1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
8 cMS$ATTRIBUTES C :: proc_proc
11 include 'COMMON.IOUNITS'
12 double precision energia(0:max_ene),energia1(0:max_ene+1)
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
23 include 'COMMON.CONTROL'
25 double precision fact(5)
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.
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 C Gay-Berne potential (shifted LJ, angular dependence).
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
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,fact(1))
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)
106 c write(iout,*) "TEST_ENE",constr_homology
107 if (constr_homology.ge.1) then
108 call e_modeller(ehomology_constr)
110 ehomology_constr=0.0d0
112 c write(iout,*) "TEST_ENE",ehomology_constr
114 C BARTEK for dfa test!
115 if (wdfa_dist.gt.0) call edfad(edfadis)
116 c print*, 'edfad is finished!', edfadis
117 if (wdfa_tor.gt.0) call edfat(edfator)
118 c print*, 'edfat is finished!', edfator
119 if (wdfa_nei.gt.0) call edfan(edfanei)
120 c print*, 'edfan is finished!', edfanei
121 if (wdfa_beta.gt.0) call edfab(edfabet)
122 c print*, 'edfab is finished!', edfabet
125 C call multibody(ecorr)
130 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
131 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
132 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
133 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
134 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
135 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
136 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
137 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
140 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
141 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
142 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
143 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
144 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
145 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
146 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
147 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
153 energia(2)=evdw2-evdw2_14
170 energia(8)=eello_turn3
171 energia(9)=eello_turn4
180 energia(20)=edihcnstr
181 energia(21)=ehomology_constr
186 cc if (dyn_ss) call dyn_set_nss
190 idumm=proc_proc(etot,i)
192 call proc_proc(etot,i)
194 if(i.eq.1)energia(0)=1.0d+99
200 C Sum up the components of the Cartesian gradient.
205 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
206 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
208 & wstrain*ghpbc(j,i)+
209 & wcorr*fact(3)*gradcorr(j,i)+
210 & wel_loc*fact(2)*gel_loc(j,i)+
211 & wturn3*fact(2)*gcorr3_turn(j,i)+
212 & wturn4*fact(3)*gcorr4_turn(j,i)+
213 & wcorr5*fact(4)*gradcorr5(j,i)+
214 & wcorr6*fact(5)*gradcorr6(j,i)+
215 & wturn6*fact(5)*gcorr6_turn(j,i)+
216 & wsccor*fact(2)*gsccorc(j,i)+
217 & wdfa_dist*gdfad(j,i)+
218 & wdfa_tor*gdfat(j,i)+
219 & wdfa_nei*gdfan(j,i)+
220 & wdfa_beta*gdfab(j,i)
221 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
223 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
228 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
229 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
231 & wcorr*fact(3)*gradcorr(j,i)+
232 & wel_loc*fact(2)*gel_loc(j,i)+
233 & wturn3*fact(2)*gcorr3_turn(j,i)+
234 & wturn4*fact(3)*gcorr4_turn(j,i)+
235 & wcorr5*fact(4)*gradcorr5(j,i)+
236 & wcorr6*fact(5)*gradcorr6(j,i)+
237 & wturn6*fact(5)*gcorr6_turn(j,i)+
238 & wsccor*fact(2)*gsccorc(j,i)+
239 & wdfa_dist*gdfad(j,i)+
240 & wdfa_tor*gdfat(j,i)+
241 & wdfa_nei*gdfan(j,i)+
242 & wdfa_beta*gdfab(j,i)
243 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
245 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
248 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
249 cd & (gradc(k,i),k=1,3)
254 cd write (iout,*) i,g_corr5_loc(i)
255 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
256 & +wcorr5*fact(4)*g_corr5_loc(i)
257 & +wcorr6*fact(5)*g_corr6_loc(i)
258 & +wturn4*fact(3)*gel_loc_turn4(i)
259 & +wturn3*fact(2)*gel_loc_turn3(i)
260 & +wturn6*fact(5)*gel_loc_turn6(i)
261 & +wel_loc*fact(2)*gel_loc_loc(i)
262 & +wsccor*fact(1)*gsccor_loc(i)
265 cd call enerprint(energia(0),fact)
270 C------------------------------------------------------------------------
271 subroutine enerprint(energia,fact)
272 implicit real*8 (a-h,o-z)
274 include 'sizesclu.dat'
275 include 'COMMON.IOUNITS'
276 include 'COMMON.FFIELD'
277 include 'COMMON.SBRIDGE'
278 double precision energia(0:max_ene),fact(5)
282 evdw2=energia(2)+energia(17)
294 eello_turn3=energia(8)
295 eello_turn4=energia(9)
296 eello_turn6=energia(10)
303 edihcnstr=energia(20)
305 ehomology_constr=energia(21)
311 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
313 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
314 & etors_d,wtor_d*fact(2),ehpb,wstrain,
315 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
316 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
317 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
318 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
319 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
321 10 format (/'Virtual-chain energies:'//
322 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
323 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
324 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
325 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
326 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
327 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
328 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
329 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
330 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
331 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
332 & ' (SS bridges & dist. cnstr.)'/
333 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
334 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
335 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
336 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
337 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
338 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
339 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
340 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
341 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
342 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
343 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
344 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
345 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
346 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
347 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
348 & 'ETOT= ',1pE16.6,' (total)')
350 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
351 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
352 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
353 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
354 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
355 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
356 & edihcnstr,ehomology_constr,ebr*nss,
357 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
359 10 format (/'Virtual-chain energies:'//
360 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
361 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
362 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
363 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
364 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
365 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
366 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
367 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
368 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
369 & ' (SS bridges & dist. cnstr.)'/
370 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
371 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
372 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
373 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
374 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
375 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
376 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
377 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
378 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
379 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
380 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
381 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
382 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
383 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
384 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
385 & 'ETOT= ',1pE16.6,' (total)')
389 C-----------------------------------------------------------------------
392 C This subroutine calculates the interaction energy of nonbonded side chains
393 C assuming the LJ potential of interaction.
395 implicit real*8 (a-h,o-z)
397 include 'sizesclu.dat'
398 c include "DIMENSIONS.COMPAR"
399 parameter (accur=1.0d-10)
402 include 'COMMON.LOCAL'
403 include 'COMMON.CHAIN'
404 include 'COMMON.DERIV'
405 include 'COMMON.INTERACT'
406 include 'COMMON.TORSION'
407 include 'COMMON.SBRIDGE'
408 include 'COMMON.NAMES'
409 include 'COMMON.IOUNITS'
410 include 'COMMON.CONTACTS'
414 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
425 C Calculate SC interaction energy.
428 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
429 cd & 'iend=',iend(i,iint)
430 do j=istart(i,iint),iend(i,iint)
435 C Change 12/1/95 to calculate four-body interactions
436 rij=xj*xj+yj*yj+zj*zj
438 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
439 eps0ij=eps(itypi,itypj)
441 e1=fac*fac*aa(itypi,itypj)
442 e2=fac*bb(itypi,itypj)
444 ij=icant(itypi,itypj)
445 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
446 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
447 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
448 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
449 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
450 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
454 C Calculate the components of the gradient in DC and X
456 fac=-rrij*(e1+evdwij)
461 gvdwx(k,i)=gvdwx(k,i)-gg(k)
462 gvdwx(k,j)=gvdwx(k,j)+gg(k)
466 gvdwc(l,k)=gvdwc(l,k)+gg(l)
471 C 12/1/95, revised on 5/20/97
473 C Calculate the contact function. The ith column of the array JCONT will
474 C contain the numbers of atoms that make contacts with the atom I (of numbers
475 C greater than I). The arrays FACONT and GACONT will contain the values of
476 C the contact function and its derivative.
478 C Uncomment next line, if the correlation interactions include EVDW explicitly.
479 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
480 C Uncomment next line, if the correlation interactions are contact function only
481 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
483 sigij=sigma(itypi,itypj)
484 r0ij=rs0(itypi,itypj)
486 C Check whether the SC's are not too far to make a contact.
489 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
490 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
492 if (fcont.gt.0.0D0) then
493 C If the SC-SC distance if close to sigma, apply spline.
494 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
495 cAdam & fcont1,fprimcont1)
496 cAdam fcont1=1.0d0-fcont1
497 cAdam if (fcont1.gt.0.0d0) then
498 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
499 cAdam fcont=fcont*fcont1
501 C Uncomment following 4 lines to have the geometric average of the epsilon0's
502 cga eps0ij=1.0d0/dsqrt(eps0ij)
504 cga gg(k)=gg(k)*eps0ij
506 cga eps0ij=-evdwij*eps0ij
507 C Uncomment for AL's type of SC correlation interactions.
509 num_conti=num_conti+1
511 facont(num_conti,i)=fcont*eps0ij
512 fprimcont=eps0ij*fprimcont/rij
514 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
515 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
516 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
517 C Uncomment following 3 lines for Skolnick's type of SC correlation.
518 gacont(1,num_conti,i)=-fprimcont*xj
519 gacont(2,num_conti,i)=-fprimcont*yj
520 gacont(3,num_conti,i)=-fprimcont*zj
521 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
522 cd write (iout,'(2i3,3f10.5)')
523 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
529 num_cont(i)=num_conti
534 gvdwc(j,i)=expon*gvdwc(j,i)
535 gvdwx(j,i)=expon*gvdwx(j,i)
539 C******************************************************************************
543 C To save time, the factor of EXPON has been extracted from ALL components
544 C of GVDWC and GRADX. Remember to multiply them by this factor before further
547 C******************************************************************************
550 C-----------------------------------------------------------------------------
551 subroutine eljk(evdw)
553 C This subroutine calculates the interaction energy of nonbonded side chains
554 C assuming the LJK potential of interaction.
556 implicit real*8 (a-h,o-z)
558 include 'sizesclu.dat'
559 c include "DIMENSIONS.COMPAR"
562 include 'COMMON.LOCAL'
563 include 'COMMON.CHAIN'
564 include 'COMMON.DERIV'
565 include 'COMMON.INTERACT'
566 include 'COMMON.IOUNITS'
567 include 'COMMON.NAMES'
572 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
581 C Calculate SC interaction energy.
584 do j=istart(i,iint),iend(i,iint)
589 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
591 e_augm=augm(itypi,itypj)*fac_augm
594 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
595 fac=r_shift_inv**expon
596 e1=fac*fac*aa(itypi,itypj)
597 e2=fac*bb(itypi,itypj)
599 ij=icant(itypi,itypj)
600 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
601 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
602 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
603 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
604 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
605 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
606 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
610 C Calculate the components of the gradient in DC and X
612 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
617 gvdwx(k,i)=gvdwx(k,i)-gg(k)
618 gvdwx(k,j)=gvdwx(k,j)+gg(k)
622 gvdwc(l,k)=gvdwc(l,k)+gg(l)
632 gvdwc(j,i)=expon*gvdwc(j,i)
633 gvdwx(j,i)=expon*gvdwx(j,i)
639 C-----------------------------------------------------------------------------
642 C This subroutine calculates the interaction energy of nonbonded side chains
643 C assuming the Berne-Pechukas potential of interaction.
645 implicit real*8 (a-h,o-z)
647 include 'sizesclu.dat'
648 c include "DIMENSIONS.COMPAR"
651 include 'COMMON.LOCAL'
652 include 'COMMON.CHAIN'
653 include 'COMMON.DERIV'
654 include 'COMMON.NAMES'
655 include 'COMMON.INTERACT'
656 include 'COMMON.IOUNITS'
657 include 'COMMON.CALC'
659 c double precision rrsave(maxdim)
664 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
666 c if (icall.eq.0) then
678 dxi=dc_norm(1,nres+i)
679 dyi=dc_norm(2,nres+i)
680 dzi=dc_norm(3,nres+i)
681 dsci_inv=vbld_inv(i+nres)
683 C Calculate SC interaction energy.
686 do j=istart(i,iint),iend(i,iint)
689 dscj_inv=vbld_inv(j+nres)
690 chi1=chi(itypi,itypj)
691 chi2=chi(itypj,itypi)
698 alf12=0.5D0*(alf1+alf2)
699 C For diagnostics only!!!
712 dxj=dc_norm(1,nres+j)
713 dyj=dc_norm(2,nres+j)
714 dzj=dc_norm(3,nres+j)
715 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
716 cd if (icall.eq.0) then
722 C Calculate the angle-dependent terms of energy & contributions to derivatives.
724 C Calculate whole angle-dependent part of epsilon and contributions
726 fac=(rrij*sigsq)**expon2
727 e1=fac*fac*aa(itypi,itypj)
728 e2=fac*bb(itypi,itypj)
729 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
730 eps2der=evdwij*eps3rt
731 eps3der=evdwij*eps2rt
732 evdwij=evdwij*eps2rt*eps3rt
733 ij=icant(itypi,itypj)
734 aux=eps1*eps2rt**2*eps3rt**2
738 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
739 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
740 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
741 cd & restyp(itypi),i,restyp(itypj),j,
742 cd & epsi,sigm,chi1,chi2,chip1,chip2,
743 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
744 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
747 C Calculate gradient components.
748 e1=e1*eps1*eps2rt**2*eps3rt**2
749 fac=-expon*(e1+evdwij)
752 C Calculate radial part of the gradient
756 C Calculate the angular part of the gradient and sum add the contributions
757 C to the appropriate components of the Cartesian gradient.
766 C-----------------------------------------------------------------------------
769 C This subroutine calculates the interaction energy of nonbonded side chains
770 C assuming the Gay-Berne potential of interaction.
772 implicit real*8 (a-h,o-z)
774 include 'sizesclu.dat'
775 c include "DIMENSIONS.COMPAR"
778 include 'COMMON.LOCAL'
779 include 'COMMON.CHAIN'
780 include 'COMMON.DERIV'
781 include 'COMMON.NAMES'
782 include 'COMMON.INTERACT'
783 include 'COMMON.IOUNITS'
784 include 'COMMON.CALC'
785 include 'COMMON.SBRIDGE'
791 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
794 c if (icall.gt.0) lprn=.true.
802 dxi=dc_norm(1,nres+i)
803 dyi=dc_norm(2,nres+i)
804 dzi=dc_norm(3,nres+i)
805 dsci_inv=vbld_inv(i+nres)
807 C Calculate SC interaction energy.
810 do j=istart(i,iint),iend(i,iint)
811 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
812 call dyn_ssbond_ene(i,j,evdwij)
814 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
815 c & 'evdw',i,j,evdwij,' ss'
819 dscj_inv=vbld_inv(j+nres)
820 sig0ij=sigma(itypi,itypj)
821 chi1=chi(itypi,itypj)
822 chi2=chi(itypj,itypi)
829 alf12=0.5D0*(alf1+alf2)
830 C For diagnostics only!!!
843 dxj=dc_norm(1,nres+j)
844 dyj=dc_norm(2,nres+j)
845 dzj=dc_norm(3,nres+j)
846 c write (iout,*) i,j,xj,yj,zj
847 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
849 C Calculate angle-dependent terms of energy and contributions to their
853 sig=sig0ij*dsqrt(sigsq)
854 rij_shift=1.0D0/rij-sig+sig0ij
855 C I hate to put IF's in the loops, but here don't have another choice!!!!
856 if (rij_shift.le.0.0D0) then
861 c---------------------------------------------------------------
862 rij_shift=1.0D0/rij_shift
864 e1=fac*fac*aa(itypi,itypj)
865 e2=fac*bb(itypi,itypj)
866 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
867 eps2der=evdwij*eps3rt
868 eps3der=evdwij*eps2rt
869 evdwij=evdwij*eps2rt*eps3rt
871 ij=icant(itypi,itypj)
872 aux=eps1*eps2rt**2*eps3rt**2
873 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
874 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
875 c & aux*e2/eps(itypi,itypj)
877 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
878 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
879 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
880 & restyp(itypi),i,restyp(itypj),j,
881 & epsi,sigm,chi1,chi2,chip1,chip2,
882 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
883 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
887 C Calculate gradient components.
888 e1=e1*eps1*eps2rt**2*eps3rt**2
889 fac=-expon*(e1+evdwij)*rij_shift
892 C Calculate the radial part of the gradient
896 C Calculate angular part of the gradient.
905 C-----------------------------------------------------------------------------
906 subroutine egbv(evdw)
908 C This subroutine calculates the interaction energy of nonbonded side chains
909 C assuming the Gay-Berne-Vorobjev potential of interaction.
911 implicit real*8 (a-h,o-z)
913 include 'sizesclu.dat'
914 c include "DIMENSIONS.COMPAR"
917 include 'COMMON.LOCAL'
918 include 'COMMON.CHAIN'
919 include 'COMMON.DERIV'
920 include 'COMMON.NAMES'
921 include 'COMMON.INTERACT'
922 include 'COMMON.IOUNITS'
923 include 'COMMON.CALC'
924 include 'COMMON.SBRIDGE'
930 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
933 c if (icall.gt.0) lprn=.true.
941 dxi=dc_norm(1,nres+i)
942 dyi=dc_norm(2,nres+i)
943 dzi=dc_norm(3,nres+i)
944 dsci_inv=vbld_inv(i+nres)
946 C Calculate SC interaction energy.
949 do j=istart(i,iint),iend(i,iint)
950 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
951 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
952 call dyn_ssbond_ene(i,j,evdwij)
954 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
955 c & 'evdw',i,j,evdwij,' ss'
959 dscj_inv=vbld_inv(j+nres)
960 sig0ij=sigma(itypi,itypj)
962 chi1=chi(itypi,itypj)
963 chi2=chi(itypj,itypi)
970 alf12=0.5D0*(alf1+alf2)
971 C For diagnostics only!!!
984 dxj=dc_norm(1,nres+j)
985 dyj=dc_norm(2,nres+j)
986 dzj=dc_norm(3,nres+j)
987 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
989 C Calculate angle-dependent terms of energy and contributions to their
993 sig=sig0ij*dsqrt(sigsq)
994 rij_shift=1.0D0/rij-sig+r0ij
995 C I hate to put IF's in the loops, but here don't have another choice!!!!
996 if (rij_shift.le.0.0D0) then
1001 c---------------------------------------------------------------
1002 rij_shift=1.0D0/rij_shift
1003 fac=rij_shift**expon
1004 e1=fac*fac*aa(itypi,itypj)
1005 e2=fac*bb(itypi,itypj)
1006 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1007 eps2der=evdwij*eps3rt
1008 eps3der=evdwij*eps2rt
1009 fac_augm=rrij**expon
1010 e_augm=augm(itypi,itypj)*fac_augm
1011 evdwij=evdwij*eps2rt*eps3rt
1012 evdw=evdw+evdwij+e_augm
1013 ij=icant(itypi,itypj)
1014 aux=eps1*eps2rt**2*eps3rt**2
1016 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1017 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1018 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1019 c & restyp(itypi),i,restyp(itypj),j,
1020 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1021 c & chi1,chi2,chip1,chip2,
1022 c & eps1,eps2rt**2,eps3rt**2,
1023 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1027 C Calculate gradient components.
1028 e1=e1*eps1*eps2rt**2*eps3rt**2
1029 fac=-expon*(e1+evdwij)*rij_shift
1031 fac=rij*fac-2*expon*rrij*e_augm
1032 C Calculate the radial part of the gradient
1036 C Calculate angular part of the gradient.
1045 C-----------------------------------------------------------------------------
1046 subroutine sc_angular
1047 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1048 C om12. Called by ebp, egb, and egbv.
1050 include 'COMMON.CALC'
1054 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1055 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1056 om12=dxi*dxj+dyi*dyj+dzi*dzj
1058 C Calculate eps1(om12) and its derivative in om12
1059 faceps1=1.0D0-om12*chiom12
1060 faceps1_inv=1.0D0/faceps1
1061 eps1=dsqrt(faceps1_inv)
1062 C Following variable is eps1*deps1/dom12
1063 eps1_om12=faceps1_inv*chiom12
1064 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1069 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1070 sigsq=1.0D0-facsig*faceps1_inv
1071 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1072 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1073 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1074 C Calculate eps2 and its derivatives in om1, om2, and om12.
1077 chipom12=chip12*om12
1078 facp=1.0D0-om12*chipom12
1080 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1081 C Following variable is the square root of eps2
1082 eps2rt=1.0D0-facp1*facp_inv
1083 C Following three variables are the derivatives of the square root of eps
1084 C in om1, om2, and om12.
1085 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1086 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1087 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1088 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1089 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1090 C Calculate whole angle-dependent part of epsilon and contributions
1091 C to its derivatives
1094 C----------------------------------------------------------------------------
1096 implicit real*8 (a-h,o-z)
1097 include 'DIMENSIONS'
1098 include 'sizesclu.dat'
1099 include 'COMMON.CHAIN'
1100 include 'COMMON.DERIV'
1101 include 'COMMON.CALC'
1102 double precision dcosom1(3),dcosom2(3)
1103 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1104 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1105 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1106 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1108 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1109 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1112 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1115 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1116 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1117 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1118 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1119 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1120 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1123 C Calculate the components of the gradient in DC and X
1127 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1132 c------------------------------------------------------------------------------
1133 subroutine vec_and_deriv
1134 implicit real*8 (a-h,o-z)
1135 include 'DIMENSIONS'
1136 include 'sizesclu.dat'
1137 include 'COMMON.IOUNITS'
1138 include 'COMMON.GEO'
1139 include 'COMMON.VAR'
1140 include 'COMMON.LOCAL'
1141 include 'COMMON.CHAIN'
1142 include 'COMMON.VECTORS'
1143 include 'COMMON.DERIV'
1144 include 'COMMON.INTERACT'
1145 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1146 C Compute the local reference systems. For reference system (i), the
1147 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1148 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1150 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1151 if (i.eq.nres-1) then
1152 C Case of the last full residue
1153 C Compute the Z-axis
1154 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1155 costh=dcos(pi-theta(nres))
1156 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1161 C Compute the derivatives of uz
1163 uzder(2,1,1)=-dc_norm(3,i-1)
1164 uzder(3,1,1)= dc_norm(2,i-1)
1165 uzder(1,2,1)= dc_norm(3,i-1)
1167 uzder(3,2,1)=-dc_norm(1,i-1)
1168 uzder(1,3,1)=-dc_norm(2,i-1)
1169 uzder(2,3,1)= dc_norm(1,i-1)
1172 uzder(2,1,2)= dc_norm(3,i)
1173 uzder(3,1,2)=-dc_norm(2,i)
1174 uzder(1,2,2)=-dc_norm(3,i)
1176 uzder(3,2,2)= dc_norm(1,i)
1177 uzder(1,3,2)= dc_norm(2,i)
1178 uzder(2,3,2)=-dc_norm(1,i)
1181 C Compute the Y-axis
1184 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1187 C Compute the derivatives of uy
1190 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1191 & -dc_norm(k,i)*dc_norm(j,i-1)
1192 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1194 uyder(j,j,1)=uyder(j,j,1)-costh
1195 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1200 uygrad(l,k,j,i)=uyder(l,k,j)
1201 uzgrad(l,k,j,i)=uzder(l,k,j)
1205 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1206 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1207 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1208 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1212 C Compute the Z-axis
1213 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1214 costh=dcos(pi-theta(i+2))
1215 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1220 C Compute the derivatives of uz
1222 uzder(2,1,1)=-dc_norm(3,i+1)
1223 uzder(3,1,1)= dc_norm(2,i+1)
1224 uzder(1,2,1)= dc_norm(3,i+1)
1226 uzder(3,2,1)=-dc_norm(1,i+1)
1227 uzder(1,3,1)=-dc_norm(2,i+1)
1228 uzder(2,3,1)= dc_norm(1,i+1)
1231 uzder(2,1,2)= dc_norm(3,i)
1232 uzder(3,1,2)=-dc_norm(2,i)
1233 uzder(1,2,2)=-dc_norm(3,i)
1235 uzder(3,2,2)= dc_norm(1,i)
1236 uzder(1,3,2)= dc_norm(2,i)
1237 uzder(2,3,2)=-dc_norm(1,i)
1240 C Compute the Y-axis
1243 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1246 C Compute the derivatives of uy
1249 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1250 & -dc_norm(k,i)*dc_norm(j,i+1)
1251 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1253 uyder(j,j,1)=uyder(j,j,1)-costh
1254 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1259 uygrad(l,k,j,i)=uyder(l,k,j)
1260 uzgrad(l,k,j,i)=uzder(l,k,j)
1264 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1265 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1266 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1267 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1273 vbld_inv_temp(1)=vbld_inv(i+1)
1274 if (i.lt.nres-1) then
1275 vbld_inv_temp(2)=vbld_inv(i+2)
1277 vbld_inv_temp(2)=vbld_inv(i)
1282 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1283 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1291 C-----------------------------------------------------------------------------
1292 subroutine vec_and_deriv_test
1293 implicit real*8 (a-h,o-z)
1294 include 'DIMENSIONS'
1295 include 'sizesclu.dat'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.GEO'
1298 include 'COMMON.VAR'
1299 include 'COMMON.LOCAL'
1300 include 'COMMON.CHAIN'
1301 include 'COMMON.VECTORS'
1302 dimension uyder(3,3,2),uzder(3,3,2)
1303 C Compute the local reference systems. For reference system (i), the
1304 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1305 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1307 if (i.eq.nres-1) then
1308 C Case of the last full residue
1309 C Compute the Z-axis
1310 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1311 costh=dcos(pi-theta(nres))
1312 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1313 c write (iout,*) 'fac',fac,
1314 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1315 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1319 C Compute the derivatives of uz
1321 uzder(2,1,1)=-dc_norm(3,i-1)
1322 uzder(3,1,1)= dc_norm(2,i-1)
1323 uzder(1,2,1)= dc_norm(3,i-1)
1325 uzder(3,2,1)=-dc_norm(1,i-1)
1326 uzder(1,3,1)=-dc_norm(2,i-1)
1327 uzder(2,3,1)= dc_norm(1,i-1)
1330 uzder(2,1,2)= dc_norm(3,i)
1331 uzder(3,1,2)=-dc_norm(2,i)
1332 uzder(1,2,2)=-dc_norm(3,i)
1334 uzder(3,2,2)= dc_norm(1,i)
1335 uzder(1,3,2)= dc_norm(2,i)
1336 uzder(2,3,2)=-dc_norm(1,i)
1338 C Compute the Y-axis
1340 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1343 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1344 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1345 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1347 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1350 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1351 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1354 c write (iout,*) 'facy',facy,
1355 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1358 uy(k,i)=facy*uy(k,i)
1360 C Compute the derivatives of uy
1363 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1364 & -dc_norm(k,i)*dc_norm(j,i-1)
1365 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1367 c uyder(j,j,1)=uyder(j,j,1)-costh
1368 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1369 uyder(j,j,1)=uyder(j,j,1)
1370 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1371 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1377 uygrad(l,k,j,i)=uyder(l,k,j)
1378 uzgrad(l,k,j,i)=uzder(l,k,j)
1382 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1383 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1384 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1385 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1388 C Compute the Z-axis
1389 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1390 costh=dcos(pi-theta(i+2))
1391 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1392 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1396 C Compute the derivatives of uz
1398 uzder(2,1,1)=-dc_norm(3,i+1)
1399 uzder(3,1,1)= dc_norm(2,i+1)
1400 uzder(1,2,1)= dc_norm(3,i+1)
1402 uzder(3,2,1)=-dc_norm(1,i+1)
1403 uzder(1,3,1)=-dc_norm(2,i+1)
1404 uzder(2,3,1)= dc_norm(1,i+1)
1407 uzder(2,1,2)= dc_norm(3,i)
1408 uzder(3,1,2)=-dc_norm(2,i)
1409 uzder(1,2,2)=-dc_norm(3,i)
1411 uzder(3,2,2)= dc_norm(1,i)
1412 uzder(1,3,2)= dc_norm(2,i)
1413 uzder(2,3,2)=-dc_norm(1,i)
1415 C Compute the Y-axis
1417 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1418 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1419 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1421 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1424 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1425 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1428 c write (iout,*) 'facy',facy,
1429 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1430 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1432 uy(k,i)=facy*uy(k,i)
1434 C Compute the derivatives of uy
1437 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1438 & -dc_norm(k,i)*dc_norm(j,i+1)
1439 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1441 c uyder(j,j,1)=uyder(j,j,1)-costh
1442 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1443 uyder(j,j,1)=uyder(j,j,1)
1444 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1445 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1451 uygrad(l,k,j,i)=uyder(l,k,j)
1452 uzgrad(l,k,j,i)=uzder(l,k,j)
1456 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1457 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1458 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1459 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1466 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1467 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1474 C-----------------------------------------------------------------------------
1475 subroutine check_vecgrad
1476 implicit real*8 (a-h,o-z)
1477 include 'DIMENSIONS'
1478 include 'sizesclu.dat'
1479 include 'COMMON.IOUNITS'
1480 include 'COMMON.GEO'
1481 include 'COMMON.VAR'
1482 include 'COMMON.LOCAL'
1483 include 'COMMON.CHAIN'
1484 include 'COMMON.VECTORS'
1485 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1486 dimension uyt(3,maxres),uzt(3,maxres)
1487 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1488 double precision delta /1.0d-7/
1491 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1492 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1493 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1494 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1495 cd & (dc_norm(if90,i),if90=1,3)
1496 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1497 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1498 cd write(iout,'(a)')
1504 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1505 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1518 cd write (iout,*) 'i=',i
1520 erij(k)=dc_norm(k,i)
1524 dc_norm(k,i)=erij(k)
1526 dc_norm(j,i)=dc_norm(j,i)+delta
1527 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1529 c dc_norm(k,i)=dc_norm(k,i)/fac
1531 c write (iout,*) (dc_norm(k,i),k=1,3)
1532 c write (iout,*) (erij(k),k=1,3)
1535 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1536 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1537 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1538 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1540 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1541 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1542 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1545 dc_norm(k,i)=erij(k)
1548 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1549 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1550 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1551 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1552 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1553 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1554 cd write (iout,'(a)')
1559 C--------------------------------------------------------------------------
1560 subroutine set_matrices
1561 implicit real*8 (a-h,o-z)
1562 include 'DIMENSIONS'
1563 include 'sizesclu.dat'
1564 include 'COMMON.IOUNITS'
1565 include 'COMMON.GEO'
1566 include 'COMMON.VAR'
1567 include 'COMMON.LOCAL'
1568 include 'COMMON.CHAIN'
1569 include 'COMMON.DERIV'
1570 include 'COMMON.INTERACT'
1571 include 'COMMON.CONTACTS'
1572 include 'COMMON.TORSION'
1573 include 'COMMON.VECTORS'
1574 include 'COMMON.FFIELD'
1575 double precision auxvec(2),auxmat(2,2)
1577 C Compute the virtual-bond-torsional-angle dependent quantities needed
1578 C to calculate the el-loc multibody terms of various order.
1581 if (i .lt. nres+1) then
1618 if (i .gt. 3 .and. i .lt. nres+1) then
1619 obrot_der(1,i-2)=-sin1
1620 obrot_der(2,i-2)= cos1
1621 Ugder(1,1,i-2)= sin1
1622 Ugder(1,2,i-2)=-cos1
1623 Ugder(2,1,i-2)=-cos1
1624 Ugder(2,2,i-2)=-sin1
1627 obrot2_der(1,i-2)=-dwasin2
1628 obrot2_der(2,i-2)= dwacos2
1629 Ug2der(1,1,i-2)= dwasin2
1630 Ug2der(1,2,i-2)=-dwacos2
1631 Ug2der(2,1,i-2)=-dwacos2
1632 Ug2der(2,2,i-2)=-dwasin2
1634 obrot_der(1,i-2)=0.0d0
1635 obrot_der(2,i-2)=0.0d0
1636 Ugder(1,1,i-2)=0.0d0
1637 Ugder(1,2,i-2)=0.0d0
1638 Ugder(2,1,i-2)=0.0d0
1639 Ugder(2,2,i-2)=0.0d0
1640 obrot2_der(1,i-2)=0.0d0
1641 obrot2_der(2,i-2)=0.0d0
1642 Ug2der(1,1,i-2)=0.0d0
1643 Ug2der(1,2,i-2)=0.0d0
1644 Ug2der(2,1,i-2)=0.0d0
1645 Ug2der(2,2,i-2)=0.0d0
1647 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1648 iti = itortyp(itype(i-2))
1652 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1653 iti1 = itortyp(itype(i-1))
1657 cd write (iout,*) '*******i',i,' iti1',iti
1658 cd write (iout,*) 'b1',b1(:,iti)
1659 cd write (iout,*) 'b2',b2(:,iti)
1660 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1661 if (i .gt. iatel_s+2) then
1662 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1663 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1664 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1665 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1666 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1667 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1668 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1678 DtUg2(l,k,i-2)=0.0d0
1682 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1683 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1684 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1685 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1686 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1687 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1688 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1690 muder(k,i-2)=Ub2der(k,i-2)
1692 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1693 iti1 = itortyp(itype(i-1))
1698 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1700 C Vectors and matrices dependent on a single virtual-bond dihedral.
1701 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1702 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1703 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1704 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1705 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1706 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1707 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1708 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1709 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1710 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1711 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1713 C Matrices dependent on two consecutive virtual-bond dihedrals.
1714 C The order of matrices is from left to right.
1716 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1717 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1718 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1719 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1720 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1721 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1722 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1723 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1726 cd iti = itortyp(itype(i))
1729 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1730 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1735 C--------------------------------------------------------------------------
1736 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1738 C This subroutine calculates the average interaction energy and its gradient
1739 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1740 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1741 C The potential depends both on the distance of peptide-group centers and on
1742 C the orientation of the CA-CA virtual bonds.
1744 implicit real*8 (a-h,o-z)
1745 include 'DIMENSIONS'
1746 include 'sizesclu.dat'
1747 include 'COMMON.CONTROL'
1748 include 'COMMON.IOUNITS'
1749 include 'COMMON.GEO'
1750 include 'COMMON.VAR'
1751 include 'COMMON.LOCAL'
1752 include 'COMMON.CHAIN'
1753 include 'COMMON.DERIV'
1754 include 'COMMON.INTERACT'
1755 include 'COMMON.CONTACTS'
1756 include 'COMMON.TORSION'
1757 include 'COMMON.VECTORS'
1758 include 'COMMON.FFIELD'
1759 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1760 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1761 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1762 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1763 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1764 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1765 double precision scal_el /0.5d0/
1767 C 13-go grudnia roku pamietnego...
1768 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1769 & 0.0d0,1.0d0,0.0d0,
1770 & 0.0d0,0.0d0,1.0d0/
1771 cd write(iout,*) 'In EELEC'
1773 cd write(iout,*) 'Type',i
1774 cd write(iout,*) 'B1',B1(:,i)
1775 cd write(iout,*) 'B2',B2(:,i)
1776 cd write(iout,*) 'CC',CC(:,:,i)
1777 cd write(iout,*) 'DD',DD(:,:,i)
1778 cd write(iout,*) 'EE',EE(:,:,i)
1780 cd call check_vecgrad
1782 if (icheckgrad.eq.1) then
1784 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1786 dc_norm(k,i)=dc(k,i)*fac
1788 c write (iout,*) 'i',i,' fac',fac
1791 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1792 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1793 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1794 cd if (wel_loc.gt.0.0d0) then
1795 if (icheckgrad.eq.1) then
1796 call vec_and_deriv_test
1803 cd write (iout,*) 'i=',i
1805 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1808 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1809 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1822 cd print '(a)','Enter EELEC'
1823 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1825 gel_loc_loc(i)=0.0d0
1828 do i=iatel_s,iatel_e
1829 if (itel(i).eq.0) goto 1215
1833 dx_normi=dc_norm(1,i)
1834 dy_normi=dc_norm(2,i)
1835 dz_normi=dc_norm(3,i)
1836 xmedi=c(1,i)+0.5d0*dxi
1837 ymedi=c(2,i)+0.5d0*dyi
1838 zmedi=c(3,i)+0.5d0*dzi
1840 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1841 do j=ielstart(i),ielend(i)
1842 if (itel(j).eq.0) goto 1216
1846 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1847 aaa=app(iteli,itelj)
1848 bbb=bpp(iteli,itelj)
1849 C Diagnostics only!!!
1855 ael6i=ael6(iteli,itelj)
1856 ael3i=ael3(iteli,itelj)
1860 dx_normj=dc_norm(1,j)
1861 dy_normj=dc_norm(2,j)
1862 dz_normj=dc_norm(3,j)
1863 xj=c(1,j)+0.5D0*dxj-xmedi
1864 yj=c(2,j)+0.5D0*dyj-ymedi
1865 zj=c(3,j)+0.5D0*dzj-zmedi
1866 rij=xj*xj+yj*yj+zj*zj
1872 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1873 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1874 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1875 fac=cosa-3.0D0*cosb*cosg
1877 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1878 if (j.eq.i+2) ev1=scal_el*ev1
1883 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1886 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1887 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1888 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1891 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1892 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1893 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1894 cd & xmedi,ymedi,zmedi,xj,yj,zj
1896 C Calculate contributions to the Cartesian gradient.
1899 facvdw=-6*rrmij*(ev1+evdwij)
1900 facel=-3*rrmij*(el1+eesij)
1907 * Radial derivatives. First process both termini of the fragment (i,j)
1914 gelc(k,i)=gelc(k,i)+ghalf
1915 gelc(k,j)=gelc(k,j)+ghalf
1918 * Loop over residues i+1 thru j-1.
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1930 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1931 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1934 * Loop over residues i+1 thru j-1.
1938 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1945 fac=-3*rrmij*(facvdw+facvdw+facel)
1951 * Radial derivatives. First process both termini of the fragment (i,j)
1958 gelc(k,i)=gelc(k,i)+ghalf
1959 gelc(k,j)=gelc(k,j)+ghalf
1962 * Loop over residues i+1 thru j-1.
1966 gelc(l,k)=gelc(l,k)+ggg(l)
1973 ecosa=2.0D0*fac3*fac1+fac4
1976 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1977 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1979 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1980 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1982 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1983 cd & (dcosg(k),k=1,3)
1985 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1989 gelc(k,i)=gelc(k,i)+ghalf
1990 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1991 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1992 gelc(k,j)=gelc(k,j)+ghalf
1993 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1994 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1998 gelc(l,k)=gelc(l,k)+ggg(l)
2003 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2004 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2005 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2007 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2008 C energy of a peptide unit is assumed in the form of a second-order
2009 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2010 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2011 C are computed for EVERY pair of non-contiguous peptide groups.
2013 if (j.lt.nres-1) then
2024 muij(kkk)=mu(k,i)*mu(l,j)
2027 cd write (iout,*) 'EELEC: i',i,' j',j
2028 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2029 cd write(iout,*) 'muij',muij
2030 ury=scalar(uy(1,i),erij)
2031 urz=scalar(uz(1,i),erij)
2032 vry=scalar(uy(1,j),erij)
2033 vrz=scalar(uz(1,j),erij)
2034 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2035 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2036 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2037 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2038 C For diagnostics only
2043 fac=dsqrt(-ael6i)*r3ij
2044 cd write (2,*) 'fac=',fac
2045 C For diagnostics only
2051 cd write (iout,'(4i5,4f10.5)')
2052 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2053 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2054 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2055 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2056 cd write (iout,'(4f10.5)')
2057 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2058 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2059 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2060 cd write (iout,'(2i3,9f10.5/)') i,j,
2061 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2063 C Derivatives of the elements of A in virtual-bond vectors
2064 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2071 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2072 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2073 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2074 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2075 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2076 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2077 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2078 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2079 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2080 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2081 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2082 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2092 C Compute radial contributions to the gradient
2114 C Add the contributions coming from er
2117 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2118 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2119 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2120 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2123 C Derivatives in DC(i)
2124 ghalf1=0.5d0*agg(k,1)
2125 ghalf2=0.5d0*agg(k,2)
2126 ghalf3=0.5d0*agg(k,3)
2127 ghalf4=0.5d0*agg(k,4)
2128 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2129 & -3.0d0*uryg(k,2)*vry)+ghalf1
2130 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2131 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2132 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2133 & -3.0d0*urzg(k,2)*vry)+ghalf3
2134 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2135 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2136 C Derivatives in DC(i+1)
2137 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2138 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2139 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2140 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2141 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2142 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2143 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2144 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2145 C Derivatives in DC(j)
2146 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2147 & -3.0d0*vryg(k,2)*ury)+ghalf1
2148 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2149 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2150 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2151 & -3.0d0*vryg(k,2)*urz)+ghalf3
2152 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2153 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2154 C Derivatives in DC(j+1) or DC(nres-1)
2155 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2156 & -3.0d0*vryg(k,3)*ury)
2157 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2158 & -3.0d0*vrzg(k,3)*ury)
2159 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2160 & -3.0d0*vryg(k,3)*urz)
2161 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2162 & -3.0d0*vrzg(k,3)*urz)
2167 C Derivatives in DC(i+1)
2168 cd aggi1(k,1)=agg(k,1)
2169 cd aggi1(k,2)=agg(k,2)
2170 cd aggi1(k,3)=agg(k,3)
2171 cd aggi1(k,4)=agg(k,4)
2172 C Derivatives in DC(j)
2177 C Derivatives in DC(j+1)
2182 if (j.eq.nres-1 .and. i.lt.j-2) then
2184 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2185 cd aggj1(k,l)=agg(k,l)
2191 C Check the loc-el terms by numerical integration
2201 aggi(k,l)=-aggi(k,l)
2202 aggi1(k,l)=-aggi1(k,l)
2203 aggj(k,l)=-aggj(k,l)
2204 aggj1(k,l)=-aggj1(k,l)
2207 if (j.lt.nres-1) then
2213 aggi(k,l)=-aggi(k,l)
2214 aggi1(k,l)=-aggi1(k,l)
2215 aggj(k,l)=-aggj(k,l)
2216 aggj1(k,l)=-aggj1(k,l)
2227 aggi(k,l)=-aggi(k,l)
2228 aggi1(k,l)=-aggi1(k,l)
2229 aggj(k,l)=-aggj(k,l)
2230 aggj1(k,l)=-aggj1(k,l)
2236 IF (wel_loc.gt.0.0d0) THEN
2237 C Contribution to the local-electrostatic energy coming from the i-j pair
2238 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2240 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2241 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2242 eel_loc=eel_loc+eel_loc_ij
2243 C Partial derivatives in virtual-bond dihedral angles gamma
2246 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2247 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2248 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2249 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2250 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2251 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2252 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2253 cd write(iout,*) 'agg ',agg
2254 cd write(iout,*) 'aggi ',aggi
2255 cd write(iout,*) 'aggi1',aggi1
2256 cd write(iout,*) 'aggj ',aggj
2257 cd write(iout,*) 'aggj1',aggj1
2259 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2261 ggg(l)=agg(l,1)*muij(1)+
2262 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2266 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2269 C Remaining derivatives of eello
2271 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2272 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2273 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2274 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2275 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2276 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2277 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2278 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2282 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2283 C Contributions from turns
2288 call eturn34(i,j,eello_turn3,eello_turn4)
2290 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2291 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2293 C Calculate the contact function. The ith column of the array JCONT will
2294 C contain the numbers of atoms that make contacts with the atom I (of numbers
2295 C greater than I). The arrays FACONT and GACONT will contain the values of
2296 C the contact function and its derivative.
2297 c r0ij=1.02D0*rpp(iteli,itelj)
2298 c r0ij=1.11D0*rpp(iteli,itelj)
2299 r0ij=2.20D0*rpp(iteli,itelj)
2300 c r0ij=1.55D0*rpp(iteli,itelj)
2301 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2302 if (fcont.gt.0.0D0) then
2303 num_conti=num_conti+1
2304 if (num_conti.gt.maxconts) then
2305 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2306 & ' will skip next contacts for this conf.'
2308 jcont_hb(num_conti,i)=j
2309 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2310 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2311 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2313 d_cont(num_conti,i)=rij
2314 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2315 C --- Electrostatic-interaction matrix ---
2316 a_chuj(1,1,num_conti,i)=a22
2317 a_chuj(1,2,num_conti,i)=a23
2318 a_chuj(2,1,num_conti,i)=a32
2319 a_chuj(2,2,num_conti,i)=a33
2320 C --- Gradient of rij
2322 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2325 c a_chuj(1,1,num_conti,i)=-0.61d0
2326 c a_chuj(1,2,num_conti,i)= 0.4d0
2327 c a_chuj(2,1,num_conti,i)= 0.65d0
2328 c a_chuj(2,2,num_conti,i)= 0.50d0
2329 c else if (i.eq.2) then
2330 c a_chuj(1,1,num_conti,i)= 0.0d0
2331 c a_chuj(1,2,num_conti,i)= 0.0d0
2332 c a_chuj(2,1,num_conti,i)= 0.0d0
2333 c a_chuj(2,2,num_conti,i)= 0.0d0
2335 C --- and its gradients
2336 cd write (iout,*) 'i',i,' j',j
2338 cd write (iout,*) 'iii 1 kkk',kkk
2339 cd write (iout,*) agg(kkk,:)
2342 cd write (iout,*) 'iii 2 kkk',kkk
2343 cd write (iout,*) aggi(kkk,:)
2346 cd write (iout,*) 'iii 3 kkk',kkk
2347 cd write (iout,*) aggi1(kkk,:)
2350 cd write (iout,*) 'iii 4 kkk',kkk
2351 cd write (iout,*) aggj(kkk,:)
2354 cd write (iout,*) 'iii 5 kkk',kkk
2355 cd write (iout,*) aggj1(kkk,:)
2362 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2363 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2364 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2365 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2366 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2368 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2374 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2375 C Calculate contact energies
2377 wij=cosa-3.0D0*cosb*cosg
2380 c fac3=dsqrt(-ael6i)/r0ij**3
2381 fac3=dsqrt(-ael6i)*r3ij
2382 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2383 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2385 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2386 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2387 C Diagnostics. Comment out or remove after debugging!
2388 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2389 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2390 c ees0m(num_conti,i)=0.0D0
2392 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2393 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2394 facont_hb(num_conti,i)=fcont
2396 C Angular derivatives of the contact function
2397 ees0pij1=fac3/ees0pij
2398 ees0mij1=fac3/ees0mij
2399 fac3p=-3.0D0*fac3*rrmij
2400 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2401 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2403 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2404 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2405 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2406 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2407 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2408 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2409 ecosap=ecosa1+ecosa2
2410 ecosbp=ecosb1+ecosb2
2411 ecosgp=ecosg1+ecosg2
2412 ecosam=ecosa1-ecosa2
2413 ecosbm=ecosb1-ecosb2
2414 ecosgm=ecosg1-ecosg2
2423 fprimcont=fprimcont/rij
2424 cd facont_hb(num_conti,i)=1.0D0
2425 C Following line is for diagnostics.
2428 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2429 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2432 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2433 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2435 gggp(1)=gggp(1)+ees0pijp*xj
2436 gggp(2)=gggp(2)+ees0pijp*yj
2437 gggp(3)=gggp(3)+ees0pijp*zj
2438 gggm(1)=gggm(1)+ees0mijp*xj
2439 gggm(2)=gggm(2)+ees0mijp*yj
2440 gggm(3)=gggm(3)+ees0mijp*zj
2441 C Derivatives due to the contact function
2442 gacont_hbr(1,num_conti,i)=fprimcont*xj
2443 gacont_hbr(2,num_conti,i)=fprimcont*yj
2444 gacont_hbr(3,num_conti,i)=fprimcont*zj
2446 ghalfp=0.5D0*gggp(k)
2447 ghalfm=0.5D0*gggm(k)
2448 gacontp_hb1(k,num_conti,i)=ghalfp
2449 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2450 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2451 gacontp_hb2(k,num_conti,i)=ghalfp
2452 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2453 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2454 gacontp_hb3(k,num_conti,i)=gggp(k)
2455 gacontm_hb1(k,num_conti,i)=ghalfm
2456 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2457 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2458 gacontm_hb2(k,num_conti,i)=ghalfm
2459 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2460 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2461 gacontm_hb3(k,num_conti,i)=gggm(k)
2464 C Diagnostics. Comment out or remove after debugging!
2466 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2467 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2468 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2469 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2470 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2471 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2474 endif ! num_conti.le.maxconts
2479 num_cont_hb(i)=num_conti
2483 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2484 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2486 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2487 ccc eel_loc=eel_loc+eello_turn3
2490 C-----------------------------------------------------------------------------
2491 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2492 C Third- and fourth-order contributions from turns
2493 implicit real*8 (a-h,o-z)
2494 include 'DIMENSIONS'
2495 include 'sizesclu.dat'
2496 include 'COMMON.IOUNITS'
2497 include 'COMMON.GEO'
2498 include 'COMMON.VAR'
2499 include 'COMMON.LOCAL'
2500 include 'COMMON.CHAIN'
2501 include 'COMMON.DERIV'
2502 include 'COMMON.INTERACT'
2503 include 'COMMON.CONTACTS'
2504 include 'COMMON.TORSION'
2505 include 'COMMON.VECTORS'
2506 include 'COMMON.FFIELD'
2508 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2509 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2510 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2511 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2512 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2513 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2515 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2517 C Third-order contributions
2524 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2525 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2526 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2527 call transpose2(auxmat(1,1),auxmat1(1,1))
2528 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2529 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2531 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2532 cd & ' eello_turn3_num',4*eello_turn3_num
2534 C Derivatives in gamma(i)
2535 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2536 call transpose2(auxmat2(1,1),pizda(1,1))
2537 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2538 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2539 C Derivatives in gamma(i+1)
2540 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2541 call transpose2(auxmat2(1,1),pizda(1,1))
2542 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2543 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2544 & +0.5d0*(pizda(1,1)+pizda(2,2))
2545 C Cartesian derivatives
2547 a_temp(1,1)=aggi(l,1)
2548 a_temp(1,2)=aggi(l,2)
2549 a_temp(2,1)=aggi(l,3)
2550 a_temp(2,2)=aggi(l,4)
2551 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2552 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2553 & +0.5d0*(pizda(1,1)+pizda(2,2))
2554 a_temp(1,1)=aggi1(l,1)
2555 a_temp(1,2)=aggi1(l,2)
2556 a_temp(2,1)=aggi1(l,3)
2557 a_temp(2,2)=aggi1(l,4)
2558 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2559 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2560 & +0.5d0*(pizda(1,1)+pizda(2,2))
2561 a_temp(1,1)=aggj(l,1)
2562 a_temp(1,2)=aggj(l,2)
2563 a_temp(2,1)=aggj(l,3)
2564 a_temp(2,2)=aggj(l,4)
2565 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2566 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2567 & +0.5d0*(pizda(1,1)+pizda(2,2))
2568 a_temp(1,1)=aggj1(l,1)
2569 a_temp(1,2)=aggj1(l,2)
2570 a_temp(2,1)=aggj1(l,3)
2571 a_temp(2,2)=aggj1(l,4)
2572 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2573 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2574 & +0.5d0*(pizda(1,1)+pizda(2,2))
2577 else if (j.eq.i+3) then
2578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2580 C Fourth-order contributions
2588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2589 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2590 iti1=itortyp(itype(i+1))
2591 iti2=itortyp(itype(i+2))
2592 iti3=itortyp(itype(i+3))
2593 call transpose2(EUg(1,1,i+1),e1t(1,1))
2594 call transpose2(Eug(1,1,i+2),e2t(1,1))
2595 call transpose2(Eug(1,1,i+3),e3t(1,1))
2596 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2597 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2598 s1=scalar2(b1(1,iti2),auxvec(1))
2599 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2600 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2601 s2=scalar2(b1(1,iti1),auxvec(1))
2602 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2603 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2604 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2605 eello_turn4=eello_turn4-(s1+s2+s3)
2606 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2607 cd & ' eello_turn4_num',8*eello_turn4_num
2608 C Derivatives in gamma(i)
2610 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2611 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2612 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2613 s1=scalar2(b1(1,iti2),auxvec(1))
2614 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2615 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2616 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2617 C Derivatives in gamma(i+1)
2618 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2619 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2622 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2625 C Derivatives in gamma(i+2)
2626 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2627 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2628 s1=scalar2(b1(1,iti2),auxvec(1))
2629 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2630 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2631 s2=scalar2(b1(1,iti1),auxvec(1))
2632 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2633 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2635 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2636 C Cartesian derivatives
2637 C Derivatives of this turn contributions in DC(i+2)
2638 if (j.lt.nres-1) then
2640 a_temp(1,1)=agg(l,1)
2641 a_temp(1,2)=agg(l,2)
2642 a_temp(2,1)=agg(l,3)
2643 a_temp(2,2)=agg(l,4)
2644 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2645 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2646 s1=scalar2(b1(1,iti2),auxvec(1))
2647 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2648 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2649 s2=scalar2(b1(1,iti1),auxvec(1))
2650 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2651 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2652 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2654 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2657 C Remaining derivatives of this turn contribution
2659 a_temp(1,1)=aggi(l,1)
2660 a_temp(1,2)=aggi(l,2)
2661 a_temp(2,1)=aggi(l,3)
2662 a_temp(2,2)=aggi(l,4)
2663 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2664 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2665 s1=scalar2(b1(1,iti2),auxvec(1))
2666 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2667 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2668 s2=scalar2(b1(1,iti1),auxvec(1))
2669 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2670 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2672 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2673 a_temp(1,1)=aggi1(l,1)
2674 a_temp(1,2)=aggi1(l,2)
2675 a_temp(2,1)=aggi1(l,3)
2676 a_temp(2,2)=aggi1(l,4)
2677 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2678 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2679 s1=scalar2(b1(1,iti2),auxvec(1))
2680 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2681 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2682 s2=scalar2(b1(1,iti1),auxvec(1))
2683 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2684 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2685 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2686 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2687 a_temp(1,1)=aggj(l,1)
2688 a_temp(1,2)=aggj(l,2)
2689 a_temp(2,1)=aggj(l,3)
2690 a_temp(2,2)=aggj(l,4)
2691 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2692 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2693 s1=scalar2(b1(1,iti2),auxvec(1))
2694 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2695 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2698 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2701 a_temp(1,1)=aggj1(l,1)
2702 a_temp(1,2)=aggj1(l,2)
2703 a_temp(2,1)=aggj1(l,3)
2704 a_temp(2,2)=aggj1(l,4)
2705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2707 s1=scalar2(b1(1,iti2),auxvec(1))
2708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2710 s2=scalar2(b1(1,iti1),auxvec(1))
2711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2714 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2720 C-----------------------------------------------------------------------------
2721 subroutine vecpr(u,v,w)
2722 implicit real*8(a-h,o-z)
2723 dimension u(3),v(3),w(3)
2724 w(1)=u(2)*v(3)-u(3)*v(2)
2725 w(2)=-u(1)*v(3)+u(3)*v(1)
2726 w(3)=u(1)*v(2)-u(2)*v(1)
2729 C-----------------------------------------------------------------------------
2730 subroutine unormderiv(u,ugrad,unorm,ungrad)
2731 C This subroutine computes the derivatives of a normalized vector u, given
2732 C the derivatives computed without normalization conditions, ugrad. Returns
2735 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2736 double precision vec(3)
2737 double precision scalar
2739 c write (2,*) 'ugrad',ugrad
2742 vec(i)=scalar(ugrad(1,i),u(1))
2744 c write (2,*) 'vec',vec
2747 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2750 c write (2,*) 'ungrad',ungrad
2753 C-----------------------------------------------------------------------------
2754 subroutine escp(evdw2,evdw2_14)
2756 C This subroutine calculates the excluded-volume interaction energy between
2757 C peptide-group centers and side chains and its gradient in virtual-bond and
2758 C side-chain vectors.
2760 implicit real*8 (a-h,o-z)
2761 include 'DIMENSIONS'
2762 include 'sizesclu.dat'
2763 include 'COMMON.GEO'
2764 include 'COMMON.VAR'
2765 include 'COMMON.LOCAL'
2766 include 'COMMON.CHAIN'
2767 include 'COMMON.DERIV'
2768 include 'COMMON.INTERACT'
2769 include 'COMMON.FFIELD'
2770 include 'COMMON.IOUNITS'
2774 cd print '(a)','Enter ESCP'
2775 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2776 c & ' scal14',scal14
2777 do i=iatscp_s,iatscp_e
2779 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2780 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2781 if (iteli.eq.0) goto 1225
2782 xi=0.5D0*(c(1,i)+c(1,i+1))
2783 yi=0.5D0*(c(2,i)+c(2,i+1))
2784 zi=0.5D0*(c(3,i)+c(3,i+1))
2786 do iint=1,nscp_gr(i)
2788 do j=iscpstart(i,iint),iscpend(i,iint)
2790 C Uncomment following three lines for SC-p interactions
2794 C Uncomment following three lines for Ca-p interactions
2798 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2800 e1=fac*fac*aad(itypj,iteli)
2801 e2=fac*bad(itypj,iteli)
2802 if (iabs(j-i) .le. 2) then
2805 evdw2_14=evdw2_14+e1+e2
2808 c write (iout,*) i,j,evdwij
2812 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2814 fac=-(evdwij+e1)*rrij
2819 cd write (iout,*) 'j<i'
2820 C Uncomment following three lines for SC-p interactions
2822 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2825 cd write (iout,*) 'j>i'
2828 C Uncomment following line for SC-p interactions
2829 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2833 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2837 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2838 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2841 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2851 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2852 gradx_scp(j,i)=expon*gradx_scp(j,i)
2855 C******************************************************************************
2859 C To save time the factor EXPON has been extracted from ALL components
2860 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2863 C******************************************************************************
2866 C--------------------------------------------------------------------------
2867 subroutine edis(ehpb)
2869 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2871 implicit real*8 (a-h,o-z)
2872 include 'DIMENSIONS'
2873 include 'COMMON.SBRIDGE'
2874 include 'COMMON.CHAIN'
2875 include 'COMMON.DERIV'
2876 include 'COMMON.VAR'
2877 include 'COMMON.INTERACT'
2878 include 'COMMON.IOUNITS'
2881 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2882 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2883 if (link_end.eq.0) return
2884 do i=link_start,link_end
2885 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2886 C CA-CA distance used in regularization of structure.
2889 C iii and jjj point to the residues for which the distance is assigned.
2890 if (ii.gt.nres) then
2897 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2898 c & dhpb(i),dhpb1(i),forcon(i)
2899 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2900 C distance and angle dependent SS bond potential.
2901 if (.not.dyn_ss .and. i.le.nss) then
2902 C 15/02/13 CC dynamic SSbond - additional check
2903 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2904 call ssbond_ene(iii,jjj,eij)
2906 cd write (iout,*) "eij",eij
2908 else if (ii.gt.nres .and. jj.gt.nres) then
2909 c Restraints from contact prediction
2911 if (dhpb1(i).gt.0.0d0) then
2912 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2913 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2914 c write (iout,*) "beta nmr",
2915 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2919 C Get the force constant corresponding to this distance.
2921 C Calculate the contribution to energy.
2922 ehpb=ehpb+waga*rdis*rdis
2923 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2925 C Evaluate gradient.
2930 ggg(j)=fac*(c(j,jj)-c(j,ii))
2933 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2934 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2937 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2938 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2941 C Calculate the distance between the two points and its difference from the
2944 if (dhpb1(i).gt.0.0d0) then
2945 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2946 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2947 c write (iout,*) "alph nmr",
2948 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2951 C Get the force constant corresponding to this distance.
2953 C Calculate the contribution to energy.
2954 ehpb=ehpb+waga*rdis*rdis
2955 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2957 C Evaluate gradient.
2961 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2962 cd & ' waga=',waga,' fac=',fac
2964 ggg(j)=fac*(c(j,jj)-c(j,ii))
2966 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2967 C If this is a SC-SC distance, we need to calculate the contributions to the
2968 C Cartesian gradient in the SC vectors (ghpbx).
2971 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2972 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2976 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2977 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2984 C--------------------------------------------------------------------------
2985 subroutine ssbond_ene(i,j,eij)
2987 C Calculate the distance and angle dependent SS-bond potential energy
2988 C using a free-energy function derived based on RHF/6-31G** ab initio
2989 C calculations of diethyl disulfide.
2991 C A. Liwo and U. Kozlowska, 11/24/03
2993 implicit real*8 (a-h,o-z)
2994 include 'DIMENSIONS'
2995 include 'sizesclu.dat'
2996 include 'COMMON.SBRIDGE'
2997 include 'COMMON.CHAIN'
2998 include 'COMMON.DERIV'
2999 include 'COMMON.LOCAL'
3000 include 'COMMON.INTERACT'
3001 include 'COMMON.VAR'
3002 include 'COMMON.IOUNITS'
3003 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3008 dxi=dc_norm(1,nres+i)
3009 dyi=dc_norm(2,nres+i)
3010 dzi=dc_norm(3,nres+i)
3011 dsci_inv=dsc_inv(itypi)
3013 dscj_inv=dsc_inv(itypj)
3017 dxj=dc_norm(1,nres+j)
3018 dyj=dc_norm(2,nres+j)
3019 dzj=dc_norm(3,nres+j)
3020 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3025 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3026 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3027 om12=dxi*dxj+dyi*dyj+dzi*dzj
3029 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3030 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3036 deltat12=om2-om1+2.0d0
3038 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3039 & +akct*deltad*deltat12+ebr
3040 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3041 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3042 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3043 c & " deltat12",deltat12," eij",eij
3044 ed=2*akcm*deltad+akct*deltat12
3046 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3047 eom1=-2*akth*deltat1-pom1-om2*pom2
3048 eom2= 2*akth*deltat2+pom1-om1*pom2
3051 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3054 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3055 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3056 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3057 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3060 C Calculate the components of the gradient in DC and X
3064 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3070 C--------------------------------------------------------------------------
3073 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3074 subroutine e_modeller(ehomology_constr)
3075 implicit real*8 (a-h,o-z)
3077 include 'DIMENSIONS'
3079 integer nnn, i, j, k, ki, irec, l
3080 integer katy, odleglosci, test7
3081 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3082 real*8 distance(max_template),distancek(max_template),
3083 & min_odl,godl(max_template),dih_diff(max_template)
3085 include 'COMMON.SBRIDGE'
3086 include 'COMMON.CHAIN'
3087 include 'COMMON.GEO'
3088 include 'COMMON.DERIV'
3089 include 'COMMON.LOCAL'
3090 include 'COMMON.INTERACT'
3091 include 'COMMON.VAR'
3092 include 'COMMON.IOUNITS'
3093 include 'COMMON.CONTROL'
3097 distancek(i)=9999999.9
3102 write (iout,*) "waga_dist",waga_dist
3103 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3105 C AL 5/2/14 - Introduce list of restraints
3106 do ii = link_start_homo,link_end_homo
3110 do k=1,constr_homology
3111 distance(k)=odl(k,ii)-dij
3112 distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3115 min_odl=minval(distancek)
3117 write (iout,*) "ij dij",i,j,dij
3118 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3119 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3120 write (iout,* )"min_odl",min_odl
3123 do k=1,constr_homology
3124 c Nie wiem po co to liczycie jeszcze raz!
3125 c odleg3=-waga_dist*((distance(i,j,k)**2)/
3126 c & (2*(sigma_odl(i,j,k))**2))
3127 godl(k)=dexp(-distancek(k)+min_odl)
3128 odleg2=odleg2+godl(k)
3130 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3131 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3132 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3133 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3137 write (iout,*) "godl",(godl(k),k=1,constr_homology)
3138 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2
3140 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3144 do k=1,constr_homology
3145 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3146 c & *waga_dist)+min_odl
3147 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3148 sum_sgodl=sum_sgodl+sgodl
3150 c sgodl2=sgodl2+sgodl
3151 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3152 c write(iout,*) "constr_homology=",constr_homology
3153 c write(iout,*) i, j, k, "TEST K"
3156 grad_odl3=sum_sgodl/(sum_godl*dij)
3159 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3160 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3161 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3163 ccc write(iout,*) godl, sgodl, grad_odl3
3165 c grad_odl=grad_odl+grad_odl3
3168 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3169 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3170 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3171 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3172 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3173 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3174 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3175 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3178 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3179 ccc & dLOG(odleg2),"-odleg=", -odleg
3182 c Pseudo-energy and gradient from dihedral-angle restraints from
3183 c homology templates
3184 c write (iout,*) "End of distance loop"
3187 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3188 do i=idihconstr_start_homo,idihconstr_end_homo
3190 c betai=beta(i,i+1,i+2,i+3)
3192 do k=1,constr_homology
3193 dih_diff(k)=pinorm(dih(k,i)-betai)
3194 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3195 c & -(6.28318-dih_diff(i,k))
3196 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3197 c & 6.28318+dih_diff(i,k)
3199 kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3202 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3206 write (iout,*) "i",i," betai",betai," kat2",kat2
3207 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3209 if (kat2.le.1.0d-14) cycle
3210 kat=kat-dLOG(kat2/constr_homology)
3212 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3213 ccc & dLOG(kat2), "-kat=", -kat
3215 c ----------------------------------------------------------------------
3217 c ----------------------------------------------------------------------
3221 do k=1,constr_homology
3222 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3223 sum_sgdih=sum_sgdih+sgdih
3225 grad_dih3=sum_sgdih/sum_gdih
3227 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3228 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3229 ccc & gloc(nphi+i-3,icg)
3230 gloc(i,icg)=gloc(i,icg)+grad_dih3
3231 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3232 ccc & gloc(nphi+i-3,icg)
3237 c Total energy from homology restraints
3239 write (iout,*) "odleg",odleg," kat",kat
3241 ehomology_constr=odleg+kat
3244 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3245 747 format(a12,i4,i4,i4,f8.3,f8.3)
3246 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3247 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3248 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3249 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3255 C--------------------------------------------------------------------------
3256 subroutine ebond(estr)
3258 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3260 implicit real*8 (a-h,o-z)
3261 include 'DIMENSIONS'
3262 include 'COMMON.LOCAL'
3263 include 'COMMON.GEO'
3264 include 'COMMON.INTERACT'
3265 include 'COMMON.DERIV'
3266 include 'COMMON.VAR'
3267 include 'COMMON.CHAIN'
3268 include 'COMMON.IOUNITS'
3269 include 'COMMON.NAMES'
3270 include 'COMMON.FFIELD'
3271 include 'COMMON.CONTROL'
3272 double precision u(3),ud(3)
3275 diff = vbld(i)-vbldp0
3276 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3279 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3284 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3291 diff=vbld(i+nres)-vbldsc0(1,iti)
3292 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3293 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3294 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3296 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3300 diff=vbld(i+nres)-vbldsc0(j,iti)
3301 ud(j)=aksc(j,iti)*diff
3302 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3316 uprod2=uprod2*u(k)*u(k)
3320 usumsqder=usumsqder+ud(j)*uprod2
3322 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3323 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3324 estr=estr+uprod/usum
3326 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3334 C--------------------------------------------------------------------------
3335 subroutine ebend(etheta)
3337 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3338 C angles gamma and its derivatives in consecutive thetas and gammas.
3340 implicit real*8 (a-h,o-z)
3341 include 'DIMENSIONS'
3342 include 'sizesclu.dat'
3343 include 'COMMON.LOCAL'
3344 include 'COMMON.GEO'
3345 include 'COMMON.INTERACT'
3346 include 'COMMON.DERIV'
3347 include 'COMMON.VAR'
3348 include 'COMMON.CHAIN'
3349 include 'COMMON.IOUNITS'
3350 include 'COMMON.NAMES'
3351 include 'COMMON.FFIELD'
3352 common /calcthet/ term1,term2,termm,diffak,ratak,
3353 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3354 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3355 double precision y(2),z(2)
3357 time11=dexp(-2*time)
3360 c write (iout,*) "nres",nres
3361 c write (*,'(a,i2)') 'EBEND ICG=',icg
3362 c write (iout,*) ithet_start,ithet_end
3363 do i=ithet_start,ithet_end
3364 C Zero the energy function and its derivative at 0 or pi.
3365 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3367 c if (i.gt.ithet_start .and.
3368 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3369 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3377 c if (i.lt.nres .and. itel(i).ne.0) then
3389 call proc_proc(phii,icrc)
3390 if (icrc.eq.1) phii=150.0
3404 call proc_proc(phii1,icrc)
3405 if (icrc.eq.1) phii1=150.0
3417 C Calculate the "mean" value of theta from the part of the distribution
3418 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3419 C In following comments this theta will be referred to as t_c.
3420 thet_pred_mean=0.0d0
3424 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3426 c write (iout,*) "thet_pred_mean",thet_pred_mean
3427 dthett=thet_pred_mean*ssd
3428 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3429 c write (iout,*) "thet_pred_mean",thet_pred_mean
3430 C Derivatives of the "mean" values in gamma1 and gamma2.
3431 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3432 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3433 if (theta(i).gt.pi-delta) then
3434 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3436 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3437 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3438 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3440 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3442 else if (theta(i).lt.delta) then
3443 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3444 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3445 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3447 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3448 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3451 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3454 etheta=etheta+ethetai
3455 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3456 c & rad2deg*phii,rad2deg*phii1,ethetai
3457 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3458 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3459 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3462 C Ufff.... We've done all this!!!
3465 C---------------------------------------------------------------------------
3466 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3468 implicit real*8 (a-h,o-z)
3469 include 'DIMENSIONS'
3470 include 'COMMON.LOCAL'
3471 include 'COMMON.IOUNITS'
3472 common /calcthet/ term1,term2,termm,diffak,ratak,
3473 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3474 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3475 C Calculate the contributions to both Gaussian lobes.
3476 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3477 C The "polynomial part" of the "standard deviation" of this part of
3481 sig=sig*thet_pred_mean+polthet(j,it)
3483 C Derivative of the "interior part" of the "standard deviation of the"
3484 C gamma-dependent Gaussian lobe in t_c.
3485 sigtc=3*polthet(3,it)
3487 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3490 C Set the parameters of both Gaussian lobes of the distribution.
3491 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3492 fac=sig*sig+sigc0(it)
3495 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3496 sigsqtc=-4.0D0*sigcsq*sigtc
3497 c print *,i,sig,sigtc,sigsqtc
3498 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3499 sigtc=-sigtc/(fac*fac)
3500 C Following variable is sigma(t_c)**(-2)
3501 sigcsq=sigcsq*sigcsq
3503 sig0inv=1.0D0/sig0i**2
3504 delthec=thetai-thet_pred_mean
3505 delthe0=thetai-theta0i
3506 term1=-0.5D0*sigcsq*delthec*delthec
3507 term2=-0.5D0*sig0inv*delthe0*delthe0
3508 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3509 C NaNs in taking the logarithm. We extract the largest exponent which is added
3510 C to the energy (this being the log of the distribution) at the end of energy
3511 C term evaluation for this virtual-bond angle.
3512 if (term1.gt.term2) then
3514 term2=dexp(term2-termm)
3518 term1=dexp(term1-termm)
3521 C The ratio between the gamma-independent and gamma-dependent lobes of
3522 C the distribution is a Gaussian function of thet_pred_mean too.
3523 diffak=gthet(2,it)-thet_pred_mean
3524 ratak=diffak/gthet(3,it)**2
3525 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3526 C Let's differentiate it in thet_pred_mean NOW.
3528 C Now put together the distribution terms to make complete distribution.
3529 termexp=term1+ak*term2
3530 termpre=sigc+ak*sig0i
3531 C Contribution of the bending energy from this theta is just the -log of
3532 C the sum of the contributions from the two lobes and the pre-exponential
3533 C factor. Simple enough, isn't it?
3534 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3535 C NOW the derivatives!!!
3536 C 6/6/97 Take into account the deformation.
3537 E_theta=(delthec*sigcsq*term1
3538 & +ak*delthe0*sig0inv*term2)/termexp
3539 E_tc=((sigtc+aktc*sig0i)/termpre
3540 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3541 & aktc*term2)/termexp)
3544 c-----------------------------------------------------------------------------
3545 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3546 implicit real*8 (a-h,o-z)
3547 include 'DIMENSIONS'
3548 include 'COMMON.LOCAL'
3549 include 'COMMON.IOUNITS'
3550 common /calcthet/ term1,term2,termm,diffak,ratak,
3551 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3552 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3553 delthec=thetai-thet_pred_mean
3554 delthe0=thetai-theta0i
3555 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3556 t3 = thetai-thet_pred_mean
3560 t14 = t12+t6*sigsqtc
3562 t21 = thetai-theta0i
3568 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3569 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3570 & *(-t12*t9-ak*sig0inv*t27)
3574 C--------------------------------------------------------------------------
3575 subroutine ebend(etheta)
3577 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3578 C angles gamma and its derivatives in consecutive thetas and gammas.
3579 C ab initio-derived potentials from
3580 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3582 implicit real*8 (a-h,o-z)
3583 include 'DIMENSIONS'
3584 include 'COMMON.LOCAL'
3585 include 'COMMON.GEO'
3586 include 'COMMON.INTERACT'
3587 include 'COMMON.DERIV'
3588 include 'COMMON.VAR'
3589 include 'COMMON.CHAIN'
3590 include 'COMMON.IOUNITS'
3591 include 'COMMON.NAMES'
3592 include 'COMMON.FFIELD'
3593 include 'COMMON.CONTROL'
3594 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3595 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3596 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3597 & sinph1ph2(maxdouble,maxdouble)
3598 logical lprn /.false./, lprn1 /.false./
3600 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3601 do i=ithet_start,ithet_end
3605 theti2=0.5d0*theta(i)
3606 ityp2=ithetyp(itype(i-1))
3608 coskt(k)=dcos(k*theti2)
3609 sinkt(k)=dsin(k*theti2)
3614 if (phii.ne.phii) phii=150.0
3618 ityp1=ithetyp(itype(i-2))
3620 cosph1(k)=dcos(k*phii)
3621 sinph1(k)=dsin(k*phii)
3634 if (phii1.ne.phii1) phii1=150.0
3639 ityp3=ithetyp(itype(i))
3641 cosph2(k)=dcos(k*phii1)
3642 sinph2(k)=dsin(k*phii1)
3652 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3653 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3655 ethetai=aa0thet(ityp1,ityp2,ityp3)
3658 ccl=cosph1(l)*cosph2(k-l)
3659 ssl=sinph1(l)*sinph2(k-l)
3660 scl=sinph1(l)*cosph2(k-l)
3661 csl=cosph1(l)*sinph2(k-l)
3662 cosph1ph2(l,k)=ccl-ssl
3663 cosph1ph2(k,l)=ccl+ssl
3664 sinph1ph2(l,k)=scl+csl
3665 sinph1ph2(k,l)=scl-csl
3669 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3670 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3671 write (iout,*) "coskt and sinkt"
3673 write (iout,*) k,coskt(k),sinkt(k)
3677 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3678 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3681 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3682 & " ethetai",ethetai
3685 write (iout,*) "cosph and sinph"
3687 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3689 write (iout,*) "cosph1ph2 and sinph2ph2"
3692 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3693 & sinph1ph2(l,k),sinph1ph2(k,l)
3696 write(iout,*) "ethetai",ethetai
3700 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3701 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3702 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3703 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3704 ethetai=ethetai+sinkt(m)*aux
3705 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3706 dephii=dephii+k*sinkt(m)*(
3707 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3708 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3709 dephii1=dephii1+k*sinkt(m)*(
3710 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3711 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3713 & write (iout,*) "m",m," k",k," bbthet",
3714 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3715 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3716 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3717 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3721 & write(iout,*) "ethetai",ethetai
3725 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3726 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3727 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3728 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3729 ethetai=ethetai+sinkt(m)*aux
3730 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3731 dephii=dephii+l*sinkt(m)*(
3732 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3733 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3734 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3735 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3736 dephii1=dephii1+(k-l)*sinkt(m)*(
3737 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3738 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3739 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3740 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3742 write (iout,*) "m",m," k",k," l",l," ffthet",
3743 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3744 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3745 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3746 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3747 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3748 & cosph1ph2(k,l)*sinkt(m),
3749 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3755 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3756 & i,theta(i)*rad2deg,phii*rad2deg,
3757 & phii1*rad2deg,ethetai
3758 etheta=etheta+ethetai
3759 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3760 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3761 gloc(nphi+i-2,icg)=wang*dethetai
3767 c-----------------------------------------------------------------------------
3768 subroutine esc(escloc)
3769 C Calculate the local energy of a side chain and its derivatives in the
3770 C corresponding virtual-bond valence angles THETA and the spherical angles
3772 implicit real*8 (a-h,o-z)
3773 include 'DIMENSIONS'
3774 include 'sizesclu.dat'
3775 include 'COMMON.GEO'
3776 include 'COMMON.LOCAL'
3777 include 'COMMON.VAR'
3778 include 'COMMON.INTERACT'
3779 include 'COMMON.DERIV'
3780 include 'COMMON.CHAIN'
3781 include 'COMMON.IOUNITS'
3782 include 'COMMON.NAMES'
3783 include 'COMMON.FFIELD'
3784 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3785 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3786 common /sccalc/ time11,time12,time112,theti,it,nlobit
3789 c write (iout,'(a)') 'ESC'
3790 do i=loc_start,loc_end
3792 if (it.eq.10) goto 1
3794 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3795 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3796 theti=theta(i+1)-pipol
3800 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3802 if (x(2).gt.pi-delta) then
3806 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3808 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3809 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3811 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3812 & ddersc0(1),dersc(1))
3813 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3814 & ddersc0(3),dersc(3))
3816 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3818 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3819 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3820 & dersc0(2),esclocbi,dersc02)
3821 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3823 call splinthet(x(2),0.5d0*delta,ss,ssd)
3828 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3830 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3831 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3833 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3835 c write (iout,*) escloci
3836 else if (x(2).lt.delta) then
3840 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3842 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3843 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3845 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3846 & ddersc0(1),dersc(1))
3847 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3848 & ddersc0(3),dersc(3))
3850 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3852 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3853 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3854 & dersc0(2),esclocbi,dersc02)
3855 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3860 call splinthet(x(2),0.5d0*delta,ss,ssd)
3862 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3864 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3865 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3867 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3868 c write (iout,*) escloci
3870 call enesc(x,escloci,dersc,ddummy,.false.)
3873 escloc=escloc+escloci
3874 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3876 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3878 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3879 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3884 C---------------------------------------------------------------------------
3885 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3886 implicit real*8 (a-h,o-z)
3887 include 'DIMENSIONS'
3888 include 'COMMON.GEO'
3889 include 'COMMON.LOCAL'
3890 include 'COMMON.IOUNITS'
3891 common /sccalc/ time11,time12,time112,theti,it,nlobit
3892 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3893 double precision contr(maxlob,-1:1)
3895 c write (iout,*) 'it=',it,' nlobit=',nlobit
3899 if (mixed) ddersc(j)=0.0d0
3903 C Because of periodicity of the dependence of the SC energy in omega we have
3904 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3905 C To avoid underflows, first compute & store the exponents.
3913 z(k)=x(k)-censc(k,j,it)
3918 Axk=Axk+gaussc(l,k,j,it)*z(l)
3924 expfac=expfac+Ax(k,j,iii)*z(k)
3932 C As in the case of ebend, we want to avoid underflows in exponentiation and
3933 C subsequent NaNs and INFs in energy calculation.
3934 C Find the largest exponent
3938 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3942 cd print *,'it=',it,' emin=',emin
3944 C Compute the contribution to SC energy and derivatives
3948 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3949 cd print *,'j=',j,' expfac=',expfac
3950 escloc_i=escloc_i+expfac
3952 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3956 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3957 & +gaussc(k,2,j,it))*expfac
3964 dersc(1)=dersc(1)/cos(theti)**2
3965 ddersc(1)=ddersc(1)/cos(theti)**2
3968 escloci=-(dlog(escloc_i)-emin)
3970 dersc(j)=dersc(j)/escloc_i
3974 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3979 C------------------------------------------------------------------------------
3980 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3981 implicit real*8 (a-h,o-z)
3982 include 'DIMENSIONS'
3983 include 'COMMON.GEO'
3984 include 'COMMON.LOCAL'
3985 include 'COMMON.IOUNITS'
3986 common /sccalc/ time11,time12,time112,theti,it,nlobit
3987 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3988 double precision contr(maxlob)
3999 z(k)=x(k)-censc(k,j,it)
4005 Axk=Axk+gaussc(l,k,j,it)*z(l)
4011 expfac=expfac+Ax(k,j)*z(k)
4016 C As in the case of ebend, we want to avoid underflows in exponentiation and
4017 C subsequent NaNs and INFs in energy calculation.
4018 C Find the largest exponent
4021 if (emin.gt.contr(j)) emin=contr(j)
4025 C Compute the contribution to SC energy and derivatives
4029 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4030 escloc_i=escloc_i+expfac
4032 dersc(k)=dersc(k)+Ax(k,j)*expfac
4034 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4035 & +gaussc(1,2,j,it))*expfac
4039 dersc(1)=dersc(1)/cos(theti)**2
4040 dersc12=dersc12/cos(theti)**2
4041 escloci=-(dlog(escloc_i)-emin)
4043 dersc(j)=dersc(j)/escloc_i
4045 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4049 c----------------------------------------------------------------------------------
4050 subroutine esc(escloc)
4051 C Calculate the local energy of a side chain and its derivatives in the
4052 C corresponding virtual-bond valence angles THETA and the spherical angles
4053 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4054 C added by Urszula Kozlowska. 07/11/2007
4056 implicit real*8 (a-h,o-z)
4057 include 'DIMENSIONS'
4058 include 'COMMON.GEO'
4059 include 'COMMON.LOCAL'
4060 include 'COMMON.VAR'
4061 include 'COMMON.SCROT'
4062 include 'COMMON.INTERACT'
4063 include 'COMMON.DERIV'
4064 include 'COMMON.CHAIN'
4065 include 'COMMON.IOUNITS'
4066 include 'COMMON.NAMES'
4067 include 'COMMON.FFIELD'
4068 include 'COMMON.CONTROL'
4069 include 'COMMON.VECTORS'
4070 double precision x_prime(3),y_prime(3),z_prime(3)
4071 & , sumene,dsc_i,dp2_i,x(65),
4072 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4073 & de_dxx,de_dyy,de_dzz,de_dt
4074 double precision s1_t,s1_6_t,s2_t,s2_6_t
4076 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4077 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4078 & dt_dCi(3),dt_dCi1(3)
4079 common /sccalc/ time11,time12,time112,theti,it,nlobit
4082 do i=loc_start,loc_end
4083 costtab(i+1) =dcos(theta(i+1))
4084 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4085 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4086 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4087 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4088 cosfac=dsqrt(cosfac2)
4089 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4090 sinfac=dsqrt(sinfac2)
4092 if (it.eq.10) goto 1
4094 C Compute the axes of tghe local cartesian coordinates system; store in
4095 c x_prime, y_prime and z_prime
4102 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4103 C & dc_norm(3,i+nres)
4105 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4106 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4109 z_prime(j) = -uz(j,i-1)
4112 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4113 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4114 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4115 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4116 c & " xy",scalar(x_prime(1),y_prime(1)),
4117 c & " xz",scalar(x_prime(1),z_prime(1)),
4118 c & " yy",scalar(y_prime(1),y_prime(1)),
4119 c & " yz",scalar(y_prime(1),z_prime(1)),
4120 c & " zz",scalar(z_prime(1),z_prime(1))
4122 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4123 C to local coordinate system. Store in xx, yy, zz.
4129 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4130 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4131 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4138 C Compute the energy of the ith side cbain
4140 c write (2,*) "xx",xx," yy",yy," zz",zz
4143 x(j) = sc_parmin(j,it)
4146 Cc diagnostics - remove later
4148 yy1 = dsin(alph(2))*dcos(omeg(2))
4149 zz1 = -dsin(alph(2))*dsin(omeg(2))
4150 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4151 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4153 C," --- ", xx_w,yy_w,zz_w
4156 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4157 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4159 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4160 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4162 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4163 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4164 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4165 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4166 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4168 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4169 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4170 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4171 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4172 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4174 dsc_i = 0.743d0+x(61)
4176 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4177 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4178 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4179 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4180 s1=(1+x(63))/(0.1d0 + dscp1)
4181 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4182 s2=(1+x(65))/(0.1d0 + dscp2)
4183 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4184 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4185 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4186 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4188 c & dscp1,dscp2,sumene
4189 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4190 escloc = escloc + sumene
4191 c write (2,*) "escloc",escloc
4192 if (.not. calc_grad) goto 1
4195 C This section to check the numerical derivatives of the energy of ith side
4196 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4197 C #define DEBUG in the code to turn it on.
4199 write (2,*) "sumene =",sumene
4203 write (2,*) xx,yy,zz
4204 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4205 de_dxx_num=(sumenep-sumene)/aincr
4207 write (2,*) "xx+ sumene from enesc=",sumenep
4210 write (2,*) xx,yy,zz
4211 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4212 de_dyy_num=(sumenep-sumene)/aincr
4214 write (2,*) "yy+ sumene from enesc=",sumenep
4217 write (2,*) xx,yy,zz
4218 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4219 de_dzz_num=(sumenep-sumene)/aincr
4221 write (2,*) "zz+ sumene from enesc=",sumenep
4222 costsave=cost2tab(i+1)
4223 sintsave=sint2tab(i+1)
4224 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4225 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4226 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4227 de_dt_num=(sumenep-sumene)/aincr
4228 write (2,*) " t+ sumene from enesc=",sumenep
4229 cost2tab(i+1)=costsave
4230 sint2tab(i+1)=sintsave
4231 C End of diagnostics section.
4234 C Compute the gradient of esc
4236 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4237 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4238 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4239 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4240 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4241 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4242 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4243 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4244 pom1=(sumene3*sint2tab(i+1)+sumene1)
4245 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4246 pom2=(sumene4*cost2tab(i+1)+sumene2)
4247 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4248 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4249 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4250 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4252 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4253 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4254 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4256 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4257 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4258 & +(pom1+pom2)*pom_dx
4260 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4263 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4264 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4265 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4267 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4268 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4269 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4270 & +x(59)*zz**2 +x(60)*xx*zz
4271 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4272 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4273 & +(pom1-pom2)*pom_dy
4275 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4278 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4279 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4280 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4281 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4282 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4283 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4284 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4285 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4287 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4290 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4291 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4292 & +pom1*pom_dt1+pom2*pom_dt2
4294 write(2,*), "de_dt = ", de_dt,de_dt_num
4298 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4299 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4300 cosfac2xx=cosfac2*xx
4301 sinfac2yy=sinfac2*yy
4303 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4305 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4307 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4308 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4309 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4310 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4311 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4312 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4313 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4314 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4315 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4316 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4320 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4321 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4324 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4325 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4326 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4328 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4329 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4333 dXX_Ctab(k,i)=dXX_Ci(k)
4334 dXX_C1tab(k,i)=dXX_Ci1(k)
4335 dYY_Ctab(k,i)=dYY_Ci(k)
4336 dYY_C1tab(k,i)=dYY_Ci1(k)
4337 dZZ_Ctab(k,i)=dZZ_Ci(k)
4338 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4339 dXX_XYZtab(k,i)=dXX_XYZ(k)
4340 dYY_XYZtab(k,i)=dYY_XYZ(k)
4341 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4345 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4346 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4347 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4348 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4349 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4351 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4352 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4353 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4354 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4355 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4356 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4357 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4358 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4360 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4361 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4363 C to check gradient call subroutine check_grad
4370 c------------------------------------------------------------------------------
4371 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4373 C This procedure calculates two-body contact function g(rij) and its derivative:
4376 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4379 C where x=(rij-r0ij)/delta
4381 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4384 double precision rij,r0ij,eps0ij,fcont,fprimcont
4385 double precision x,x2,x4,delta
4389 if (x.lt.-1.0D0) then
4392 else if (x.le.1.0D0) then
4395 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4396 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4403 c------------------------------------------------------------------------------
4404 subroutine splinthet(theti,delta,ss,ssder)
4405 implicit real*8 (a-h,o-z)
4406 include 'DIMENSIONS'
4407 include 'sizesclu.dat'
4408 include 'COMMON.VAR'
4409 include 'COMMON.GEO'
4412 if (theti.gt.pipol) then
4413 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4415 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4420 c------------------------------------------------------------------------------
4421 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4423 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4424 double precision ksi,ksi2,ksi3,a1,a2,a3
4425 a1=fprim0*delta/(f1-f0)
4431 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4432 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4435 c------------------------------------------------------------------------------
4436 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4438 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4439 double precision ksi,ksi2,ksi3,a1,a2,a3
4444 a2=3*(f1x-f0x)-2*fprim0x*delta
4445 a3=fprim0x*delta-2*(f1x-f0x)
4446 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4449 C-----------------------------------------------------------------------------
4451 C-----------------------------------------------------------------------------
4452 subroutine etor(etors,edihcnstr,fact)
4453 implicit real*8 (a-h,o-z)
4454 include 'DIMENSIONS'
4455 include 'sizesclu.dat'
4456 include 'COMMON.VAR'
4457 include 'COMMON.GEO'
4458 include 'COMMON.LOCAL'
4459 include 'COMMON.TORSION'
4460 include 'COMMON.INTERACT'
4461 include 'COMMON.DERIV'
4462 include 'COMMON.CHAIN'
4463 include 'COMMON.NAMES'
4464 include 'COMMON.IOUNITS'
4465 include 'COMMON.FFIELD'
4466 include 'COMMON.TORCNSTR'
4468 C Set lprn=.true. for debugging
4472 do i=iphi_start,iphi_end
4473 itori=itortyp(itype(i-2))
4474 itori1=itortyp(itype(i-1))
4477 C Proline-Proline pair is a special case...
4478 if (itori.eq.3 .and. itori1.eq.3) then
4479 if (phii.gt.-dwapi3) then
4481 fac=1.0D0/(1.0D0-cosphi)
4482 etorsi=v1(1,3,3)*fac
4483 etorsi=etorsi+etorsi
4484 etors=etors+etorsi-v1(1,3,3)
4485 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4488 v1ij=v1(j+1,itori,itori1)
4489 v2ij=v2(j+1,itori,itori1)
4492 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4493 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4497 v1ij=v1(j,itori,itori1)
4498 v2ij=v2(j,itori,itori1)
4501 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4502 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4506 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4507 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4508 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4509 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4510 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4512 ! 6/20/98 - dihedral angle constraints
4515 itori=idih_constr(i)
4517 difi=pinorm(phii-phi0(i))
4518 if (difi.gt.drange(i)) then
4520 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4521 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4522 else if (difi.lt.-drange(i)) then
4524 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4525 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4527 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4528 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4530 write (iout,*) 'edihcnstr',edihcnstr
4533 c------------------------------------------------------------------------------
4535 subroutine etor(etors,edihcnstr,fact)
4536 implicit real*8 (a-h,o-z)
4537 include 'DIMENSIONS'
4538 include 'sizesclu.dat'
4539 include 'COMMON.VAR'
4540 include 'COMMON.GEO'
4541 include 'COMMON.LOCAL'
4542 include 'COMMON.TORSION'
4543 include 'COMMON.INTERACT'
4544 include 'COMMON.DERIV'
4545 include 'COMMON.CHAIN'
4546 include 'COMMON.NAMES'
4547 include 'COMMON.IOUNITS'
4548 include 'COMMON.FFIELD'
4549 include 'COMMON.TORCNSTR'
4551 C Set lprn=.true. for debugging
4555 do i=iphi_start,iphi_end
4556 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4557 itori=itortyp(itype(i-2))
4558 itori1=itortyp(itype(i-1))
4561 C Regular cosine and sine terms
4562 do j=1,nterm(itori,itori1)
4563 v1ij=v1(j,itori,itori1)
4564 v2ij=v2(j,itori,itori1)
4567 etors=etors+v1ij*cosphi+v2ij*sinphi
4568 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4572 C E = SUM ----------------------------------- - v1
4573 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4575 cosphi=dcos(0.5d0*phii)
4576 sinphi=dsin(0.5d0*phii)
4577 do j=1,nlor(itori,itori1)
4578 vl1ij=vlor1(j,itori,itori1)
4579 vl2ij=vlor2(j,itori,itori1)
4580 vl3ij=vlor3(j,itori,itori1)
4581 pom=vl2ij*cosphi+vl3ij*sinphi
4582 pom1=1.0d0/(pom*pom+1.0d0)
4583 etors=etors+vl1ij*pom1
4585 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4587 C Subtract the constant term
4588 etors=etors-v0(itori,itori1)
4590 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4591 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4592 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4593 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4594 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4597 ! 6/20/98 - dihedral angle constraints
4599 c write (iout,*) "Dihedral angle restraint energy"
4601 itori=idih_constr(i)
4603 difi=pinorm(phii-phi0(i))
4604 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4605 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4606 if (difi.gt.drange(i)) then
4608 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4609 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4610 c write (iout,*) 0.25d0*ftors*difi**4
4611 else if (difi.lt.-drange(i)) then
4613 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4614 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4615 c write (iout,*) 0.25d0*ftors*difi**4
4618 c write (iout,*) 'edihcnstr',edihcnstr
4621 c----------------------------------------------------------------------------
4622 subroutine etor_d(etors_d,fact2)
4623 C 6/23/01 Compute double torsional energy
4624 implicit real*8 (a-h,o-z)
4625 include 'DIMENSIONS'
4626 include 'sizesclu.dat'
4627 include 'COMMON.VAR'
4628 include 'COMMON.GEO'
4629 include 'COMMON.LOCAL'
4630 include 'COMMON.TORSION'
4631 include 'COMMON.INTERACT'
4632 include 'COMMON.DERIV'
4633 include 'COMMON.CHAIN'
4634 include 'COMMON.NAMES'
4635 include 'COMMON.IOUNITS'
4636 include 'COMMON.FFIELD'
4637 include 'COMMON.TORCNSTR'
4639 C Set lprn=.true. for debugging
4643 do i=iphi_start,iphi_end-1
4644 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4646 itori=itortyp(itype(i-2))
4647 itori1=itortyp(itype(i-1))
4648 itori2=itortyp(itype(i))
4653 C Regular cosine and sine terms
4654 do j=1,ntermd_1(itori,itori1,itori2)
4655 v1cij=v1c(1,j,itori,itori1,itori2)
4656 v1sij=v1s(1,j,itori,itori1,itori2)
4657 v2cij=v1c(2,j,itori,itori1,itori2)
4658 v2sij=v1s(2,j,itori,itori1,itori2)
4659 cosphi1=dcos(j*phii)
4660 sinphi1=dsin(j*phii)
4661 cosphi2=dcos(j*phii1)
4662 sinphi2=dsin(j*phii1)
4663 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4664 & v2cij*cosphi2+v2sij*sinphi2
4665 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4666 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4668 do k=2,ntermd_2(itori,itori1,itori2)
4670 v1cdij = v2c(k,l,itori,itori1,itori2)
4671 v2cdij = v2c(l,k,itori,itori1,itori2)
4672 v1sdij = v2s(k,l,itori,itori1,itori2)
4673 v2sdij = v2s(l,k,itori,itori1,itori2)
4674 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4675 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4676 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4677 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4678 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4679 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4680 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4681 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4682 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4683 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4686 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4687 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4693 c------------------------------------------------------------------------------
4694 subroutine eback_sc_corr(esccor,fact)
4695 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4696 c conformational states; temporarily implemented as differences
4697 c between UNRES torsional potentials (dependent on three types of
4698 c residues) and the torsional potentials dependent on all 20 types
4699 c of residues computed from AM1 energy surfaces of terminally-blocked
4700 c amino-acid residues.
4701 implicit real*8 (a-h,o-z)
4702 include 'DIMENSIONS'
4703 include 'COMMON.VAR'
4704 include 'COMMON.GEO'
4705 include 'COMMON.LOCAL'
4706 include 'COMMON.TORSION'
4707 include 'COMMON.SCCOR'
4708 include 'COMMON.INTERACT'
4709 include 'COMMON.DERIV'
4710 include 'COMMON.CHAIN'
4711 include 'COMMON.NAMES'
4712 include 'COMMON.IOUNITS'
4713 include 'COMMON.FFIELD'
4714 include 'COMMON.CONTROL'
4716 C Set lprn=.true. for debugging
4719 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4721 do i=itau_start,itau_end
4723 isccori=isccortyp(itype(i-2))
4724 isccori1=isccortyp(itype(i-1))
4726 cccc Added 9 May 2012
4727 cc Tauangle is torsional engle depending on the value of first digit
4728 c(see comment below)
4729 cc Omicron is flat angle depending on the value of first digit
4730 c(see comment below)
4733 do intertyp=1,3 !intertyp
4734 cc Added 09 May 2012 (Adasko)
4735 cc Intertyp means interaction type of backbone mainchain correlation:
4736 c 1 = SC...Ca...Ca...Ca
4737 c 2 = Ca...Ca...Ca...SC
4738 c 3 = SC...Ca...Ca...SCi
4740 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4741 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4742 & (itype(i-1).eq.21)))
4743 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4744 & .or.(itype(i-2).eq.21)))
4745 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4746 & (itype(i-1).eq.21)))) cycle
4747 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4748 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4750 do j=1,nterm_sccor(isccori,isccori1)
4751 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4752 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4753 cosphi=dcos(j*tauangle(intertyp,i))
4754 sinphi=dsin(j*tauangle(intertyp,i))
4755 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4756 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4758 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4759 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4760 c &gloc_sc(intertyp,i-3,icg)
4762 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4763 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4764 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4765 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4766 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4772 c------------------------------------------------------------------------------
4773 subroutine multibody(ecorr)
4774 C This subroutine calculates multi-body contributions to energy following
4775 C the idea of Skolnick et al. If side chains I and J make a contact and
4776 C at the same time side chains I+1 and J+1 make a contact, an extra
4777 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4778 implicit real*8 (a-h,o-z)
4779 include 'DIMENSIONS'
4780 include 'COMMON.IOUNITS'
4781 include 'COMMON.DERIV'
4782 include 'COMMON.INTERACT'
4783 include 'COMMON.CONTACTS'
4784 double precision gx(3),gx1(3)
4787 C Set lprn=.true. for debugging
4791 write (iout,'(a)') 'Contact function values:'
4793 write (iout,'(i2,20(1x,i2,f10.5))')
4794 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4809 num_conti=num_cont(i)
4810 num_conti1=num_cont(i1)
4815 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4816 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4817 cd & ' ishift=',ishift
4818 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4819 C The system gains extra energy.
4820 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4821 endif ! j1==j+-ishift
4830 c------------------------------------------------------------------------------
4831 double precision function esccorr(i,j,k,l,jj,kk)
4832 implicit real*8 (a-h,o-z)
4833 include 'DIMENSIONS'
4834 include 'COMMON.IOUNITS'
4835 include 'COMMON.DERIV'
4836 include 'COMMON.INTERACT'
4837 include 'COMMON.CONTACTS'
4838 double precision gx(3),gx1(3)
4843 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4844 C Calculate the multi-body contribution to energy.
4845 C Calculate multi-body contributions to the gradient.
4846 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4847 cd & k,l,(gacont(m,kk,k),m=1,3)
4849 gx(m) =ekl*gacont(m,jj,i)
4850 gx1(m)=eij*gacont(m,kk,k)
4851 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4852 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4853 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4854 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4858 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4863 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4869 c------------------------------------------------------------------------------
4871 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4872 implicit real*8 (a-h,o-z)
4873 include 'DIMENSIONS'
4874 integer dimen1,dimen2,atom,indx
4875 double precision buffer(dimen1,dimen2)
4876 double precision zapas
4877 common /contacts_hb/ zapas(3,20,maxres,7),
4878 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4879 & num_cont_hb(maxres),jcont_hb(20,maxres)
4880 num_kont=num_cont_hb(atom)
4884 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4887 buffer(i,indx+22)=facont_hb(i,atom)
4888 buffer(i,indx+23)=ees0p(i,atom)
4889 buffer(i,indx+24)=ees0m(i,atom)
4890 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4892 buffer(1,indx+26)=dfloat(num_kont)
4895 c------------------------------------------------------------------------------
4896 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4897 implicit real*8 (a-h,o-z)
4898 include 'DIMENSIONS'
4899 integer dimen1,dimen2,atom,indx
4900 double precision buffer(dimen1,dimen2)
4901 double precision zapas
4902 common /contacts_hb/ zapas(3,20,maxres,7),
4903 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4904 & num_cont_hb(maxres),jcont_hb(20,maxres)
4905 num_kont=buffer(1,indx+26)
4906 num_kont_old=num_cont_hb(atom)
4907 num_cont_hb(atom)=num_kont+num_kont_old
4912 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4915 facont_hb(ii,atom)=buffer(i,indx+22)
4916 ees0p(ii,atom)=buffer(i,indx+23)
4917 ees0m(ii,atom)=buffer(i,indx+24)
4918 jcont_hb(ii,atom)=buffer(i,indx+25)
4922 c------------------------------------------------------------------------------
4924 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4925 C This subroutine calculates multi-body contributions to hydrogen-bonding
4926 implicit real*8 (a-h,o-z)
4927 include 'DIMENSIONS'
4928 include 'sizesclu.dat'
4929 include 'COMMON.IOUNITS'
4931 include 'COMMON.INFO'
4933 include 'COMMON.FFIELD'
4934 include 'COMMON.DERIV'
4935 include 'COMMON.INTERACT'
4936 include 'COMMON.CONTACTS'
4938 parameter (max_cont=maxconts)
4939 parameter (max_dim=2*(8*3+2))
4940 parameter (msglen1=max_cont*max_dim*4)
4941 parameter (msglen2=2*msglen1)
4942 integer source,CorrelType,CorrelID,Error
4943 double precision buffer(max_cont,max_dim)
4945 double precision gx(3),gx1(3)
4948 C Set lprn=.true. for debugging
4953 if (fgProcs.le.1) goto 30
4955 write (iout,'(a)') 'Contact function values:'
4957 write (iout,'(2i3,50(1x,i2,f5.2))')
4958 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4959 & j=1,num_cont_hb(i))
4962 C Caution! Following code assumes that electrostatic interactions concerning
4963 C a given atom are split among at most two processors!
4973 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4976 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4977 if (MyRank.gt.0) then
4978 C Send correlation contributions to the preceding processor
4980 nn=num_cont_hb(iatel_s)
4981 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4982 cd write (iout,*) 'The BUFFER array:'
4984 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4986 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4988 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4989 C Clear the contacts of the atom passed to the neighboring processor
4990 nn=num_cont_hb(iatel_s+1)
4992 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4994 num_cont_hb(iatel_s)=0
4996 cd write (iout,*) 'Processor ',MyID,MyRank,
4997 cd & ' is sending correlation contribution to processor',MyID-1,
4998 cd & ' msglen=',msglen
4999 cd write (*,*) 'Processor ',MyID,MyRank,
5000 cd & ' is sending correlation contribution to processor',MyID-1,
5001 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5002 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5003 cd write (iout,*) 'Processor ',MyID,
5004 cd & ' has sent correlation contribution to processor',MyID-1,
5005 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5006 cd write (*,*) 'Processor ',MyID,
5007 cd & ' has sent correlation contribution to processor',MyID-1,
5008 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5010 endif ! (MyRank.gt.0)
5014 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5015 if (MyRank.lt.fgProcs-1) then
5016 C Receive correlation contributions from the next processor
5018 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5019 cd write (iout,*) 'Processor',MyID,
5020 cd & ' is receiving correlation contribution from processor',MyID+1,
5021 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5022 cd write (*,*) 'Processor',MyID,
5023 cd & ' is receiving correlation contribution from processor',MyID+1,
5024 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5026 do while (nbytes.le.0)
5027 call mp_probe(MyID+1,CorrelType,nbytes)
5029 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5030 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5031 cd write (iout,*) 'Processor',MyID,
5032 cd & ' has received correlation contribution from processor',MyID+1,
5033 cd & ' msglen=',msglen,' nbytes=',nbytes
5034 cd write (iout,*) 'The received BUFFER array:'
5036 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5038 if (msglen.eq.msglen1) then
5039 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5040 else if (msglen.eq.msglen2) then
5041 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5042 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5045 & 'ERROR!!!! message length changed while processing correlations.'
5047 & 'ERROR!!!! message length changed while processing correlations.'
5048 call mp_stopall(Error)
5049 endif ! msglen.eq.msglen1
5050 endif ! MyRank.lt.fgProcs-1
5057 write (iout,'(a)') 'Contact function values:'
5059 write (iout,'(2i3,50(1x,i2,f5.2))')
5060 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5061 & j=1,num_cont_hb(i))
5065 C Remove the loop below after debugging !!!
5072 C Calculate the local-electrostatic correlation terms
5073 do i=iatel_s,iatel_e+1
5075 num_conti=num_cont_hb(i)
5076 num_conti1=num_cont_hb(i+1)
5081 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5082 c & ' jj=',jj,' kk=',kk
5083 if (j1.eq.j+1 .or. j1.eq.j-1) then
5084 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5085 C The system gains extra energy.
5086 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5088 else if (j1.eq.j) then
5089 C Contacts I-J and I-(J+1) occur simultaneously.
5090 C The system loses extra energy.
5091 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5096 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5097 c & ' jj=',jj,' kk=',kk
5099 C Contacts I-J and (I+1)-J occur simultaneously.
5100 C The system loses extra energy.
5101 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5108 c------------------------------------------------------------------------------
5109 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5111 C This subroutine calculates multi-body contributions to hydrogen-bonding
5112 implicit real*8 (a-h,o-z)
5113 include 'DIMENSIONS'
5114 include 'sizesclu.dat'
5115 include 'COMMON.IOUNITS'
5117 include 'COMMON.INFO'
5119 include 'COMMON.FFIELD'
5120 include 'COMMON.DERIV'
5121 include 'COMMON.INTERACT'
5122 include 'COMMON.CONTACTS'
5124 parameter (max_cont=maxconts)
5125 parameter (max_dim=2*(8*3+2))
5126 parameter (msglen1=max_cont*max_dim*4)
5127 parameter (msglen2=2*msglen1)
5128 integer source,CorrelType,CorrelID,Error
5129 double precision buffer(max_cont,max_dim)
5131 double precision gx(3),gx1(3)
5134 C Set lprn=.true. for debugging
5141 if (fgProcs.le.1) goto 30
5143 write (iout,'(a)') 'Contact function values:'
5145 write (iout,'(2i3,50(1x,i2,f5.2))')
5146 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5147 & j=1,num_cont_hb(i))
5150 C Caution! Following code assumes that electrostatic interactions concerning
5151 C a given atom are split among at most two processors!
5161 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5164 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5165 if (MyRank.gt.0) then
5166 C Send correlation contributions to the preceding processor
5168 nn=num_cont_hb(iatel_s)
5169 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5170 cd write (iout,*) 'The BUFFER array:'
5172 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5174 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5176 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5177 C Clear the contacts of the atom passed to the neighboring processor
5178 nn=num_cont_hb(iatel_s+1)
5180 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5182 num_cont_hb(iatel_s)=0
5184 cd write (iout,*) 'Processor ',MyID,MyRank,
5185 cd & ' is sending correlation contribution to processor',MyID-1,
5186 cd & ' msglen=',msglen
5187 cd write (*,*) 'Processor ',MyID,MyRank,
5188 cd & ' is sending correlation contribution to processor',MyID-1,
5189 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5190 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5191 cd write (iout,*) 'Processor ',MyID,
5192 cd & ' has sent correlation contribution to processor',MyID-1,
5193 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5194 cd write (*,*) 'Processor ',MyID,
5195 cd & ' has sent correlation contribution to processor',MyID-1,
5196 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5198 endif ! (MyRank.gt.0)
5202 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5203 if (MyRank.lt.fgProcs-1) then
5204 C Receive correlation contributions from the next processor
5206 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5207 cd write (iout,*) 'Processor',MyID,
5208 cd & ' is receiving correlation contribution from processor',MyID+1,
5209 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5210 cd write (*,*) 'Processor',MyID,
5211 cd & ' is receiving correlation contribution from processor',MyID+1,
5212 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5214 do while (nbytes.le.0)
5215 call mp_probe(MyID+1,CorrelType,nbytes)
5217 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5218 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5219 cd write (iout,*) 'Processor',MyID,
5220 cd & ' has received correlation contribution from processor',MyID+1,
5221 cd & ' msglen=',msglen,' nbytes=',nbytes
5222 cd write (iout,*) 'The received BUFFER array:'
5224 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5226 if (msglen.eq.msglen1) then
5227 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5228 else if (msglen.eq.msglen2) then
5229 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5230 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5233 & 'ERROR!!!! message length changed while processing correlations.'
5235 & 'ERROR!!!! message length changed while processing correlations.'
5236 call mp_stopall(Error)
5237 endif ! msglen.eq.msglen1
5238 endif ! MyRank.lt.fgProcs-1
5245 write (iout,'(a)') 'Contact function values:'
5247 write (iout,'(2i3,50(1x,i2,f5.2))')
5248 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5249 & j=1,num_cont_hb(i))
5255 C Remove the loop below after debugging !!!
5262 C Calculate the dipole-dipole interaction energies
5263 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5264 do i=iatel_s,iatel_e+1
5265 num_conti=num_cont_hb(i)
5272 C Calculate the local-electrostatic correlation terms
5273 do i=iatel_s,iatel_e+1
5275 num_conti=num_cont_hb(i)
5276 num_conti1=num_cont_hb(i+1)
5281 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5282 c & ' jj=',jj,' kk=',kk
5283 if (j1.eq.j+1 .or. j1.eq.j-1) then
5284 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5285 C The system gains extra energy.
5287 sqd1=dsqrt(d_cont(jj,i))
5288 sqd2=dsqrt(d_cont(kk,i1))
5289 sred_geom = sqd1*sqd2
5290 IF (sred_geom.lt.cutoff_corr) THEN
5291 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5293 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5294 c & ' jj=',jj,' kk=',kk
5295 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5296 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5298 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5299 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5302 cd write (iout,*) 'sred_geom=',sred_geom,
5303 cd & ' ekont=',ekont,' fprim=',fprimcont
5304 call calc_eello(i,j,i+1,j1,jj,kk)
5305 if (wcorr4.gt.0.0d0)
5306 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5307 if (wcorr5.gt.0.0d0)
5308 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5309 c print *,"wcorr5",ecorr5
5310 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5311 cd write(2,*)'ijkl',i,j,i+1,j1
5312 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5313 & .or. wturn6.eq.0.0d0))then
5314 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5315 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5316 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5317 c & 'ecorr6=',ecorr6, wcorr6
5318 cd write (iout,'(4e15.5)') sred_geom,
5319 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5320 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5321 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5322 else if (wturn6.gt.0.0d0
5323 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5324 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5325 eturn6=eturn6+eello_turn6(i,jj,kk)
5326 cd write (2,*) 'multibody_eello:eturn6',eturn6
5330 else if (j1.eq.j) then
5331 C Contacts I-J and I-(J+1) occur simultaneously.
5332 C The system loses extra energy.
5333 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5338 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5339 c & ' jj=',jj,' kk=',kk
5341 C Contacts I-J and (I+1)-J occur simultaneously.
5342 C The system loses extra energy.
5343 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5350 c------------------------------------------------------------------------------
5351 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5352 implicit real*8 (a-h,o-z)
5353 include 'DIMENSIONS'
5354 include 'COMMON.IOUNITS'
5355 include 'COMMON.DERIV'
5356 include 'COMMON.INTERACT'
5357 include 'COMMON.CONTACTS'
5358 double precision gx(3),gx1(3)
5368 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5369 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5370 C Following 4 lines for diagnostics.
5375 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5377 c write (iout,*)'Contacts have occurred for peptide groups',
5378 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5379 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5380 C Calculate the multi-body contribution to energy.
5381 ecorr=ecorr+ekont*ees
5383 C Calculate multi-body contributions to the gradient.
5385 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5386 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5387 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5388 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5389 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5390 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5391 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5392 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5393 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5394 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5395 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5396 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5397 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5398 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5402 gradcorr(ll,m)=gradcorr(ll,m)+
5403 & ees*ekl*gacont_hbr(ll,jj,i)-
5404 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5405 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5410 gradcorr(ll,m)=gradcorr(ll,m)+
5411 & ees*eij*gacont_hbr(ll,kk,k)-
5412 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5413 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5420 C---------------------------------------------------------------------------
5421 subroutine dipole(i,j,jj)
5422 implicit real*8 (a-h,o-z)
5423 include 'DIMENSIONS'
5424 include 'sizesclu.dat'
5425 include 'COMMON.IOUNITS'
5426 include 'COMMON.CHAIN'
5427 include 'COMMON.FFIELD'
5428 include 'COMMON.DERIV'
5429 include 'COMMON.INTERACT'
5430 include 'COMMON.CONTACTS'
5431 include 'COMMON.TORSION'
5432 include 'COMMON.VAR'
5433 include 'COMMON.GEO'
5434 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5436 iti1 = itortyp(itype(i+1))
5437 if (j.lt.nres-1) then
5438 itj1 = itortyp(itype(j+1))
5443 dipi(iii,1)=Ub2(iii,i)
5444 dipderi(iii)=Ub2der(iii,i)
5445 dipi(iii,2)=b1(iii,iti1)
5446 dipj(iii,1)=Ub2(iii,j)
5447 dipderj(iii)=Ub2der(iii,j)
5448 dipj(iii,2)=b1(iii,itj1)
5452 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5455 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5458 if (.not.calc_grad) return
5463 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5467 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5472 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5473 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5475 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5477 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5479 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5483 C---------------------------------------------------------------------------
5484 subroutine calc_eello(i,j,k,l,jj,kk)
5486 C This subroutine computes matrices and vectors needed to calculate
5487 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5489 implicit real*8 (a-h,o-z)
5490 include 'DIMENSIONS'
5491 include 'sizesclu.dat'
5492 include 'COMMON.IOUNITS'
5493 include 'COMMON.CHAIN'
5494 include 'COMMON.DERIV'
5495 include 'COMMON.INTERACT'
5496 include 'COMMON.CONTACTS'
5497 include 'COMMON.TORSION'
5498 include 'COMMON.VAR'
5499 include 'COMMON.GEO'
5500 include 'COMMON.FFIELD'
5501 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5502 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5505 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5506 cd & ' jj=',jj,' kk=',kk
5507 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5510 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5511 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5514 call transpose2(aa1(1,1),aa1t(1,1))
5515 call transpose2(aa2(1,1),aa2t(1,1))
5518 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5519 & aa1tder(1,1,lll,kkk))
5520 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5521 & aa2tder(1,1,lll,kkk))
5525 C parallel orientation of the two CA-CA-CA frames.
5527 iti=itortyp(itype(i))
5531 itk1=itortyp(itype(k+1))
5532 itj=itortyp(itype(j))
5533 if (l.lt.nres-1) then
5534 itl1=itortyp(itype(l+1))
5538 C A1 kernel(j+1) A2T
5540 cd write (iout,'(3f10.5,5x,3f10.5)')
5541 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5543 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5544 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5545 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5546 C Following matrices are needed only for 6-th order cumulants
5547 IF (wcorr6.gt.0.0d0) THEN
5548 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5549 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5550 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5551 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5552 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5553 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5554 & ADtEAderx(1,1,1,1,1,1))
5556 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5557 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5558 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5559 & ADtEA1derx(1,1,1,1,1,1))
5561 C End 6-th order cumulants
5564 cd write (2,*) 'In calc_eello6'
5566 cd write (2,*) 'iii=',iii
5568 cd write (2,*) 'kkk=',kkk
5570 cd write (2,'(3(2f10.5),5x)')
5571 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5576 call transpose2(EUgder(1,1,k),auxmat(1,1))
5577 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5578 call transpose2(EUg(1,1,k),auxmat(1,1))
5579 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5580 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5584 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5585 & EAEAderx(1,1,lll,kkk,iii,1))
5589 C A1T kernel(i+1) A2
5590 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5591 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5592 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5593 C Following matrices are needed only for 6-th order cumulants
5594 IF (wcorr6.gt.0.0d0) THEN
5595 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5597 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5598 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5599 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5600 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5601 & ADtEAderx(1,1,1,1,1,2))
5602 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5603 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5604 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5605 & ADtEA1derx(1,1,1,1,1,2))
5607 C End 6-th order cumulants
5608 call transpose2(EUgder(1,1,l),auxmat(1,1))
5609 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5610 call transpose2(EUg(1,1,l),auxmat(1,1))
5611 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5612 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5616 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5617 & EAEAderx(1,1,lll,kkk,iii,2))
5622 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5623 C They are needed only when the fifth- or the sixth-order cumulants are
5625 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5626 call transpose2(AEA(1,1,1),auxmat(1,1))
5627 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5628 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5629 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5630 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5631 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5632 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5633 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5634 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5635 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5636 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5637 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5638 call transpose2(AEA(1,1,2),auxmat(1,1))
5639 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5640 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5641 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5642 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5643 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5644 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5645 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5646 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5647 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5648 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5649 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5650 C Calculate the Cartesian derivatives of the vectors.
5654 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5655 call matvec2(auxmat(1,1),b1(1,iti),
5656 & AEAb1derx(1,lll,kkk,iii,1,1))
5657 call matvec2(auxmat(1,1),Ub2(1,i),
5658 & AEAb2derx(1,lll,kkk,iii,1,1))
5659 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5660 & AEAb1derx(1,lll,kkk,iii,2,1))
5661 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5662 & AEAb2derx(1,lll,kkk,iii,2,1))
5663 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5664 call matvec2(auxmat(1,1),b1(1,itj),
5665 & AEAb1derx(1,lll,kkk,iii,1,2))
5666 call matvec2(auxmat(1,1),Ub2(1,j),
5667 & AEAb2derx(1,lll,kkk,iii,1,2))
5668 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5669 & AEAb1derx(1,lll,kkk,iii,2,2))
5670 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5671 & AEAb2derx(1,lll,kkk,iii,2,2))
5678 C Antiparallel orientation of the two CA-CA-CA frames.
5680 iti=itortyp(itype(i))
5684 itk1=itortyp(itype(k+1))
5685 itl=itortyp(itype(l))
5686 itj=itortyp(itype(j))
5687 if (j.lt.nres-1) then
5688 itj1=itortyp(itype(j+1))
5692 C A2 kernel(j-1)T A1T
5693 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5694 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5695 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5696 C Following matrices are needed only for 6-th order cumulants
5697 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5698 & j.eq.i+4 .and. l.eq.i+3)) THEN
5699 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5700 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5701 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5702 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5703 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5704 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5705 & ADtEAderx(1,1,1,1,1,1))
5706 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5707 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5708 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5709 & ADtEA1derx(1,1,1,1,1,1))
5711 C End 6-th order cumulants
5712 call transpose2(EUgder(1,1,k),auxmat(1,1))
5713 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5714 call transpose2(EUg(1,1,k),auxmat(1,1))
5715 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5716 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5720 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5721 & EAEAderx(1,1,lll,kkk,iii,1))
5725 C A2T kernel(i+1)T A1
5726 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5727 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5728 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5729 C Following matrices are needed only for 6-th order cumulants
5730 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5731 & j.eq.i+4 .and. l.eq.i+3)) THEN
5732 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5733 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5734 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5735 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5736 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5737 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5738 & ADtEAderx(1,1,1,1,1,2))
5739 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5740 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5741 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5742 & ADtEA1derx(1,1,1,1,1,2))
5744 C End 6-th order cumulants
5745 call transpose2(EUgder(1,1,j),auxmat(1,1))
5746 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5747 call transpose2(EUg(1,1,j),auxmat(1,1))
5748 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5749 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5753 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5754 & EAEAderx(1,1,lll,kkk,iii,2))
5759 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5760 C They are needed only when the fifth- or the sixth-order cumulants are
5762 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5763 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5764 call transpose2(AEA(1,1,1),auxmat(1,1))
5765 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5766 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5767 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5768 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5769 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5770 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5771 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5772 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5773 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5774 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5775 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5776 call transpose2(AEA(1,1,2),auxmat(1,1))
5777 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5778 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5779 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5780 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5781 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5782 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5783 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5784 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5785 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5786 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5787 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5788 C Calculate the Cartesian derivatives of the vectors.
5792 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5793 call matvec2(auxmat(1,1),b1(1,iti),
5794 & AEAb1derx(1,lll,kkk,iii,1,1))
5795 call matvec2(auxmat(1,1),Ub2(1,i),
5796 & AEAb2derx(1,lll,kkk,iii,1,1))
5797 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5798 & AEAb1derx(1,lll,kkk,iii,2,1))
5799 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5800 & AEAb2derx(1,lll,kkk,iii,2,1))
5801 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5802 call matvec2(auxmat(1,1),b1(1,itl),
5803 & AEAb1derx(1,lll,kkk,iii,1,2))
5804 call matvec2(auxmat(1,1),Ub2(1,l),
5805 & AEAb2derx(1,lll,kkk,iii,1,2))
5806 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5807 & AEAb1derx(1,lll,kkk,iii,2,2))
5808 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5809 & AEAb2derx(1,lll,kkk,iii,2,2))
5818 C---------------------------------------------------------------------------
5819 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5820 & KK,KKderg,AKA,AKAderg,AKAderx)
5824 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5825 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5826 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5831 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5833 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5836 cd if (lprn) write (2,*) 'In kernel'
5838 cd if (lprn) write (2,*) 'kkk=',kkk
5840 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5841 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5843 cd write (2,*) 'lll=',lll
5844 cd write (2,*) 'iii=1'
5846 cd write (2,'(3(2f10.5),5x)')
5847 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5850 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5851 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5853 cd write (2,*) 'lll=',lll
5854 cd write (2,*) 'iii=2'
5856 cd write (2,'(3(2f10.5),5x)')
5857 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5864 C---------------------------------------------------------------------------
5865 double precision function eello4(i,j,k,l,jj,kk)
5866 implicit real*8 (a-h,o-z)
5867 include 'DIMENSIONS'
5868 include 'sizesclu.dat'
5869 include 'COMMON.IOUNITS'
5870 include 'COMMON.CHAIN'
5871 include 'COMMON.DERIV'
5872 include 'COMMON.INTERACT'
5873 include 'COMMON.CONTACTS'
5874 include 'COMMON.TORSION'
5875 include 'COMMON.VAR'
5876 include 'COMMON.GEO'
5877 double precision pizda(2,2),ggg1(3),ggg2(3)
5878 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5882 cd print *,'eello4:',i,j,k,l,jj,kk
5883 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5884 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5885 cold eij=facont_hb(jj,i)
5886 cold ekl=facont_hb(kk,k)
5888 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5890 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5891 gcorr_loc(k-1)=gcorr_loc(k-1)
5892 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5894 gcorr_loc(l-1)=gcorr_loc(l-1)
5895 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5897 gcorr_loc(j-1)=gcorr_loc(j-1)
5898 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5903 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5904 & -EAEAderx(2,2,lll,kkk,iii,1)
5905 cd derx(lll,kkk,iii)=0.0d0
5909 cd gcorr_loc(l-1)=0.0d0
5910 cd gcorr_loc(j-1)=0.0d0
5911 cd gcorr_loc(k-1)=0.0d0
5913 cd write (iout,*)'Contacts have occurred for peptide groups',
5914 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5915 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5916 if (j.lt.nres-1) then
5923 if (l.lt.nres-1) then
5931 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5932 ggg1(ll)=eel4*g_contij(ll,1)
5933 ggg2(ll)=eel4*g_contij(ll,2)
5934 ghalf=0.5d0*ggg1(ll)
5936 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5937 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5938 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5939 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5940 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5941 ghalf=0.5d0*ggg2(ll)
5943 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5944 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5945 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5946 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5951 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5952 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5957 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5958 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5964 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5969 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5973 cd write (2,*) iii,gcorr_loc(iii)
5977 cd write (2,*) 'ekont',ekont
5978 cd write (iout,*) 'eello4',ekont*eel4
5981 C---------------------------------------------------------------------------
5982 double precision function eello5(i,j,k,l,jj,kk)
5983 implicit real*8 (a-h,o-z)
5984 include 'DIMENSIONS'
5985 include 'sizesclu.dat'
5986 include 'COMMON.IOUNITS'
5987 include 'COMMON.CHAIN'
5988 include 'COMMON.DERIV'
5989 include 'COMMON.INTERACT'
5990 include 'COMMON.CONTACTS'
5991 include 'COMMON.TORSION'
5992 include 'COMMON.VAR'
5993 include 'COMMON.GEO'
5994 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5995 double precision ggg1(3),ggg2(3)
5996 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6001 C /l\ / \ \ / \ / \ / C
6002 C / \ / \ \ / \ / \ / C
6003 C j| o |l1 | o | o| o | | o |o C
6004 C \ |/k\| |/ \| / |/ \| |/ \| C
6005 C \i/ \ / \ / / \ / \ C
6007 C (I) (II) (III) (IV) C
6009 C eello5_1 eello5_2 eello5_3 eello5_4 C
6011 C Antiparallel chains C
6014 C /j\ / \ \ / \ / \ / C
6015 C / \ / \ \ / \ / \ / C
6016 C j1| o |l | o | o| o | | o |o C
6017 C \ |/k\| |/ \| / |/ \| |/ \| C
6018 C \i/ \ / \ / / \ / \ C
6020 C (I) (II) (III) (IV) C
6022 C eello5_1 eello5_2 eello5_3 eello5_4 C
6024 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6026 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6027 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6032 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6034 itk=itortyp(itype(k))
6035 itl=itortyp(itype(l))
6036 itj=itortyp(itype(j))
6041 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6042 cd & eel5_3_num,eel5_4_num)
6046 derx(lll,kkk,iii)=0.0d0
6050 cd eij=facont_hb(jj,i)
6051 cd ekl=facont_hb(kk,k)
6053 cd write (iout,*)'Contacts have occurred for peptide groups',
6054 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6056 C Contribution from the graph I.
6057 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6058 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6059 call transpose2(EUg(1,1,k),auxmat(1,1))
6060 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6061 vv(1)=pizda(1,1)-pizda(2,2)
6062 vv(2)=pizda(1,2)+pizda(2,1)
6063 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6064 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6066 C Explicit gradient in virtual-dihedral angles.
6067 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6068 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6069 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6070 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6071 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6072 vv(1)=pizda(1,1)-pizda(2,2)
6073 vv(2)=pizda(1,2)+pizda(2,1)
6074 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6075 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6076 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6077 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6078 vv(1)=pizda(1,1)-pizda(2,2)
6079 vv(2)=pizda(1,2)+pizda(2,1)
6081 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6082 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6083 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6085 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6086 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6087 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6089 C Cartesian gradient
6093 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6095 vv(1)=pizda(1,1)-pizda(2,2)
6096 vv(2)=pizda(1,2)+pizda(2,1)
6097 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6098 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6099 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6106 C Contribution from graph II
6107 call transpose2(EE(1,1,itk),auxmat(1,1))
6108 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6109 vv(1)=pizda(1,1)+pizda(2,2)
6110 vv(2)=pizda(2,1)-pizda(1,2)
6111 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6112 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6114 C Explicit gradient in virtual-dihedral angles.
6115 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6116 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6117 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6118 vv(1)=pizda(1,1)+pizda(2,2)
6119 vv(2)=pizda(2,1)-pizda(1,2)
6121 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6122 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6123 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6125 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6126 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6127 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6129 C Cartesian gradient
6133 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6135 vv(1)=pizda(1,1)+pizda(2,2)
6136 vv(2)=pizda(2,1)-pizda(1,2)
6137 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6138 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6139 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6148 C Parallel orientation
6149 C Contribution from graph III
6150 call transpose2(EUg(1,1,l),auxmat(1,1))
6151 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6152 vv(1)=pizda(1,1)-pizda(2,2)
6153 vv(2)=pizda(1,2)+pizda(2,1)
6154 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6155 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6157 C Explicit gradient in virtual-dihedral angles.
6158 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6159 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6160 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6161 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6162 vv(1)=pizda(1,1)-pizda(2,2)
6163 vv(2)=pizda(1,2)+pizda(2,1)
6164 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6165 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6166 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6167 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6168 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6169 vv(1)=pizda(1,1)-pizda(2,2)
6170 vv(2)=pizda(1,2)+pizda(2,1)
6171 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6172 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6173 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6174 C Cartesian gradient
6178 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6180 vv(1)=pizda(1,1)-pizda(2,2)
6181 vv(2)=pizda(1,2)+pizda(2,1)
6182 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6183 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6184 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6190 C Contribution from graph IV
6192 call transpose2(EE(1,1,itl),auxmat(1,1))
6193 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6194 vv(1)=pizda(1,1)+pizda(2,2)
6195 vv(2)=pizda(2,1)-pizda(1,2)
6196 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6197 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6199 C Explicit gradient in virtual-dihedral angles.
6200 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6201 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6202 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6203 vv(1)=pizda(1,1)+pizda(2,2)
6204 vv(2)=pizda(2,1)-pizda(1,2)
6205 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6206 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6207 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6208 C Cartesian gradient
6212 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6214 vv(1)=pizda(1,1)+pizda(2,2)
6215 vv(2)=pizda(2,1)-pizda(1,2)
6216 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6217 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6218 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6224 C Antiparallel orientation
6225 C Contribution from graph III
6227 call transpose2(EUg(1,1,j),auxmat(1,1))
6228 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6229 vv(1)=pizda(1,1)-pizda(2,2)
6230 vv(2)=pizda(1,2)+pizda(2,1)
6231 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6232 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6234 C Explicit gradient in virtual-dihedral angles.
6235 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6236 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6237 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6238 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6239 vv(1)=pizda(1,1)-pizda(2,2)
6240 vv(2)=pizda(1,2)+pizda(2,1)
6241 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6242 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6243 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6244 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6245 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6246 vv(1)=pizda(1,1)-pizda(2,2)
6247 vv(2)=pizda(1,2)+pizda(2,1)
6248 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6249 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6250 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6251 C Cartesian gradient
6255 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6257 vv(1)=pizda(1,1)-pizda(2,2)
6258 vv(2)=pizda(1,2)+pizda(2,1)
6259 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6260 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6261 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6267 C Contribution from graph IV
6269 call transpose2(EE(1,1,itj),auxmat(1,1))
6270 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6271 vv(1)=pizda(1,1)+pizda(2,2)
6272 vv(2)=pizda(2,1)-pizda(1,2)
6273 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6274 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6276 C Explicit gradient in virtual-dihedral angles.
6277 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6278 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6279 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6280 vv(1)=pizda(1,1)+pizda(2,2)
6281 vv(2)=pizda(2,1)-pizda(1,2)
6282 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6283 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6284 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6285 C Cartesian gradient
6289 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6291 vv(1)=pizda(1,1)+pizda(2,2)
6292 vv(2)=pizda(2,1)-pizda(1,2)
6293 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6294 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6295 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6302 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6303 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6304 cd write (2,*) 'ijkl',i,j,k,l
6305 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6306 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6308 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6309 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6310 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6311 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6313 if (j.lt.nres-1) then
6320 if (l.lt.nres-1) then
6330 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6332 ggg1(ll)=eel5*g_contij(ll,1)
6333 ggg2(ll)=eel5*g_contij(ll,2)
6334 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6335 ghalf=0.5d0*ggg1(ll)
6337 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6338 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6339 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6340 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6341 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6342 ghalf=0.5d0*ggg2(ll)
6344 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6345 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6346 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6347 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6352 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6353 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6358 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6359 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6365 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6370 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6374 cd write (2,*) iii,g_corr5_loc(iii)
6378 cd write (2,*) 'ekont',ekont
6379 cd write (iout,*) 'eello5',ekont*eel5
6382 c--------------------------------------------------------------------------
6383 double precision function eello6(i,j,k,l,jj,kk)
6384 implicit real*8 (a-h,o-z)
6385 include 'DIMENSIONS'
6386 include 'sizesclu.dat'
6387 include 'COMMON.IOUNITS'
6388 include 'COMMON.CHAIN'
6389 include 'COMMON.DERIV'
6390 include 'COMMON.INTERACT'
6391 include 'COMMON.CONTACTS'
6392 include 'COMMON.TORSION'
6393 include 'COMMON.VAR'
6394 include 'COMMON.GEO'
6395 include 'COMMON.FFIELD'
6396 double precision ggg1(3),ggg2(3)
6397 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6402 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6410 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6411 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6415 derx(lll,kkk,iii)=0.0d0
6419 cd eij=facont_hb(jj,i)
6420 cd ekl=facont_hb(kk,k)
6426 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6427 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6428 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6429 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6430 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6431 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6433 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6434 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6435 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6436 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6437 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6438 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6442 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6444 C If turn contributions are considered, they will be handled separately.
6445 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6446 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6447 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6448 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6449 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6450 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6451 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6454 if (j.lt.nres-1) then
6461 if (l.lt.nres-1) then
6469 ggg1(ll)=eel6*g_contij(ll,1)
6470 ggg2(ll)=eel6*g_contij(ll,2)
6471 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6472 ghalf=0.5d0*ggg1(ll)
6474 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6475 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6476 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6477 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6478 ghalf=0.5d0*ggg2(ll)
6479 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6481 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6482 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6483 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6484 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6489 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6490 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6495 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6496 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6502 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6507 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6511 cd write (2,*) iii,g_corr6_loc(iii)
6515 cd write (2,*) 'ekont',ekont
6516 cd write (iout,*) 'eello6',ekont*eel6
6519 c--------------------------------------------------------------------------
6520 double precision function eello6_graph1(i,j,k,l,imat,swap)
6521 implicit real*8 (a-h,o-z)
6522 include 'DIMENSIONS'
6523 include 'sizesclu.dat'
6524 include 'COMMON.IOUNITS'
6525 include 'COMMON.CHAIN'
6526 include 'COMMON.DERIV'
6527 include 'COMMON.INTERACT'
6528 include 'COMMON.CONTACTS'
6529 include 'COMMON.TORSION'
6530 include 'COMMON.VAR'
6531 include 'COMMON.GEO'
6532 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6536 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6538 C Parallel Antiparallel C
6544 C \ j|/k\| / \ |/k\|l / C
6549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6550 itk=itortyp(itype(k))
6551 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6552 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6553 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6554 call transpose2(EUgC(1,1,k),auxmat(1,1))
6555 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6556 vv1(1)=pizda1(1,1)-pizda1(2,2)
6557 vv1(2)=pizda1(1,2)+pizda1(2,1)
6558 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6559 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6560 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6561 s5=scalar2(vv(1),Dtobr2(1,i))
6562 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6563 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6564 if (.not. calc_grad) return
6565 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6566 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6567 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6568 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6569 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6570 & +scalar2(vv(1),Dtobr2der(1,i)))
6571 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6572 vv1(1)=pizda1(1,1)-pizda1(2,2)
6573 vv1(2)=pizda1(1,2)+pizda1(2,1)
6574 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6575 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6577 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6578 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6579 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6580 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6581 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6583 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6584 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6585 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6586 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6587 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6589 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6590 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6591 vv1(1)=pizda1(1,1)-pizda1(2,2)
6592 vv1(2)=pizda1(1,2)+pizda1(2,1)
6593 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6594 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6595 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6596 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6605 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6606 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6607 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6608 call transpose2(EUgC(1,1,k),auxmat(1,1))
6609 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6611 vv1(1)=pizda1(1,1)-pizda1(2,2)
6612 vv1(2)=pizda1(1,2)+pizda1(2,1)
6613 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6614 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6615 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6616 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6617 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6618 s5=scalar2(vv(1),Dtobr2(1,i))
6619 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6625 c----------------------------------------------------------------------------
6626 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6627 implicit real*8 (a-h,o-z)
6628 include 'DIMENSIONS'
6629 include 'sizesclu.dat'
6630 include 'COMMON.IOUNITS'
6631 include 'COMMON.CHAIN'
6632 include 'COMMON.DERIV'
6633 include 'COMMON.INTERACT'
6634 include 'COMMON.CONTACTS'
6635 include 'COMMON.TORSION'
6636 include 'COMMON.VAR'
6637 include 'COMMON.GEO'
6639 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6640 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6643 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6645 C Parallel Antiparallel C
6651 C \ j|/k\| \ |/k\|l C
6656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6657 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6658 C AL 7/4/01 s1 would occur in the sixth-order moment,
6659 C but not in a cluster cumulant
6661 s1=dip(1,jj,i)*dip(1,kk,k)
6663 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6664 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6665 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6666 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6667 call transpose2(EUg(1,1,k),auxmat(1,1))
6668 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6669 vv(1)=pizda(1,1)-pizda(2,2)
6670 vv(2)=pizda(1,2)+pizda(2,1)
6671 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6672 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6674 eello6_graph2=-(s1+s2+s3+s4)
6676 eello6_graph2=-(s2+s3+s4)
6679 if (.not. calc_grad) return
6680 C Derivatives in gamma(i-1)
6683 s1=dipderg(1,jj,i)*dip(1,kk,k)
6685 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6686 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6687 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6688 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6690 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6692 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6694 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6696 C Derivatives in gamma(k-1)
6698 s1=dip(1,jj,i)*dipderg(1,kk,k)
6700 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6701 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6702 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6703 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6704 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6705 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6706 vv(1)=pizda(1,1)-pizda(2,2)
6707 vv(2)=pizda(1,2)+pizda(2,1)
6708 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6710 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6712 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6714 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6715 C Derivatives in gamma(j-1) or gamma(l-1)
6718 s1=dipderg(3,jj,i)*dip(1,kk,k)
6720 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6721 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6722 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6723 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6724 vv(1)=pizda(1,1)-pizda(2,2)
6725 vv(2)=pizda(1,2)+pizda(2,1)
6726 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6729 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6731 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6734 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6735 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6737 C Derivatives in gamma(l-1) or gamma(j-1)
6740 s1=dip(1,jj,i)*dipderg(3,kk,k)
6742 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6743 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6744 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6745 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6746 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6747 vv(1)=pizda(1,1)-pizda(2,2)
6748 vv(2)=pizda(1,2)+pizda(2,1)
6749 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6752 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6754 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6757 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6758 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6760 C Cartesian derivatives.
6762 write (2,*) 'In eello6_graph2'
6764 write (2,*) 'iii=',iii
6766 write (2,*) 'kkk=',kkk
6768 write (2,'(3(2f10.5),5x)')
6769 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6779 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6781 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6784 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6786 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6787 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6789 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6790 call transpose2(EUg(1,1,k),auxmat(1,1))
6791 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6793 vv(1)=pizda(1,1)-pizda(2,2)
6794 vv(2)=pizda(1,2)+pizda(2,1)
6795 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6796 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6798 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6800 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6803 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6805 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6812 c----------------------------------------------------------------------------
6813 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6814 implicit real*8 (a-h,o-z)
6815 include 'DIMENSIONS'
6816 include 'sizesclu.dat'
6817 include 'COMMON.IOUNITS'
6818 include 'COMMON.CHAIN'
6819 include 'COMMON.DERIV'
6820 include 'COMMON.INTERACT'
6821 include 'COMMON.CONTACTS'
6822 include 'COMMON.TORSION'
6823 include 'COMMON.VAR'
6824 include 'COMMON.GEO'
6825 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6829 C Parallel Antiparallel C
6835 C j|/k\| / |/k\|l / C
6840 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6842 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6843 C energy moment and not to the cluster cumulant.
6844 iti=itortyp(itype(i))
6845 if (j.lt.nres-1) then
6846 itj1=itortyp(itype(j+1))
6850 itk=itortyp(itype(k))
6851 itk1=itortyp(itype(k+1))
6852 if (l.lt.nres-1) then
6853 itl1=itortyp(itype(l+1))
6858 s1=dip(4,jj,i)*dip(4,kk,k)
6860 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6861 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6862 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6863 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6864 call transpose2(EE(1,1,itk),auxmat(1,1))
6865 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6866 vv(1)=pizda(1,1)+pizda(2,2)
6867 vv(2)=pizda(2,1)-pizda(1,2)
6868 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6869 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6871 eello6_graph3=-(s1+s2+s3+s4)
6873 eello6_graph3=-(s2+s3+s4)
6876 if (.not. calc_grad) return
6877 C Derivatives in gamma(k-1)
6878 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6879 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6880 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6881 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6882 C Derivatives in gamma(l-1)
6883 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6884 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6885 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6886 vv(1)=pizda(1,1)+pizda(2,2)
6887 vv(2)=pizda(2,1)-pizda(1,2)
6888 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6889 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6890 C Cartesian derivatives.
6896 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6898 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6901 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6903 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6904 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6906 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6907 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6909 vv(1)=pizda(1,1)+pizda(2,2)
6910 vv(2)=pizda(2,1)-pizda(1,2)
6911 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6913 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6915 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6918 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6922 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6928 c----------------------------------------------------------------------------
6929 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6930 implicit real*8 (a-h,o-z)
6931 include 'DIMENSIONS'
6932 include 'sizesclu.dat'
6933 include 'COMMON.IOUNITS'
6934 include 'COMMON.CHAIN'
6935 include 'COMMON.DERIV'
6936 include 'COMMON.INTERACT'
6937 include 'COMMON.CONTACTS'
6938 include 'COMMON.TORSION'
6939 include 'COMMON.VAR'
6940 include 'COMMON.GEO'
6941 include 'COMMON.FFIELD'
6942 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6943 & auxvec1(2),auxmat1(2,2)
6945 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6947 C Parallel Antiparallel C
6953 C \ j|/k\| \ |/k\|l C
6958 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6960 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6961 C energy moment and not to the cluster cumulant.
6962 cd write (2,*) 'eello_graph4: wturn6',wturn6
6963 iti=itortyp(itype(i))
6964 itj=itortyp(itype(j))
6965 if (j.lt.nres-1) then
6966 itj1=itortyp(itype(j+1))
6970 itk=itortyp(itype(k))
6971 if (k.lt.nres-1) then
6972 itk1=itortyp(itype(k+1))
6976 itl=itortyp(itype(l))
6977 if (l.lt.nres-1) then
6978 itl1=itortyp(itype(l+1))
6982 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6983 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6984 cd & ' itl',itl,' itl1',itl1
6987 s1=dip(3,jj,i)*dip(3,kk,k)
6989 s1=dip(2,jj,j)*dip(2,kk,l)
6992 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6993 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6995 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6996 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6998 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6999 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7001 call transpose2(EUg(1,1,k),auxmat(1,1))
7002 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7003 vv(1)=pizda(1,1)-pizda(2,2)
7004 vv(2)=pizda(2,1)+pizda(1,2)
7005 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7006 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7008 eello6_graph4=-(s1+s2+s3+s4)
7010 eello6_graph4=-(s2+s3+s4)
7012 if (.not. calc_grad) return
7013 C Derivatives in gamma(i-1)
7017 s1=dipderg(2,jj,i)*dip(3,kk,k)
7019 s1=dipderg(4,jj,j)*dip(2,kk,l)
7022 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7024 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7025 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7027 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7028 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7030 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7031 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7032 cd write (2,*) 'turn6 derivatives'
7034 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7036 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7040 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7042 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7046 C Derivatives in gamma(k-1)
7049 s1=dip(3,jj,i)*dipderg(2,kk,k)
7051 s1=dip(2,jj,j)*dipderg(4,kk,l)
7054 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7055 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7057 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7058 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7060 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7061 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7063 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7064 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7065 vv(1)=pizda(1,1)-pizda(2,2)
7066 vv(2)=pizda(2,1)+pizda(1,2)
7067 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7068 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7070 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7072 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7076 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7078 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7081 C Derivatives in gamma(j-1) or gamma(l-1)
7082 if (l.eq.j+1 .and. l.gt.1) then
7083 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7084 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7085 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7086 vv(1)=pizda(1,1)-pizda(2,2)
7087 vv(2)=pizda(2,1)+pizda(1,2)
7088 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7089 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7090 else if (j.gt.1) then
7091 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7092 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7093 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7094 vv(1)=pizda(1,1)-pizda(2,2)
7095 vv(2)=pizda(2,1)+pizda(1,2)
7096 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7097 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7098 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7100 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7103 C Cartesian derivatives.
7110 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7112 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7116 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7118 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7122 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7124 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7126 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7127 & b1(1,itj1),auxvec(1))
7128 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7130 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7131 & b1(1,itl1),auxvec(1))
7132 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7134 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7136 vv(1)=pizda(1,1)-pizda(2,2)
7137 vv(2)=pizda(2,1)+pizda(1,2)
7138 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7140 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7142 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7145 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7148 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7151 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7153 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7155 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7159 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7164 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7166 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7174 c----------------------------------------------------------------------------
7175 double precision function eello_turn6(i,jj,kk)
7176 implicit real*8 (a-h,o-z)
7177 include 'DIMENSIONS'
7178 include 'sizesclu.dat'
7179 include 'COMMON.IOUNITS'
7180 include 'COMMON.CHAIN'
7181 include 'COMMON.DERIV'
7182 include 'COMMON.INTERACT'
7183 include 'COMMON.CONTACTS'
7184 include 'COMMON.TORSION'
7185 include 'COMMON.VAR'
7186 include 'COMMON.GEO'
7187 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7188 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7190 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7191 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7192 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7193 C the respective energy moment and not to the cluster cumulant.
7198 iti=itortyp(itype(i))
7199 itk=itortyp(itype(k))
7200 itk1=itortyp(itype(k+1))
7201 itl=itortyp(itype(l))
7202 itj=itortyp(itype(j))
7203 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7204 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7205 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7210 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7212 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7216 derx_turn(lll,kkk,iii)=0.0d0
7223 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7225 cd write (2,*) 'eello6_5',eello6_5
7227 call transpose2(AEA(1,1,1),auxmat(1,1))
7228 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7229 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7230 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7234 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7235 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7236 s2 = scalar2(b1(1,itk),vtemp1(1))
7238 call transpose2(AEA(1,1,2),atemp(1,1))
7239 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7240 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7241 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7245 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7246 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7247 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7249 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7250 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7251 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7252 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7253 ss13 = scalar2(b1(1,itk),vtemp4(1))
7254 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7258 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7264 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7266 C Derivatives in gamma(i+2)
7268 call transpose2(AEA(1,1,1),auxmatd(1,1))
7269 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7270 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7271 call transpose2(AEAderg(1,1,2),atempd(1,1))
7272 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7273 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7277 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7278 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7279 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7285 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7286 C Derivatives in gamma(i+3)
7288 call transpose2(AEA(1,1,1),auxmatd(1,1))
7289 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7290 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7291 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7295 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7296 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7297 s2d = scalar2(b1(1,itk),vtemp1d(1))
7299 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7300 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7302 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7304 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7305 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7306 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7316 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7317 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7319 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7320 & -0.5d0*ekont*(s2d+s12d)
7322 C Derivatives in gamma(i+4)
7323 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7324 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7325 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7327 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7328 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7329 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7339 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7341 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7343 C Derivatives in gamma(i+5)
7345 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7346 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7347 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7351 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7352 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7353 s2d = scalar2(b1(1,itk),vtemp1d(1))
7355 call transpose2(AEA(1,1,2),atempd(1,1))
7356 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7357 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7361 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7362 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7364 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7365 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7366 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7376 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7377 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7379 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7380 & -0.5d0*ekont*(s2d+s12d)
7382 C Cartesian derivatives
7387 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7388 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7389 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7393 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7394 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7396 s2d = scalar2(b1(1,itk),vtemp1d(1))
7398 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7399 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7400 s8d = -(atempd(1,1)+atempd(2,2))*
7401 & scalar2(cc(1,1,itl),vtemp2(1))
7405 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7407 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7408 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7415 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7418 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7422 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7423 & - 0.5d0*(s8d+s12d)
7425 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7434 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7436 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7437 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7438 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7439 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7440 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7442 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7443 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7444 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7448 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7449 cd & 16*eel_turn6_num
7451 if (j.lt.nres-1) then
7458 if (l.lt.nres-1) then
7466 ggg1(ll)=eel_turn6*g_contij(ll,1)
7467 ggg2(ll)=eel_turn6*g_contij(ll,2)
7468 ghalf=0.5d0*ggg1(ll)
7470 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7471 & +ekont*derx_turn(ll,2,1)
7472 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7473 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7474 & +ekont*derx_turn(ll,4,1)
7475 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7476 ghalf=0.5d0*ggg2(ll)
7478 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7479 & +ekont*derx_turn(ll,2,2)
7480 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7481 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7482 & +ekont*derx_turn(ll,4,2)
7483 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7488 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7493 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7499 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7504 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7508 cd write (2,*) iii,g_corr6_loc(iii)
7511 eello_turn6=ekont*eel_turn6
7512 cd write (2,*) 'ekont',ekont
7513 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7516 crc-------------------------------------------------
7517 SUBROUTINE MATVEC2(A1,V1,V2)
7518 implicit real*8 (a-h,o-z)
7519 include 'DIMENSIONS'
7520 DIMENSION A1(2,2),V1(2),V2(2)
7524 c 3 VI=VI+A1(I,K)*V1(K)
7528 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7529 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7534 C---------------------------------------
7535 SUBROUTINE MATMAT2(A1,A2,A3)
7536 implicit real*8 (a-h,o-z)
7537 include 'DIMENSIONS'
7538 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7539 c DIMENSION AI3(2,2)
7543 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7549 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7550 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7551 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7552 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7560 c-------------------------------------------------------------------------
7561 double precision function scalar2(u,v)
7563 double precision u(2),v(2)
7566 scalar2=u(1)*v(1)+u(2)*v(2)
7570 C-----------------------------------------------------------------------------
7572 subroutine transpose2(a,at)
7574 double precision a(2,2),at(2,2)
7581 c--------------------------------------------------------------------------
7582 subroutine transpose(n,a,at)
7585 double precision a(n,n),at(n,n)
7593 C---------------------------------------------------------------------------
7594 subroutine prodmat3(a1,a2,kk,transp,prod)
7597 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7599 crc double precision auxmat(2,2),prod_(2,2)
7602 crc call transpose2(kk(1,1),auxmat(1,1))
7603 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7604 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7606 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7607 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7608 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7609 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7610 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7611 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7612 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7613 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7616 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7617 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7619 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7620 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7621 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7622 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7623 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7624 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7625 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7626 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7629 c call transpose2(a2(1,1),a2t(1,1))
7632 crc print *,((prod_(i,j),i=1,2),j=1,2)
7633 crc print *,((prod(i,j),i=1,2),j=1,2)
7637 C-----------------------------------------------------------------------------
7638 double precision function scalar(u,v)
7640 double precision u(3),v(3)