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 c 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 c 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'
2879 include 'COMMON.CONTROL'
2882 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2883 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2884 if (link_end.eq.0) return
2885 do i=link_start,link_end
2886 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2887 C CA-CA distance used in regularization of structure.
2890 C iii and jjj point to the residues for which the distance is assigned.
2891 if (ii.gt.nres) then
2898 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2899 c & dhpb(i),dhpb1(i),forcon(i)
2900 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2901 C distance and angle dependent SS bond potential.
2902 if (.not.dyn_ss .and. i.le.nss) then
2903 C 15/02/13 CC dynamic SSbond - additional check
2904 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2905 call ssbond_ene(iii,jjj,eij)
2907 cd write (iout,*) "eij",eij
2909 else if (ii.gt.nres .and. jj.gt.nres) then
2910 c Restraints from contact prediction
2912 if (constr_dist.eq.11) then
2913 ehpb=ehpb+fordepth(i)**4.0d0
2914 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2915 fac=fordepth(i)**4.0d0
2916 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2918 if (dhpb1(i).gt.0.0d0) then
2919 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2920 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2921 c write (iout,*) "beta nmr",
2922 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2926 C Get the force constant corresponding to this distance.
2928 C Calculate the contribution to energy.
2929 ehpb=ehpb+waga*rdis*rdis
2930 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2932 C Evaluate gradient.
2935 endif !end dhpb1(i).gt.0
2936 endif !end const_dist=11
2938 ggg(j)=fac*(c(j,jj)-c(j,ii))
2941 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2942 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2945 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2946 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2949 C Calculate the distance between the two points and its difference from the
2952 C write(iout,*) "after",dd
2953 if (constr_dist.eq.11) then
2954 ehpb=ehpb+fordepth(i)**4.0d0
2955 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2956 fac=fordepth(i)**4.0d0
2957 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2958 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
2959 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
2960 C print *,ehpb,"tu?"
2961 C write(iout,*) ehpb,"btu?",
2962 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
2963 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
2964 C & ehpb,fordepth(i),dd
2966 if (dhpb1(i).gt.0.0d0) then
2967 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2968 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2969 c write (iout,*) "alph nmr",
2970 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2973 C Get the force constant corresponding to this distance.
2975 C Calculate the contribution to energy.
2976 ehpb=ehpb+waga*rdis*rdis
2977 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2979 C Evaluate gradient.
2984 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2985 cd & ' waga=',waga,' fac=',fac
2987 ggg(j)=fac*(c(j,jj)-c(j,ii))
2989 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2990 C If this is a SC-SC distance, we need to calculate the contributions to the
2991 C Cartesian gradient in the SC vectors (ghpbx).
2994 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2995 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2999 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3000 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3004 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3007 C--------------------------------------------------------------------------
3008 subroutine ssbond_ene(i,j,eij)
3010 C Calculate the distance and angle dependent SS-bond potential energy
3011 C using a free-energy function derived based on RHF/6-31G** ab initio
3012 C calculations of diethyl disulfide.
3014 C A. Liwo and U. Kozlowska, 11/24/03
3016 implicit real*8 (a-h,o-z)
3017 include 'DIMENSIONS'
3018 include 'sizesclu.dat'
3019 include 'COMMON.SBRIDGE'
3020 include 'COMMON.CHAIN'
3021 include 'COMMON.DERIV'
3022 include 'COMMON.LOCAL'
3023 include 'COMMON.INTERACT'
3024 include 'COMMON.VAR'
3025 include 'COMMON.IOUNITS'
3026 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3031 dxi=dc_norm(1,nres+i)
3032 dyi=dc_norm(2,nres+i)
3033 dzi=dc_norm(3,nres+i)
3034 dsci_inv=dsc_inv(itypi)
3036 dscj_inv=dsc_inv(itypj)
3040 dxj=dc_norm(1,nres+j)
3041 dyj=dc_norm(2,nres+j)
3042 dzj=dc_norm(3,nres+j)
3043 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3048 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3049 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3050 om12=dxi*dxj+dyi*dyj+dzi*dzj
3052 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3053 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3059 deltat12=om2-om1+2.0d0
3061 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3062 & +akct*deltad*deltat12+ebr
3063 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3064 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3065 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3066 c & " deltat12",deltat12," eij",eij
3067 ed=2*akcm*deltad+akct*deltat12
3069 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3070 eom1=-2*akth*deltat1-pom1-om2*pom2
3071 eom2= 2*akth*deltat2+pom1-om1*pom2
3074 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3077 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3078 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3079 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3080 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3083 C Calculate the components of the gradient in DC and X
3087 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3093 C--------------------------------------------------------------------------
3096 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3097 subroutine e_modeller(ehomology_constr)
3098 implicit real*8 (a-h,o-z)
3100 include 'DIMENSIONS'
3102 integer nnn, i, j, k, ki, irec, l
3103 integer katy, odleglosci, test7
3104 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3105 real*8 distance(max_template),distancek(max_template),
3106 & min_odl,godl(max_template),dih_diff(max_template)
3109 c FP - 30/10/2014 Temporary specifications for homology restraints
3111 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3113 double precision, dimension (maxres) :: guscdiff,usc_diff
3114 double precision, dimension (max_template) ::
3115 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3118 include 'COMMON.SBRIDGE'
3119 include 'COMMON.CHAIN'
3120 include 'COMMON.GEO'
3121 include 'COMMON.DERIV'
3122 include 'COMMON.LOCAL'
3123 include 'COMMON.INTERACT'
3124 include 'COMMON.VAR'
3125 include 'COMMON.IOUNITS'
3126 include 'COMMON.CONTROL'
3127 include 'COMMON.HOMRESTR'
3129 include 'COMMON.SETUP'
3130 include 'COMMON.NAMES'
3133 distancek(i)=9999999.9
3138 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3140 C AL 5/2/14 - Introduce list of restraints
3141 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3143 write(iout,*) "------- dist restrs start -------"
3144 write (iout,*) "link_start_homo",link_start_homo,
3145 & " link_end_homo",link_end_homo
3147 do ii = link_start_homo,link_end_homo
3151 c write (iout,*) "dij(",i,j,") =",dij
3153 do k=1,constr_homology
3154 if(.not.l_homo(k,ii)) then
3158 distance(k)=odl(k,ii)-dij
3159 c write (iout,*) "distance(",k,") =",distance(k)
3161 c For Gaussian-type Urestr
3163 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3164 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3165 c write (iout,*) "distancek(",k,") =",distancek(k)
3166 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3168 c For Lorentzian-type Urestr
3170 if (waga_dist.lt.0.0d0) then
3171 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3172 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3173 & (distance(k)**2+sigma_odlir(k,ii)**2))
3177 c min_odl=minval(distancek)
3178 do kk=1,constr_homology
3179 if(l_homo(kk,ii)) then
3180 min_odl=distancek(kk)
3184 do kk=1,constr_homology
3185 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3186 & min_odl=distancek(kk)
3188 c write (iout,* )"min_odl",min_odl
3190 write (iout,*) "ij dij",i,j,dij
3191 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3192 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3193 write (iout,* )"min_odl",min_odl
3198 if (waga_dist.ge.0.0d0) then
3204 do k=1,constr_homology
3205 c Nie wiem po co to liczycie jeszcze raz!
3206 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3207 c & (2*(sigma_odl(i,j,k))**2))
3208 if(.not.l_homo(k,ii)) cycle
3209 if (waga_dist.ge.0.0d0) then
3211 c For Gaussian-type Urestr
3213 godl(k)=dexp(-distancek(k)+min_odl)
3214 odleg2=odleg2+godl(k)
3216 c For Lorentzian-type Urestr
3219 odleg2=odleg2+distancek(k)
3222 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3223 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3224 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3225 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3228 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3229 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3231 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3232 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3234 if (waga_dist.ge.0.0d0) then
3236 c For Gaussian-type Urestr
3238 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3240 c For Lorentzian-type Urestr
3243 odleg=odleg+odleg2/constr_homology
3247 c write (iout,*) "odleg",odleg ! sum of -ln-s
3250 c For Gaussian-type Urestr
3252 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3254 do k=1,constr_homology
3255 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3256 c & *waga_dist)+min_odl
3257 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3259 if(.not.l_homo(k,ii)) cycle
3260 if (waga_dist.ge.0.0d0) then
3261 c For Gaussian-type Urestr
3263 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3265 c For Lorentzian-type Urestr
3268 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3269 & sigma_odlir(k,ii)**2)**2)
3271 sum_sgodl=sum_sgodl+sgodl
3273 c sgodl2=sgodl2+sgodl
3274 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3275 c write(iout,*) "constr_homology=",constr_homology
3276 c write(iout,*) i, j, k, "TEST K"
3278 if (waga_dist.ge.0.0d0) then
3280 c For Gaussian-type Urestr
3282 grad_odl3=waga_homology(iset)*waga_dist
3283 & *sum_sgodl/(sum_godl*dij)
3285 c For Lorentzian-type Urestr
3288 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3289 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3290 grad_odl3=-waga_homology(iset)*waga_dist*
3291 & sum_sgodl/(constr_homology*dij)
3294 c grad_odl3=sum_sgodl/(sum_godl*dij)
3297 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3298 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3299 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3301 ccc write(iout,*) godl, sgodl, grad_odl3
3303 c grad_odl=grad_odl+grad_odl3
3306 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3307 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3308 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3309 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3310 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3311 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3312 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3313 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3314 c if (i.eq.25.and.j.eq.27) then
3315 c write(iout,*) "jik",jik,"i",i,"j",j
3316 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3317 c write(iout,*) "grad_odl3",grad_odl3
3318 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3319 c write(iout,*) "ggodl",ggodl
3320 c write(iout,*) "ghpbc(",jik,i,")",
3321 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3326 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3327 ccc & dLOG(odleg2),"-odleg=", -odleg
3329 enddo ! ii-loop for dist
3331 write(iout,*) "------- dist restrs end -------"
3332 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3333 c & waga_d.eq.1.0d0) call sum_gradient
3335 c Pseudo-energy and gradient from dihedral-angle restraints from
3336 c homology templates
3337 c write (iout,*) "End of distance loop"
3340 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3342 write(iout,*) "------- dih restrs start -------"
3343 do i=idihconstr_start_homo,idihconstr_end_homo
3344 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3347 do i=idihconstr_start_homo,idihconstr_end_homo
3349 c betai=beta(i,i+1,i+2,i+3)
3351 c write (iout,*) "betai =",betai
3352 do k=1,constr_homology
3353 dih_diff(k)=pinorm(dih(k,i)-betai)
3354 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3355 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3356 c & -(6.28318-dih_diff(i,k))
3357 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3358 c & 6.28318+dih_diff(i,k)
3360 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3362 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3364 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3367 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3370 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3371 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3373 write (iout,*) "i",i," betai",betai," kat2",kat2
3374 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3376 if (kat2.le.1.0d-14) cycle
3377 kat=kat-dLOG(kat2/constr_homology)
3378 c write (iout,*) "kat",kat ! sum of -ln-s
3380 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3381 ccc & dLOG(kat2), "-kat=", -kat
3384 c ----------------------------------------------------------------------
3386 c ----------------------------------------------------------------------
3390 do k=1,constr_homology
3392 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3394 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3396 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3397 sum_sgdih=sum_sgdih+sgdih
3399 c grad_dih3=sum_sgdih/sum_gdih
3400 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3402 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3403 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3404 ccc & gloc(nphi+i-3,icg)
3405 gloc(i,icg)=gloc(i,icg)+grad_dih3
3407 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3409 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3410 ccc & gloc(nphi+i-3,icg)
3412 enddo ! i-loop for dih
3414 write(iout,*) "------- dih restrs end -------"
3417 c Pseudo-energy and gradient for theta angle restraints from
3418 c homology templates
3419 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3423 c For constr_homology reference structures (FP)
3425 c Uconst_back_tot=0.0d0
3428 c Econstr_back legacy
3431 c do i=ithet_start,ithet_end
3434 c do i=loc_start,loc_end
3437 duscdiffx(j,i)=0.0d0
3443 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3444 c write (iout,*) "waga_theta",waga_theta
3445 if (waga_theta.gt.0.0d0) then
3447 write (iout,*) "usampl",usampl
3448 write(iout,*) "------- theta restrs start -------"
3449 c do i=ithet_start,ithet_end
3450 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3453 c write (iout,*) "maxres",maxres,"nres",nres
3455 do i=ithet_start,ithet_end
3458 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3460 c Deviation of theta angles wrt constr_homology ref structures
3462 utheta_i=0.0d0 ! argument of Gaussian for single k
3463 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3464 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3465 c over residues in a fragment
3466 c write (iout,*) "theta(",i,")=",theta(i)
3467 do k=1,constr_homology
3469 c dtheta_i=theta(j)-thetaref(j,iref)
3470 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3471 theta_diff(k)=thetatpl(k,i)-theta(i)
3473 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3474 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3475 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3476 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3477 c Gradient for single Gaussian restraint in subr Econstr_back
3478 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3481 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3482 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3486 c Gradient for multiple Gaussian restraint
3487 sum_gtheta=gutheta_i
3489 do k=1,constr_homology
3490 c New generalized expr for multiple Gaussian from Econstr_back
3491 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3493 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3494 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3497 c Final value of gradient using same var as in Econstr_back
3498 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3499 & *waga_homology(iset)
3500 c dutheta(i)=sum_sgtheta/sum_gtheta
3502 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3504 Eval=Eval-dLOG(gutheta_i/constr_homology)
3505 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3506 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3507 c Uconst_back=Uconst_back+utheta(i)
3508 enddo ! (i-loop for theta)
3510 write(iout,*) "------- theta restrs end -------"
3514 c Deviation of local SC geometry
3516 c Separation of two i-loops (instructed by AL - 11/3/2014)
3518 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3519 c write (iout,*) "waga_d",waga_d
3522 write(iout,*) "------- SC restrs start -------"
3523 write (iout,*) "Initial duscdiff,duscdiffx"
3524 do i=loc_start,loc_end
3525 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3526 & (duscdiffx(jik,i),jik=1,3)
3529 do i=loc_start,loc_end
3530 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3531 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3532 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3533 c write(iout,*) "xxtab, yytab, zztab"
3534 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3535 do k=1,constr_homology
3537 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3538 c Original sign inverted for calc of gradients (s. Econstr_back)
3539 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3540 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3541 c write(iout,*) "dxx, dyy, dzz"
3542 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3544 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3545 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3546 c uscdiffk(k)=usc_diff(i)
3547 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3548 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3549 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3550 c & xxref(j),yyref(j),zzref(j)
3555 c Generalized expression for multiple Gaussian acc to that for a single
3556 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3558 c Original implementation
3559 c sum_guscdiff=guscdiff(i)
3561 c sum_sguscdiff=0.0d0
3562 c do k=1,constr_homology
3563 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3564 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3565 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3568 c Implementation of new expressions for gradient (Jan. 2015)
3570 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3572 do k=1,constr_homology
3574 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3575 c before. Now the drivatives should be correct
3577 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3578 c Original sign inverted for calc of gradients (s. Econstr_back)
3579 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3580 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3582 c New implementation
3584 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3585 & sigma_d(k,i) ! for the grad wrt r'
3586 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3589 c New implementation
3590 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3592 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3593 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3594 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3595 duscdiff(jik,i)=duscdiff(jik,i)+
3596 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3597 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3598 duscdiffx(jik,i)=duscdiffx(jik,i)+
3599 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3600 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3603 write(iout,*) "jik",jik,"i",i
3604 write(iout,*) "dxx, dyy, dzz"
3605 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3606 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3607 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3608 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3609 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3610 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3611 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3612 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3613 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3614 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3615 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3616 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3617 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3618 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3619 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3626 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3627 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3629 c write (iout,*) i," uscdiff",uscdiff(i)
3631 c Put together deviations from local geometry
3633 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3634 c & wfrag_back(3,i,iset)*uscdiff(i)
3635 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3636 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3637 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3638 c Uconst_back=Uconst_back+usc_diff(i)
3640 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3642 c New implment: multiplied by sum_sguscdiff
3645 enddo ! (i-loop for dscdiff)
3650 write(iout,*) "------- SC restrs end -------"
3651 write (iout,*) "------ After SC loop in e_modeller ------"
3652 do i=loc_start,loc_end
3653 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3654 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3656 if (waga_theta.eq.1.0d0) then
3657 write (iout,*) "in e_modeller after SC restr end: dutheta"
3658 do i=ithet_start,ithet_end
3659 write (iout,*) i,dutheta(i)
3662 if (waga_d.eq.1.0d0) then
3663 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3665 write (iout,*) i,(duscdiff(j,i),j=1,3)
3666 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3671 c Total energy from homology restraints
3673 write (iout,*) "odleg",odleg," kat",kat
3674 write (iout,*) "odleg",odleg," kat",kat
3675 write (iout,*) "Eval",Eval," Erot",Erot
3676 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3677 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3678 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3679 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3682 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3684 c ehomology_constr=odleg+kat
3686 c For Lorentzian-type Urestr
3689 if (waga_dist.ge.0.0d0) then
3691 c For Gaussian-type Urestr
3693 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3694 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3695 c write (iout,*) "ehomology_constr=",ehomology_constr
3698 c For Lorentzian-type Urestr
3700 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3701 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3702 c write (iout,*) "ehomology_constr=",ehomology_constr
3705 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
3706 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3707 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
3708 write (iout,*) "ehomology_constr",ehomology_constr
3712 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3713 747 format(a12,i4,i4,i4,f8.3,f8.3)
3714 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3715 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3716 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3717 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3719 C--------------------------------------------------------------------------
3720 subroutine ebond(estr)
3722 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3724 implicit real*8 (a-h,o-z)
3725 include 'DIMENSIONS'
3726 include 'COMMON.LOCAL'
3727 include 'COMMON.GEO'
3728 include 'COMMON.INTERACT'
3729 include 'COMMON.DERIV'
3730 include 'COMMON.VAR'
3731 include 'COMMON.CHAIN'
3732 include 'COMMON.IOUNITS'
3733 include 'COMMON.NAMES'
3734 include 'COMMON.FFIELD'
3735 include 'COMMON.CONTROL'
3736 double precision u(3),ud(3)
3739 diff = vbld(i)-vbldp0
3740 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3743 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3748 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3755 diff=vbld(i+nres)-vbldsc0(1,iti)
3756 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3757 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3758 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3760 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3764 diff=vbld(i+nres)-vbldsc0(j,iti)
3765 ud(j)=aksc(j,iti)*diff
3766 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3780 uprod2=uprod2*u(k)*u(k)
3784 usumsqder=usumsqder+ud(j)*uprod2
3786 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3787 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3788 estr=estr+uprod/usum
3790 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3798 C--------------------------------------------------------------------------
3799 subroutine ebend(etheta)
3801 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3802 C angles gamma and its derivatives in consecutive thetas and gammas.
3804 implicit real*8 (a-h,o-z)
3805 include 'DIMENSIONS'
3806 include 'sizesclu.dat'
3807 include 'COMMON.LOCAL'
3808 include 'COMMON.GEO'
3809 include 'COMMON.INTERACT'
3810 include 'COMMON.DERIV'
3811 include 'COMMON.VAR'
3812 include 'COMMON.CHAIN'
3813 include 'COMMON.IOUNITS'
3814 include 'COMMON.NAMES'
3815 include 'COMMON.FFIELD'
3816 common /calcthet/ term1,term2,termm,diffak,ratak,
3817 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3818 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3819 double precision y(2),z(2)
3821 time11=dexp(-2*time)
3824 c write (iout,*) "nres",nres
3825 c write (*,'(a,i2)') 'EBEND ICG=',icg
3826 c write (iout,*) ithet_start,ithet_end
3827 do i=ithet_start,ithet_end
3828 C Zero the energy function and its derivative at 0 or pi.
3829 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3831 c if (i.gt.ithet_start .and.
3832 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3833 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3841 c if (i.lt.nres .and. itel(i).ne.0) then
3853 call proc_proc(phii,icrc)
3854 if (icrc.eq.1) phii=150.0
3868 call proc_proc(phii1,icrc)
3869 if (icrc.eq.1) phii1=150.0
3881 C Calculate the "mean" value of theta from the part of the distribution
3882 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3883 C In following comments this theta will be referred to as t_c.
3884 thet_pred_mean=0.0d0
3888 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3890 c write (iout,*) "thet_pred_mean",thet_pred_mean
3891 dthett=thet_pred_mean*ssd
3892 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3893 c write (iout,*) "thet_pred_mean",thet_pred_mean
3894 C Derivatives of the "mean" values in gamma1 and gamma2.
3895 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3896 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3897 if (theta(i).gt.pi-delta) then
3898 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3900 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3901 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3902 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3904 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3906 else if (theta(i).lt.delta) then
3907 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3908 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3909 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3911 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3912 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3915 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3918 etheta=etheta+ethetai
3919 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3920 c & rad2deg*phii,rad2deg*phii1,ethetai
3921 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3922 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3923 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3926 C Ufff.... We've done all this!!!
3929 C---------------------------------------------------------------------------
3930 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3932 implicit real*8 (a-h,o-z)
3933 include 'DIMENSIONS'
3934 include 'COMMON.LOCAL'
3935 include 'COMMON.IOUNITS'
3936 common /calcthet/ term1,term2,termm,diffak,ratak,
3937 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3938 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3939 C Calculate the contributions to both Gaussian lobes.
3940 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3941 C The "polynomial part" of the "standard deviation" of this part of
3945 sig=sig*thet_pred_mean+polthet(j,it)
3947 C Derivative of the "interior part" of the "standard deviation of the"
3948 C gamma-dependent Gaussian lobe in t_c.
3949 sigtc=3*polthet(3,it)
3951 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3954 C Set the parameters of both Gaussian lobes of the distribution.
3955 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3956 fac=sig*sig+sigc0(it)
3959 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3960 sigsqtc=-4.0D0*sigcsq*sigtc
3961 c print *,i,sig,sigtc,sigsqtc
3962 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3963 sigtc=-sigtc/(fac*fac)
3964 C Following variable is sigma(t_c)**(-2)
3965 sigcsq=sigcsq*sigcsq
3967 sig0inv=1.0D0/sig0i**2
3968 delthec=thetai-thet_pred_mean
3969 delthe0=thetai-theta0i
3970 term1=-0.5D0*sigcsq*delthec*delthec
3971 term2=-0.5D0*sig0inv*delthe0*delthe0
3972 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3973 C NaNs in taking the logarithm. We extract the largest exponent which is added
3974 C to the energy (this being the log of the distribution) at the end of energy
3975 C term evaluation for this virtual-bond angle.
3976 if (term1.gt.term2) then
3978 term2=dexp(term2-termm)
3982 term1=dexp(term1-termm)
3985 C The ratio between the gamma-independent and gamma-dependent lobes of
3986 C the distribution is a Gaussian function of thet_pred_mean too.
3987 diffak=gthet(2,it)-thet_pred_mean
3988 ratak=diffak/gthet(3,it)**2
3989 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3990 C Let's differentiate it in thet_pred_mean NOW.
3992 C Now put together the distribution terms to make complete distribution.
3993 termexp=term1+ak*term2
3994 termpre=sigc+ak*sig0i
3995 C Contribution of the bending energy from this theta is just the -log of
3996 C the sum of the contributions from the two lobes and the pre-exponential
3997 C factor. Simple enough, isn't it?
3998 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3999 C NOW the derivatives!!!
4000 C 6/6/97 Take into account the deformation.
4001 E_theta=(delthec*sigcsq*term1
4002 & +ak*delthe0*sig0inv*term2)/termexp
4003 E_tc=((sigtc+aktc*sig0i)/termpre
4004 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4005 & aktc*term2)/termexp)
4008 c-----------------------------------------------------------------------------
4009 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4010 implicit real*8 (a-h,o-z)
4011 include 'DIMENSIONS'
4012 include 'COMMON.LOCAL'
4013 include 'COMMON.IOUNITS'
4014 common /calcthet/ term1,term2,termm,diffak,ratak,
4015 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4016 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4017 delthec=thetai-thet_pred_mean
4018 delthe0=thetai-theta0i
4019 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4020 t3 = thetai-thet_pred_mean
4024 t14 = t12+t6*sigsqtc
4026 t21 = thetai-theta0i
4032 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4033 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4034 & *(-t12*t9-ak*sig0inv*t27)
4038 C--------------------------------------------------------------------------
4039 subroutine ebend(etheta)
4041 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4042 C angles gamma and its derivatives in consecutive thetas and gammas.
4043 C ab initio-derived potentials from
4044 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4046 implicit real*8 (a-h,o-z)
4047 include 'DIMENSIONS'
4048 include 'COMMON.LOCAL'
4049 include 'COMMON.GEO'
4050 include 'COMMON.INTERACT'
4051 include 'COMMON.DERIV'
4052 include 'COMMON.VAR'
4053 include 'COMMON.CHAIN'
4054 include 'COMMON.IOUNITS'
4055 include 'COMMON.NAMES'
4056 include 'COMMON.FFIELD'
4057 include 'COMMON.CONTROL'
4058 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4059 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4060 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4061 & sinph1ph2(maxdouble,maxdouble)
4062 logical lprn /.false./, lprn1 /.false./
4064 do i=ithet_start,ithet_end
4065 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4066 & (itype(i).eq.ntyp1)) cycle
4070 theti2=0.5d0*theta(i)
4071 ityp2=ithetyp(itype(i-1))
4073 coskt(k)=dcos(k*theti2)
4074 sinkt(k)=dsin(k*theti2)
4076 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4079 if (phii.ne.phii) phii=150.0
4083 ityp1=ithetyp(itype(i-2))
4085 cosph1(k)=dcos(k*phii)
4086 sinph1(k)=dsin(k*phii)
4090 ityp1=ithetyp(itype(i-2))
4096 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4099 if (phii1.ne.phii1) phii1=150.0
4104 ityp3=ithetyp(itype(i))
4106 cosph2(k)=dcos(k*phii1)
4107 sinph2(k)=dsin(k*phii1)
4111 ityp3=ithetyp(itype(i))
4117 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4118 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4120 ethetai=aa0thet(ityp1,ityp2,ityp3)
4123 ccl=cosph1(l)*cosph2(k-l)
4124 ssl=sinph1(l)*sinph2(k-l)
4125 scl=sinph1(l)*cosph2(k-l)
4126 csl=cosph1(l)*sinph2(k-l)
4127 cosph1ph2(l,k)=ccl-ssl
4128 cosph1ph2(k,l)=ccl+ssl
4129 sinph1ph2(l,k)=scl+csl
4130 sinph1ph2(k,l)=scl-csl
4134 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4135 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4136 write (iout,*) "coskt and sinkt"
4138 write (iout,*) k,coskt(k),sinkt(k)
4142 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4143 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4146 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4147 & " ethetai",ethetai
4150 write (iout,*) "cosph and sinph"
4152 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4154 write (iout,*) "cosph1ph2 and sinph2ph2"
4157 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4158 & sinph1ph2(l,k),sinph1ph2(k,l)
4161 write(iout,*) "ethetai",ethetai
4165 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4166 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4167 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4168 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4169 ethetai=ethetai+sinkt(m)*aux
4170 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4171 dephii=dephii+k*sinkt(m)*(
4172 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4173 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4174 dephii1=dephii1+k*sinkt(m)*(
4175 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4176 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4178 & write (iout,*) "m",m," k",k," bbthet",
4179 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4180 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4181 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4182 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4186 & write(iout,*) "ethetai",ethetai
4190 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4191 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4192 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4193 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4194 ethetai=ethetai+sinkt(m)*aux
4195 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4196 dephii=dephii+l*sinkt(m)*(
4197 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4198 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4199 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4200 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4201 dephii1=dephii1+(k-l)*sinkt(m)*(
4202 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4203 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4204 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4205 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4207 write (iout,*) "m",m," k",k," l",l," ffthet",
4208 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4209 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4210 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4211 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4212 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4213 & cosph1ph2(k,l)*sinkt(m),
4214 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4221 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4222 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4223 & phii1*rad2deg,ethetai
4225 etheta=etheta+ethetai
4227 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4228 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4229 gloc(nphi+i-2,icg)=wang*dethetai
4235 c-----------------------------------------------------------------------------
4236 subroutine esc(escloc)
4237 C Calculate the local energy of a side chain and its derivatives in the
4238 C corresponding virtual-bond valence angles THETA and the spherical angles
4240 implicit real*8 (a-h,o-z)
4241 include 'DIMENSIONS'
4242 include 'sizesclu.dat'
4243 include 'COMMON.GEO'
4244 include 'COMMON.LOCAL'
4245 include 'COMMON.VAR'
4246 include 'COMMON.INTERACT'
4247 include 'COMMON.DERIV'
4248 include 'COMMON.CHAIN'
4249 include 'COMMON.IOUNITS'
4250 include 'COMMON.NAMES'
4251 include 'COMMON.FFIELD'
4252 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4253 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4254 common /sccalc/ time11,time12,time112,theti,it,nlobit
4257 c write (iout,'(a)') 'ESC'
4258 do i=loc_start,loc_end
4260 if (it.eq.10) goto 1
4262 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4263 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4264 theti=theta(i+1)-pipol
4268 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4270 if (x(2).gt.pi-delta) then
4274 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4276 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4277 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4279 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4280 & ddersc0(1),dersc(1))
4281 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4282 & ddersc0(3),dersc(3))
4284 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4286 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4287 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4288 & dersc0(2),esclocbi,dersc02)
4289 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4291 call splinthet(x(2),0.5d0*delta,ss,ssd)
4296 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4298 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4299 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4301 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4303 c write (iout,*) escloci
4304 else if (x(2).lt.delta) then
4308 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4310 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4311 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4313 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4314 & ddersc0(1),dersc(1))
4315 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4316 & ddersc0(3),dersc(3))
4318 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4320 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4321 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4322 & dersc0(2),esclocbi,dersc02)
4323 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4328 call splinthet(x(2),0.5d0*delta,ss,ssd)
4330 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4332 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4333 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4335 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4336 c write (iout,*) escloci
4338 call enesc(x,escloci,dersc,ddummy,.false.)
4341 escloc=escloc+escloci
4342 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4344 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4346 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4347 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4352 C---------------------------------------------------------------------------
4353 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4354 implicit real*8 (a-h,o-z)
4355 include 'DIMENSIONS'
4356 include 'COMMON.GEO'
4357 include 'COMMON.LOCAL'
4358 include 'COMMON.IOUNITS'
4359 common /sccalc/ time11,time12,time112,theti,it,nlobit
4360 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4361 double precision contr(maxlob,-1:1)
4363 c write (iout,*) 'it=',it,' nlobit=',nlobit
4367 if (mixed) ddersc(j)=0.0d0
4371 C Because of periodicity of the dependence of the SC energy in omega we have
4372 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4373 C To avoid underflows, first compute & store the exponents.
4381 z(k)=x(k)-censc(k,j,it)
4386 Axk=Axk+gaussc(l,k,j,it)*z(l)
4392 expfac=expfac+Ax(k,j,iii)*z(k)
4400 C As in the case of ebend, we want to avoid underflows in exponentiation and
4401 C subsequent NaNs and INFs in energy calculation.
4402 C Find the largest exponent
4406 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4410 cd print *,'it=',it,' emin=',emin
4412 C Compute the contribution to SC energy and derivatives
4416 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4417 cd print *,'j=',j,' expfac=',expfac
4418 escloc_i=escloc_i+expfac
4420 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4424 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4425 & +gaussc(k,2,j,it))*expfac
4432 dersc(1)=dersc(1)/cos(theti)**2
4433 ddersc(1)=ddersc(1)/cos(theti)**2
4436 escloci=-(dlog(escloc_i)-emin)
4438 dersc(j)=dersc(j)/escloc_i
4442 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4447 C------------------------------------------------------------------------------
4448 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4449 implicit real*8 (a-h,o-z)
4450 include 'DIMENSIONS'
4451 include 'COMMON.GEO'
4452 include 'COMMON.LOCAL'
4453 include 'COMMON.IOUNITS'
4454 common /sccalc/ time11,time12,time112,theti,it,nlobit
4455 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4456 double precision contr(maxlob)
4467 z(k)=x(k)-censc(k,j,it)
4473 Axk=Axk+gaussc(l,k,j,it)*z(l)
4479 expfac=expfac+Ax(k,j)*z(k)
4484 C As in the case of ebend, we want to avoid underflows in exponentiation and
4485 C subsequent NaNs and INFs in energy calculation.
4486 C Find the largest exponent
4489 if (emin.gt.contr(j)) emin=contr(j)
4493 C Compute the contribution to SC energy and derivatives
4497 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4498 escloc_i=escloc_i+expfac
4500 dersc(k)=dersc(k)+Ax(k,j)*expfac
4502 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4503 & +gaussc(1,2,j,it))*expfac
4507 dersc(1)=dersc(1)/cos(theti)**2
4508 dersc12=dersc12/cos(theti)**2
4509 escloci=-(dlog(escloc_i)-emin)
4511 dersc(j)=dersc(j)/escloc_i
4513 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4517 c----------------------------------------------------------------------------------
4518 subroutine esc(escloc)
4519 C Calculate the local energy of a side chain and its derivatives in the
4520 C corresponding virtual-bond valence angles THETA and the spherical angles
4521 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4522 C added by Urszula Kozlowska. 07/11/2007
4524 implicit real*8 (a-h,o-z)
4525 include 'DIMENSIONS'
4526 include 'COMMON.GEO'
4527 include 'COMMON.LOCAL'
4528 include 'COMMON.VAR'
4529 include 'COMMON.SCROT'
4530 include 'COMMON.INTERACT'
4531 include 'COMMON.DERIV'
4532 include 'COMMON.CHAIN'
4533 include 'COMMON.IOUNITS'
4534 include 'COMMON.NAMES'
4535 include 'COMMON.FFIELD'
4536 include 'COMMON.CONTROL'
4537 include 'COMMON.VECTORS'
4538 double precision x_prime(3),y_prime(3),z_prime(3)
4539 & , sumene,dsc_i,dp2_i,x(65),
4540 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4541 & de_dxx,de_dyy,de_dzz,de_dt
4542 double precision s1_t,s1_6_t,s2_t,s2_6_t
4544 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4545 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4546 & dt_dCi(3),dt_dCi1(3)
4547 common /sccalc/ time11,time12,time112,theti,it,nlobit
4550 do i=loc_start,loc_end
4551 costtab(i+1) =dcos(theta(i+1))
4552 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4553 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4554 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4555 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4556 cosfac=dsqrt(cosfac2)
4557 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4558 sinfac=dsqrt(sinfac2)
4560 if (it.eq.10) goto 1
4562 C Compute the axes of tghe local cartesian coordinates system; store in
4563 c x_prime, y_prime and z_prime
4570 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4571 C & dc_norm(3,i+nres)
4573 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4574 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4577 z_prime(j) = -uz(j,i-1)
4580 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4581 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4582 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4583 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4584 c & " xy",scalar(x_prime(1),y_prime(1)),
4585 c & " xz",scalar(x_prime(1),z_prime(1)),
4586 c & " yy",scalar(y_prime(1),y_prime(1)),
4587 c & " yz",scalar(y_prime(1),z_prime(1)),
4588 c & " zz",scalar(z_prime(1),z_prime(1))
4590 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4591 C to local coordinate system. Store in xx, yy, zz.
4597 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4598 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4599 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4606 C Compute the energy of the ith side cbain
4608 c write (2,*) "xx",xx," yy",yy," zz",zz
4611 x(j) = sc_parmin(j,it)
4614 Cc diagnostics - remove later
4616 yy1 = dsin(alph(2))*dcos(omeg(2))
4617 zz1 = -dsin(alph(2))*dsin(omeg(2))
4618 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4619 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4621 C," --- ", xx_w,yy_w,zz_w
4624 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4625 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4627 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4628 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4630 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4631 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4632 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4633 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4634 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4636 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4637 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4638 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4639 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4640 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4642 dsc_i = 0.743d0+x(61)
4644 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4645 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4646 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4647 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4648 s1=(1+x(63))/(0.1d0 + dscp1)
4649 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4650 s2=(1+x(65))/(0.1d0 + dscp2)
4651 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4652 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4653 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4654 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4656 c & dscp1,dscp2,sumene
4657 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4658 escloc = escloc + sumene
4659 c write (2,*) "escloc",escloc
4660 if (.not. calc_grad) goto 1
4663 C This section to check the numerical derivatives of the energy of ith side
4664 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4665 C #define DEBUG in the code to turn it on.
4667 write (2,*) "sumene =",sumene
4671 write (2,*) xx,yy,zz
4672 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4673 de_dxx_num=(sumenep-sumene)/aincr
4675 write (2,*) "xx+ sumene from enesc=",sumenep
4678 write (2,*) xx,yy,zz
4679 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4680 de_dyy_num=(sumenep-sumene)/aincr
4682 write (2,*) "yy+ sumene from enesc=",sumenep
4685 write (2,*) xx,yy,zz
4686 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4687 de_dzz_num=(sumenep-sumene)/aincr
4689 write (2,*) "zz+ sumene from enesc=",sumenep
4690 costsave=cost2tab(i+1)
4691 sintsave=sint2tab(i+1)
4692 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4693 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4694 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4695 de_dt_num=(sumenep-sumene)/aincr
4696 write (2,*) " t+ sumene from enesc=",sumenep
4697 cost2tab(i+1)=costsave
4698 sint2tab(i+1)=sintsave
4699 C End of diagnostics section.
4702 C Compute the gradient of esc
4704 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4705 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4706 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4707 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4708 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4709 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4710 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4711 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4712 pom1=(sumene3*sint2tab(i+1)+sumene1)
4713 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4714 pom2=(sumene4*cost2tab(i+1)+sumene2)
4715 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4716 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4717 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4718 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4720 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4721 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4722 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4724 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4725 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4726 & +(pom1+pom2)*pom_dx
4728 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4731 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4732 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4733 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4735 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4736 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4737 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4738 & +x(59)*zz**2 +x(60)*xx*zz
4739 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4740 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4741 & +(pom1-pom2)*pom_dy
4743 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4746 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4747 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4748 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4749 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4750 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4751 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4752 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4753 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4755 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4758 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4759 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4760 & +pom1*pom_dt1+pom2*pom_dt2
4762 write(2,*), "de_dt = ", de_dt,de_dt_num
4766 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4767 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4768 cosfac2xx=cosfac2*xx
4769 sinfac2yy=sinfac2*yy
4771 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4773 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4775 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4776 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4777 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4778 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4779 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4780 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4781 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4782 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4783 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4784 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4788 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4789 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4792 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4793 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4794 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4796 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4797 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4801 dXX_Ctab(k,i)=dXX_Ci(k)
4802 dXX_C1tab(k,i)=dXX_Ci1(k)
4803 dYY_Ctab(k,i)=dYY_Ci(k)
4804 dYY_C1tab(k,i)=dYY_Ci1(k)
4805 dZZ_Ctab(k,i)=dZZ_Ci(k)
4806 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4807 dXX_XYZtab(k,i)=dXX_XYZ(k)
4808 dYY_XYZtab(k,i)=dYY_XYZ(k)
4809 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4813 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4814 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4815 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4816 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4817 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4819 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4820 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4821 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4822 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4823 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4824 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4825 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4826 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4828 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4829 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4831 C to check gradient call subroutine check_grad
4838 c------------------------------------------------------------------------------
4839 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4841 C This procedure calculates two-body contact function g(rij) and its derivative:
4844 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4847 C where x=(rij-r0ij)/delta
4849 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4852 double precision rij,r0ij,eps0ij,fcont,fprimcont
4853 double precision x,x2,x4,delta
4857 if (x.lt.-1.0D0) then
4860 else if (x.le.1.0D0) then
4863 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4864 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4871 c------------------------------------------------------------------------------
4872 subroutine splinthet(theti,delta,ss,ssder)
4873 implicit real*8 (a-h,o-z)
4874 include 'DIMENSIONS'
4875 include 'sizesclu.dat'
4876 include 'COMMON.VAR'
4877 include 'COMMON.GEO'
4880 if (theti.gt.pipol) then
4881 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4883 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4888 c------------------------------------------------------------------------------
4889 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4891 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4892 double precision ksi,ksi2,ksi3,a1,a2,a3
4893 a1=fprim0*delta/(f1-f0)
4899 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4900 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4903 c------------------------------------------------------------------------------
4904 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4906 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4907 double precision ksi,ksi2,ksi3,a1,a2,a3
4912 a2=3*(f1x-f0x)-2*fprim0x*delta
4913 a3=fprim0x*delta-2*(f1x-f0x)
4914 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4917 C-----------------------------------------------------------------------------
4919 C-----------------------------------------------------------------------------
4920 subroutine etor(etors,edihcnstr,fact)
4921 implicit real*8 (a-h,o-z)
4922 include 'DIMENSIONS'
4923 include 'sizesclu.dat'
4924 include 'COMMON.VAR'
4925 include 'COMMON.GEO'
4926 include 'COMMON.LOCAL'
4927 include 'COMMON.TORSION'
4928 include 'COMMON.INTERACT'
4929 include 'COMMON.DERIV'
4930 include 'COMMON.CHAIN'
4931 include 'COMMON.NAMES'
4932 include 'COMMON.IOUNITS'
4933 include 'COMMON.FFIELD'
4934 include 'COMMON.TORCNSTR'
4936 C Set lprn=.true. for debugging
4940 do i=iphi_start,iphi_end
4941 itori=itortyp(itype(i-2))
4942 itori1=itortyp(itype(i-1))
4945 C Proline-Proline pair is a special case...
4946 if (itori.eq.3 .and. itori1.eq.3) then
4947 if (phii.gt.-dwapi3) then
4949 fac=1.0D0/(1.0D0-cosphi)
4950 etorsi=v1(1,3,3)*fac
4951 etorsi=etorsi+etorsi
4952 etors=etors+etorsi-v1(1,3,3)
4953 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4956 v1ij=v1(j+1,itori,itori1)
4957 v2ij=v2(j+1,itori,itori1)
4960 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4961 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4965 v1ij=v1(j,itori,itori1)
4966 v2ij=v2(j,itori,itori1)
4969 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4970 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4974 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4975 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4976 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4977 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4978 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4980 ! 6/20/98 - dihedral angle constraints
4983 itori=idih_constr(i)
4985 difi=pinorm(phii-phi0(i))
4986 if (difi.gt.drange(i)) then
4988 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4989 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4990 else if (difi.lt.-drange(i)) then
4992 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4993 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4995 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4996 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4998 write (iout,*) 'edihcnstr',edihcnstr
5001 c------------------------------------------------------------------------------
5003 subroutine etor(etors,edihcnstr,fact)
5004 implicit real*8 (a-h,o-z)
5005 include 'DIMENSIONS'
5006 include 'sizesclu.dat'
5007 include 'COMMON.VAR'
5008 include 'COMMON.GEO'
5009 include 'COMMON.LOCAL'
5010 include 'COMMON.TORSION'
5011 include 'COMMON.INTERACT'
5012 include 'COMMON.DERIV'
5013 include 'COMMON.CHAIN'
5014 include 'COMMON.NAMES'
5015 include 'COMMON.IOUNITS'
5016 include 'COMMON.FFIELD'
5017 include 'COMMON.TORCNSTR'
5019 C Set lprn=.true. for debugging
5023 do i=iphi_start,iphi_end
5024 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5025 itori=itortyp(itype(i-2))
5026 itori1=itortyp(itype(i-1))
5029 C Regular cosine and sine terms
5030 do j=1,nterm(itori,itori1)
5031 v1ij=v1(j,itori,itori1)
5032 v2ij=v2(j,itori,itori1)
5035 etors=etors+v1ij*cosphi+v2ij*sinphi
5036 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5040 C E = SUM ----------------------------------- - v1
5041 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5043 cosphi=dcos(0.5d0*phii)
5044 sinphi=dsin(0.5d0*phii)
5045 do j=1,nlor(itori,itori1)
5046 vl1ij=vlor1(j,itori,itori1)
5047 vl2ij=vlor2(j,itori,itori1)
5048 vl3ij=vlor3(j,itori,itori1)
5049 pom=vl2ij*cosphi+vl3ij*sinphi
5050 pom1=1.0d0/(pom*pom+1.0d0)
5051 etors=etors+vl1ij*pom1
5053 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5055 C Subtract the constant term
5056 etors=etors-v0(itori,itori1)
5058 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5059 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5060 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5061 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5062 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5065 ! 6/20/98 - dihedral angle constraints
5067 c write (iout,*) "Dihedral angle restraint energy"
5069 itori=idih_constr(i)
5071 difi=pinorm(phii-phi0(i))
5072 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5073 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
5074 if (difi.gt.drange(i)) then
5076 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5077 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5078 c write (iout,*) 0.25d0*ftors*difi**4
5079 else if (difi.lt.-drange(i)) then
5081 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5082 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5083 c write (iout,*) 0.25d0*ftors*difi**4
5086 c write (iout,*) 'edihcnstr',edihcnstr
5089 c----------------------------------------------------------------------------
5090 subroutine etor_d(etors_d,fact2)
5091 C 6/23/01 Compute double torsional energy
5092 implicit real*8 (a-h,o-z)
5093 include 'DIMENSIONS'
5094 include 'sizesclu.dat'
5095 include 'COMMON.VAR'
5096 include 'COMMON.GEO'
5097 include 'COMMON.LOCAL'
5098 include 'COMMON.TORSION'
5099 include 'COMMON.INTERACT'
5100 include 'COMMON.DERIV'
5101 include 'COMMON.CHAIN'
5102 include 'COMMON.NAMES'
5103 include 'COMMON.IOUNITS'
5104 include 'COMMON.FFIELD'
5105 include 'COMMON.TORCNSTR'
5107 C Set lprn=.true. for debugging
5111 do i=iphi_start,iphi_end-1
5112 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5114 itori=itortyp(itype(i-2))
5115 itori1=itortyp(itype(i-1))
5116 itori2=itortyp(itype(i))
5121 C Regular cosine and sine terms
5122 do j=1,ntermd_1(itori,itori1,itori2)
5123 v1cij=v1c(1,j,itori,itori1,itori2)
5124 v1sij=v1s(1,j,itori,itori1,itori2)
5125 v2cij=v1c(2,j,itori,itori1,itori2)
5126 v2sij=v1s(2,j,itori,itori1,itori2)
5127 cosphi1=dcos(j*phii)
5128 sinphi1=dsin(j*phii)
5129 cosphi2=dcos(j*phii1)
5130 sinphi2=dsin(j*phii1)
5131 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5132 & v2cij*cosphi2+v2sij*sinphi2
5133 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5134 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5136 do k=2,ntermd_2(itori,itori1,itori2)
5138 v1cdij = v2c(k,l,itori,itori1,itori2)
5139 v2cdij = v2c(l,k,itori,itori1,itori2)
5140 v1sdij = v2s(k,l,itori,itori1,itori2)
5141 v2sdij = v2s(l,k,itori,itori1,itori2)
5142 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5143 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5144 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5145 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5146 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5147 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5148 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5149 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5150 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5151 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5154 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5155 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5161 c------------------------------------------------------------------------------
5162 subroutine eback_sc_corr(esccor,fact)
5163 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5164 c conformational states; temporarily implemented as differences
5165 c between UNRES torsional potentials (dependent on three types of
5166 c residues) and the torsional potentials dependent on all 20 types
5167 c of residues computed from AM1 energy surfaces of terminally-blocked
5168 c amino-acid residues.
5169 implicit real*8 (a-h,o-z)
5170 include 'DIMENSIONS'
5171 include 'COMMON.VAR'
5172 include 'COMMON.GEO'
5173 include 'COMMON.LOCAL'
5174 include 'COMMON.TORSION'
5175 include 'COMMON.SCCOR'
5176 include 'COMMON.INTERACT'
5177 include 'COMMON.DERIV'
5178 include 'COMMON.CHAIN'
5179 include 'COMMON.NAMES'
5180 include 'COMMON.IOUNITS'
5181 include 'COMMON.FFIELD'
5182 include 'COMMON.CONTROL'
5184 C Set lprn=.true. for debugging
5187 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5189 do i=itau_start,itau_end
5191 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5192 isccori=isccortyp(itype(i-2))
5193 isccori1=isccortyp(itype(i-1))
5195 cccc Added 9 May 2012
5196 cc Tauangle is torsional engle depending on the value of first digit
5197 c(see comment below)
5198 cc Omicron is flat angle depending on the value of first digit
5199 c(see comment below)
5202 do intertyp=1,3 !intertyp
5203 cc Added 09 May 2012 (Adasko)
5204 cc Intertyp means interaction type of backbone mainchain correlation:
5205 c 1 = SC...Ca...Ca...Ca
5206 c 2 = Ca...Ca...Ca...SC
5207 c 3 = SC...Ca...Ca...SCi
5209 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5210 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5211 & (itype(i-1).eq.21)))
5212 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5213 & .or.(itype(i-2).eq.21)))
5214 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5215 & (itype(i-1).eq.21)))) cycle
5216 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5217 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5219 do j=1,nterm_sccor(isccori,isccori1)
5220 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5221 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5222 cosphi=dcos(j*tauangle(intertyp,i))
5223 sinphi=dsin(j*tauangle(intertyp,i))
5224 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5226 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5228 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5230 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5231 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5232 c &gloc_sc(intertyp,i-3,icg)
5234 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5235 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5236 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5237 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5238 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5241 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5247 c------------------------------------------------------------------------------
5248 subroutine multibody(ecorr)
5249 C This subroutine calculates multi-body contributions to energy following
5250 C the idea of Skolnick et al. If side chains I and J make a contact and
5251 C at the same time side chains I+1 and J+1 make a contact, an extra
5252 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5253 implicit real*8 (a-h,o-z)
5254 include 'DIMENSIONS'
5255 include 'COMMON.IOUNITS'
5256 include 'COMMON.DERIV'
5257 include 'COMMON.INTERACT'
5258 include 'COMMON.CONTACTS'
5259 double precision gx(3),gx1(3)
5262 C Set lprn=.true. for debugging
5266 write (iout,'(a)') 'Contact function values:'
5268 write (iout,'(i2,20(1x,i2,f10.5))')
5269 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5284 num_conti=num_cont(i)
5285 num_conti1=num_cont(i1)
5290 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5291 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5292 cd & ' ishift=',ishift
5293 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5294 C The system gains extra energy.
5295 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5296 endif ! j1==j+-ishift
5305 c------------------------------------------------------------------------------
5306 double precision function esccorr(i,j,k,l,jj,kk)
5307 implicit real*8 (a-h,o-z)
5308 include 'DIMENSIONS'
5309 include 'COMMON.IOUNITS'
5310 include 'COMMON.DERIV'
5311 include 'COMMON.INTERACT'
5312 include 'COMMON.CONTACTS'
5313 double precision gx(3),gx1(3)
5318 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5319 C Calculate the multi-body contribution to energy.
5320 C Calculate multi-body contributions to the gradient.
5321 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5322 cd & k,l,(gacont(m,kk,k),m=1,3)
5324 gx(m) =ekl*gacont(m,jj,i)
5325 gx1(m)=eij*gacont(m,kk,k)
5326 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5327 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5328 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5329 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5333 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5338 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5344 c------------------------------------------------------------------------------
5346 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5347 implicit real*8 (a-h,o-z)
5348 include 'DIMENSIONS'
5349 integer dimen1,dimen2,atom,indx
5350 double precision buffer(dimen1,dimen2)
5351 double precision zapas
5352 common /contacts_hb/ zapas(3,20,maxres,7),
5353 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5354 & num_cont_hb(maxres),jcont_hb(20,maxres)
5355 num_kont=num_cont_hb(atom)
5359 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5362 buffer(i,indx+22)=facont_hb(i,atom)
5363 buffer(i,indx+23)=ees0p(i,atom)
5364 buffer(i,indx+24)=ees0m(i,atom)
5365 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5367 buffer(1,indx+26)=dfloat(num_kont)
5370 c------------------------------------------------------------------------------
5371 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5372 implicit real*8 (a-h,o-z)
5373 include 'DIMENSIONS'
5374 integer dimen1,dimen2,atom,indx
5375 double precision buffer(dimen1,dimen2)
5376 double precision zapas
5377 common /contacts_hb/ zapas(3,20,maxres,7),
5378 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5379 & num_cont_hb(maxres),jcont_hb(20,maxres)
5380 num_kont=buffer(1,indx+26)
5381 num_kont_old=num_cont_hb(atom)
5382 num_cont_hb(atom)=num_kont+num_kont_old
5387 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5390 facont_hb(ii,atom)=buffer(i,indx+22)
5391 ees0p(ii,atom)=buffer(i,indx+23)
5392 ees0m(ii,atom)=buffer(i,indx+24)
5393 jcont_hb(ii,atom)=buffer(i,indx+25)
5397 c------------------------------------------------------------------------------
5399 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5400 C This subroutine calculates multi-body contributions to hydrogen-bonding
5401 implicit real*8 (a-h,o-z)
5402 include 'DIMENSIONS'
5403 include 'sizesclu.dat'
5404 include 'COMMON.IOUNITS'
5406 include 'COMMON.INFO'
5408 include 'COMMON.FFIELD'
5409 include 'COMMON.DERIV'
5410 include 'COMMON.INTERACT'
5411 include 'COMMON.CONTACTS'
5413 parameter (max_cont=maxconts)
5414 parameter (max_dim=2*(8*3+2))
5415 parameter (msglen1=max_cont*max_dim*4)
5416 parameter (msglen2=2*msglen1)
5417 integer source,CorrelType,CorrelID,Error
5418 double precision buffer(max_cont,max_dim)
5420 double precision gx(3),gx1(3)
5423 C Set lprn=.true. for debugging
5428 if (fgProcs.le.1) goto 30
5430 write (iout,'(a)') 'Contact function values:'
5432 write (iout,'(2i3,50(1x,i2,f5.2))')
5433 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5434 & j=1,num_cont_hb(i))
5437 C Caution! Following code assumes that electrostatic interactions concerning
5438 C a given atom are split among at most two processors!
5448 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5451 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5452 if (MyRank.gt.0) then
5453 C Send correlation contributions to the preceding processor
5455 nn=num_cont_hb(iatel_s)
5456 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5457 cd write (iout,*) 'The BUFFER array:'
5459 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5461 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5463 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5464 C Clear the contacts of the atom passed to the neighboring processor
5465 nn=num_cont_hb(iatel_s+1)
5467 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5469 num_cont_hb(iatel_s)=0
5471 cd write (iout,*) 'Processor ',MyID,MyRank,
5472 cd & ' is sending correlation contribution to processor',MyID-1,
5473 cd & ' msglen=',msglen
5474 cd write (*,*) 'Processor ',MyID,MyRank,
5475 cd & ' is sending correlation contribution to processor',MyID-1,
5476 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5477 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5478 cd write (iout,*) 'Processor ',MyID,
5479 cd & ' has sent correlation contribution to processor',MyID-1,
5480 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5481 cd write (*,*) 'Processor ',MyID,
5482 cd & ' has sent correlation contribution to processor',MyID-1,
5483 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5485 endif ! (MyRank.gt.0)
5489 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5490 if (MyRank.lt.fgProcs-1) then
5491 C Receive correlation contributions from the next processor
5493 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5494 cd write (iout,*) 'Processor',MyID,
5495 cd & ' is receiving correlation contribution from processor',MyID+1,
5496 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5497 cd write (*,*) 'Processor',MyID,
5498 cd & ' is receiving correlation contribution from processor',MyID+1,
5499 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5501 do while (nbytes.le.0)
5502 call mp_probe(MyID+1,CorrelType,nbytes)
5504 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5505 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5506 cd write (iout,*) 'Processor',MyID,
5507 cd & ' has received correlation contribution from processor',MyID+1,
5508 cd & ' msglen=',msglen,' nbytes=',nbytes
5509 cd write (iout,*) 'The received BUFFER array:'
5511 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5513 if (msglen.eq.msglen1) then
5514 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5515 else if (msglen.eq.msglen2) then
5516 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5517 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5520 & 'ERROR!!!! message length changed while processing correlations.'
5522 & 'ERROR!!!! message length changed while processing correlations.'
5523 call mp_stopall(Error)
5524 endif ! msglen.eq.msglen1
5525 endif ! MyRank.lt.fgProcs-1
5532 write (iout,'(a)') 'Contact function values:'
5534 write (iout,'(2i3,50(1x,i2,f5.2))')
5535 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5536 & j=1,num_cont_hb(i))
5540 C Remove the loop below after debugging !!!
5547 C Calculate the local-electrostatic correlation terms
5548 do i=iatel_s,iatel_e+1
5550 num_conti=num_cont_hb(i)
5551 num_conti1=num_cont_hb(i+1)
5556 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5557 c & ' jj=',jj,' kk=',kk
5558 if (j1.eq.j+1 .or. j1.eq.j-1) then
5559 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5560 C The system gains extra energy.
5561 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5563 else if (j1.eq.j) then
5564 C Contacts I-J and I-(J+1) occur simultaneously.
5565 C The system loses extra energy.
5566 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5571 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5572 c & ' jj=',jj,' kk=',kk
5574 C Contacts I-J and (I+1)-J occur simultaneously.
5575 C The system loses extra energy.
5576 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5583 c------------------------------------------------------------------------------
5584 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5586 C This subroutine calculates multi-body contributions to hydrogen-bonding
5587 implicit real*8 (a-h,o-z)
5588 include 'DIMENSIONS'
5589 include 'sizesclu.dat'
5590 include 'COMMON.IOUNITS'
5592 include 'COMMON.INFO'
5594 include 'COMMON.FFIELD'
5595 include 'COMMON.DERIV'
5596 include 'COMMON.INTERACT'
5597 include 'COMMON.CONTACTS'
5599 parameter (max_cont=maxconts)
5600 parameter (max_dim=2*(8*3+2))
5601 parameter (msglen1=max_cont*max_dim*4)
5602 parameter (msglen2=2*msglen1)
5603 integer source,CorrelType,CorrelID,Error
5604 double precision buffer(max_cont,max_dim)
5606 double precision gx(3),gx1(3)
5609 C Set lprn=.true. for debugging
5616 if (fgProcs.le.1) goto 30
5618 write (iout,'(a)') 'Contact function values:'
5620 write (iout,'(2i3,50(1x,i2,f5.2))')
5621 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5622 & j=1,num_cont_hb(i))
5625 C Caution! Following code assumes that electrostatic interactions concerning
5626 C a given atom are split among at most two processors!
5636 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5639 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5640 if (MyRank.gt.0) then
5641 C Send correlation contributions to the preceding processor
5643 nn=num_cont_hb(iatel_s)
5644 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5645 cd write (iout,*) 'The BUFFER array:'
5647 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5649 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5651 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5652 C Clear the contacts of the atom passed to the neighboring processor
5653 nn=num_cont_hb(iatel_s+1)
5655 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5657 num_cont_hb(iatel_s)=0
5659 cd write (iout,*) 'Processor ',MyID,MyRank,
5660 cd & ' is sending correlation contribution to processor',MyID-1,
5661 cd & ' msglen=',msglen
5662 cd write (*,*) 'Processor ',MyID,MyRank,
5663 cd & ' is sending correlation contribution to processor',MyID-1,
5664 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5665 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5666 cd write (iout,*) 'Processor ',MyID,
5667 cd & ' has sent correlation contribution to processor',MyID-1,
5668 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5669 cd write (*,*) 'Processor ',MyID,
5670 cd & ' has sent correlation contribution to processor',MyID-1,
5671 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5673 endif ! (MyRank.gt.0)
5677 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5678 if (MyRank.lt.fgProcs-1) then
5679 C Receive correlation contributions from the next processor
5681 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5682 cd write (iout,*) 'Processor',MyID,
5683 cd & ' is receiving correlation contribution from processor',MyID+1,
5684 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5685 cd write (*,*) 'Processor',MyID,
5686 cd & ' is receiving correlation contribution from processor',MyID+1,
5687 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5689 do while (nbytes.le.0)
5690 call mp_probe(MyID+1,CorrelType,nbytes)
5692 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5693 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5694 cd write (iout,*) 'Processor',MyID,
5695 cd & ' has received correlation contribution from processor',MyID+1,
5696 cd & ' msglen=',msglen,' nbytes=',nbytes
5697 cd write (iout,*) 'The received BUFFER array:'
5699 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5701 if (msglen.eq.msglen1) then
5702 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5703 else if (msglen.eq.msglen2) then
5704 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5705 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5708 & 'ERROR!!!! message length changed while processing correlations.'
5710 & 'ERROR!!!! message length changed while processing correlations.'
5711 call mp_stopall(Error)
5712 endif ! msglen.eq.msglen1
5713 endif ! MyRank.lt.fgProcs-1
5720 write (iout,'(a)') 'Contact function values:'
5722 write (iout,'(2i3,50(1x,i2,f5.2))')
5723 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5724 & j=1,num_cont_hb(i))
5730 C Remove the loop below after debugging !!!
5737 C Calculate the dipole-dipole interaction energies
5738 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5739 do i=iatel_s,iatel_e+1
5740 num_conti=num_cont_hb(i)
5747 C Calculate the local-electrostatic correlation terms
5748 do i=iatel_s,iatel_e+1
5750 num_conti=num_cont_hb(i)
5751 num_conti1=num_cont_hb(i+1)
5756 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5757 c & ' jj=',jj,' kk=',kk
5758 if (j1.eq.j+1 .or. j1.eq.j-1) then
5759 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5760 C The system gains extra energy.
5762 sqd1=dsqrt(d_cont(jj,i))
5763 sqd2=dsqrt(d_cont(kk,i1))
5764 sred_geom = sqd1*sqd2
5765 IF (sred_geom.lt.cutoff_corr) THEN
5766 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5768 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5769 c & ' jj=',jj,' kk=',kk
5770 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5771 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5773 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5774 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5777 cd write (iout,*) 'sred_geom=',sred_geom,
5778 cd & ' ekont=',ekont,' fprim=',fprimcont
5779 call calc_eello(i,j,i+1,j1,jj,kk)
5780 if (wcorr4.gt.0.0d0)
5781 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5782 if (wcorr5.gt.0.0d0)
5783 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5784 c print *,"wcorr5",ecorr5
5785 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5786 cd write(2,*)'ijkl',i,j,i+1,j1
5787 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5788 & .or. wturn6.eq.0.0d0))then
5789 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5790 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5791 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5792 c & 'ecorr6=',ecorr6, wcorr6
5793 cd write (iout,'(4e15.5)') sred_geom,
5794 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5795 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5796 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5797 else if (wturn6.gt.0.0d0
5798 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5799 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5800 eturn6=eturn6+eello_turn6(i,jj,kk)
5801 cd write (2,*) 'multibody_eello:eturn6',eturn6
5805 else if (j1.eq.j) then
5806 C Contacts I-J and I-(J+1) occur simultaneously.
5807 C The system loses extra energy.
5808 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5813 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5814 c & ' jj=',jj,' kk=',kk
5816 C Contacts I-J and (I+1)-J occur simultaneously.
5817 C The system loses extra energy.
5818 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5825 c------------------------------------------------------------------------------
5826 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5827 implicit real*8 (a-h,o-z)
5828 include 'DIMENSIONS'
5829 include 'COMMON.IOUNITS'
5830 include 'COMMON.DERIV'
5831 include 'COMMON.INTERACT'
5832 include 'COMMON.CONTACTS'
5833 double precision gx(3),gx1(3)
5843 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5844 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5845 C Following 4 lines for diagnostics.
5850 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5852 c write (iout,*)'Contacts have occurred for peptide groups',
5853 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5854 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5855 C Calculate the multi-body contribution to energy.
5856 ecorr=ecorr+ekont*ees
5858 C Calculate multi-body contributions to the gradient.
5860 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5861 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5862 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5863 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5864 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5865 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5866 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5867 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5868 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5869 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5870 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5871 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5872 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5873 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5877 gradcorr(ll,m)=gradcorr(ll,m)+
5878 & ees*ekl*gacont_hbr(ll,jj,i)-
5879 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5880 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5885 gradcorr(ll,m)=gradcorr(ll,m)+
5886 & ees*eij*gacont_hbr(ll,kk,k)-
5887 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5888 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5895 C---------------------------------------------------------------------------
5896 subroutine dipole(i,j,jj)
5897 implicit real*8 (a-h,o-z)
5898 include 'DIMENSIONS'
5899 include 'sizesclu.dat'
5900 include 'COMMON.IOUNITS'
5901 include 'COMMON.CHAIN'
5902 include 'COMMON.FFIELD'
5903 include 'COMMON.DERIV'
5904 include 'COMMON.INTERACT'
5905 include 'COMMON.CONTACTS'
5906 include 'COMMON.TORSION'
5907 include 'COMMON.VAR'
5908 include 'COMMON.GEO'
5909 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5911 iti1 = itortyp(itype(i+1))
5912 if (j.lt.nres-1) then
5913 itj1 = itortyp(itype(j+1))
5918 dipi(iii,1)=Ub2(iii,i)
5919 dipderi(iii)=Ub2der(iii,i)
5920 dipi(iii,2)=b1(iii,iti1)
5921 dipj(iii,1)=Ub2(iii,j)
5922 dipderj(iii)=Ub2der(iii,j)
5923 dipj(iii,2)=b1(iii,itj1)
5927 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5930 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5933 if (.not.calc_grad) return
5938 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5942 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5947 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5948 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5950 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5952 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5954 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5958 C---------------------------------------------------------------------------
5959 subroutine calc_eello(i,j,k,l,jj,kk)
5961 C This subroutine computes matrices and vectors needed to calculate
5962 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5964 implicit real*8 (a-h,o-z)
5965 include 'DIMENSIONS'
5966 include 'sizesclu.dat'
5967 include 'COMMON.IOUNITS'
5968 include 'COMMON.CHAIN'
5969 include 'COMMON.DERIV'
5970 include 'COMMON.INTERACT'
5971 include 'COMMON.CONTACTS'
5972 include 'COMMON.TORSION'
5973 include 'COMMON.VAR'
5974 include 'COMMON.GEO'
5975 include 'COMMON.FFIELD'
5976 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5977 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5980 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5981 cd & ' jj=',jj,' kk=',kk
5982 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5985 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5986 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5989 call transpose2(aa1(1,1),aa1t(1,1))
5990 call transpose2(aa2(1,1),aa2t(1,1))
5993 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5994 & aa1tder(1,1,lll,kkk))
5995 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5996 & aa2tder(1,1,lll,kkk))
6000 C parallel orientation of the two CA-CA-CA frames.
6002 iti=itortyp(itype(i))
6006 itk1=itortyp(itype(k+1))
6007 itj=itortyp(itype(j))
6008 if (l.lt.nres-1) then
6009 itl1=itortyp(itype(l+1))
6013 C A1 kernel(j+1) A2T
6015 cd write (iout,'(3f10.5,5x,3f10.5)')
6016 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6018 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6019 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6020 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6021 C Following matrices are needed only for 6-th order cumulants
6022 IF (wcorr6.gt.0.0d0) THEN
6023 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6024 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6025 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6026 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6027 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6028 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6029 & ADtEAderx(1,1,1,1,1,1))
6031 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6032 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6033 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6034 & ADtEA1derx(1,1,1,1,1,1))
6036 C End 6-th order cumulants
6039 cd write (2,*) 'In calc_eello6'
6041 cd write (2,*) 'iii=',iii
6043 cd write (2,*) 'kkk=',kkk
6045 cd write (2,'(3(2f10.5),5x)')
6046 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6051 call transpose2(EUgder(1,1,k),auxmat(1,1))
6052 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6053 call transpose2(EUg(1,1,k),auxmat(1,1))
6054 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6055 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6059 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6060 & EAEAderx(1,1,lll,kkk,iii,1))
6064 C A1T kernel(i+1) A2
6065 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6066 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6067 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6068 C Following matrices are needed only for 6-th order cumulants
6069 IF (wcorr6.gt.0.0d0) THEN
6070 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6071 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6072 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6073 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6074 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6075 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6076 & ADtEAderx(1,1,1,1,1,2))
6077 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6078 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6079 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6080 & ADtEA1derx(1,1,1,1,1,2))
6082 C End 6-th order cumulants
6083 call transpose2(EUgder(1,1,l),auxmat(1,1))
6084 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6085 call transpose2(EUg(1,1,l),auxmat(1,1))
6086 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6087 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6091 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6092 & EAEAderx(1,1,lll,kkk,iii,2))
6097 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6098 C They are needed only when the fifth- or the sixth-order cumulants are
6100 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6101 call transpose2(AEA(1,1,1),auxmat(1,1))
6102 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6103 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6104 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6105 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6106 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6107 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6108 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6109 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6110 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6111 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6112 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6113 call transpose2(AEA(1,1,2),auxmat(1,1))
6114 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6115 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6116 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6117 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6118 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6119 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6120 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6121 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6122 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6123 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6124 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6125 C Calculate the Cartesian derivatives of the vectors.
6129 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6130 call matvec2(auxmat(1,1),b1(1,iti),
6131 & AEAb1derx(1,lll,kkk,iii,1,1))
6132 call matvec2(auxmat(1,1),Ub2(1,i),
6133 & AEAb2derx(1,lll,kkk,iii,1,1))
6134 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6135 & AEAb1derx(1,lll,kkk,iii,2,1))
6136 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6137 & AEAb2derx(1,lll,kkk,iii,2,1))
6138 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6139 call matvec2(auxmat(1,1),b1(1,itj),
6140 & AEAb1derx(1,lll,kkk,iii,1,2))
6141 call matvec2(auxmat(1,1),Ub2(1,j),
6142 & AEAb2derx(1,lll,kkk,iii,1,2))
6143 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6144 & AEAb1derx(1,lll,kkk,iii,2,2))
6145 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6146 & AEAb2derx(1,lll,kkk,iii,2,2))
6153 C Antiparallel orientation of the two CA-CA-CA frames.
6155 iti=itortyp(itype(i))
6159 itk1=itortyp(itype(k+1))
6160 itl=itortyp(itype(l))
6161 itj=itortyp(itype(j))
6162 if (j.lt.nres-1) then
6163 itj1=itortyp(itype(j+1))
6167 C A2 kernel(j-1)T A1T
6168 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6169 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6170 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6171 C Following matrices are needed only for 6-th order cumulants
6172 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6173 & j.eq.i+4 .and. l.eq.i+3)) THEN
6174 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6175 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6176 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6177 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6178 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6179 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6180 & ADtEAderx(1,1,1,1,1,1))
6181 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6182 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6183 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6184 & ADtEA1derx(1,1,1,1,1,1))
6186 C End 6-th order cumulants
6187 call transpose2(EUgder(1,1,k),auxmat(1,1))
6188 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6189 call transpose2(EUg(1,1,k),auxmat(1,1))
6190 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6191 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6195 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6196 & EAEAderx(1,1,lll,kkk,iii,1))
6200 C A2T kernel(i+1)T A1
6201 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6202 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6203 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6204 C Following matrices are needed only for 6-th order cumulants
6205 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6206 & j.eq.i+4 .and. l.eq.i+3)) THEN
6207 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6208 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6209 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6210 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6211 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6212 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6213 & ADtEAderx(1,1,1,1,1,2))
6214 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6215 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6216 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6217 & ADtEA1derx(1,1,1,1,1,2))
6219 C End 6-th order cumulants
6220 call transpose2(EUgder(1,1,j),auxmat(1,1))
6221 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6222 call transpose2(EUg(1,1,j),auxmat(1,1))
6223 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6224 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6228 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6229 & EAEAderx(1,1,lll,kkk,iii,2))
6234 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6235 C They are needed only when the fifth- or the sixth-order cumulants are
6237 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6238 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6239 call transpose2(AEA(1,1,1),auxmat(1,1))
6240 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6241 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6242 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6243 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6244 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6245 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6246 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6247 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6248 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6249 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6250 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6251 call transpose2(AEA(1,1,2),auxmat(1,1))
6252 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6253 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6254 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6255 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6256 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6257 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6258 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6259 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6260 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6261 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6262 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6263 C Calculate the Cartesian derivatives of the vectors.
6267 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6268 call matvec2(auxmat(1,1),b1(1,iti),
6269 & AEAb1derx(1,lll,kkk,iii,1,1))
6270 call matvec2(auxmat(1,1),Ub2(1,i),
6271 & AEAb2derx(1,lll,kkk,iii,1,1))
6272 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6273 & AEAb1derx(1,lll,kkk,iii,2,1))
6274 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6275 & AEAb2derx(1,lll,kkk,iii,2,1))
6276 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6277 call matvec2(auxmat(1,1),b1(1,itl),
6278 & AEAb1derx(1,lll,kkk,iii,1,2))
6279 call matvec2(auxmat(1,1),Ub2(1,l),
6280 & AEAb2derx(1,lll,kkk,iii,1,2))
6281 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6282 & AEAb1derx(1,lll,kkk,iii,2,2))
6283 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6284 & AEAb2derx(1,lll,kkk,iii,2,2))
6293 C---------------------------------------------------------------------------
6294 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6295 & KK,KKderg,AKA,AKAderg,AKAderx)
6299 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6300 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6301 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6306 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6308 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6311 cd if (lprn) write (2,*) 'In kernel'
6313 cd if (lprn) write (2,*) 'kkk=',kkk
6315 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6316 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6318 cd write (2,*) 'lll=',lll
6319 cd write (2,*) 'iii=1'
6321 cd write (2,'(3(2f10.5),5x)')
6322 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6325 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6326 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6328 cd write (2,*) 'lll=',lll
6329 cd write (2,*) 'iii=2'
6331 cd write (2,'(3(2f10.5),5x)')
6332 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6339 C---------------------------------------------------------------------------
6340 double precision function eello4(i,j,k,l,jj,kk)
6341 implicit real*8 (a-h,o-z)
6342 include 'DIMENSIONS'
6343 include 'sizesclu.dat'
6344 include 'COMMON.IOUNITS'
6345 include 'COMMON.CHAIN'
6346 include 'COMMON.DERIV'
6347 include 'COMMON.INTERACT'
6348 include 'COMMON.CONTACTS'
6349 include 'COMMON.TORSION'
6350 include 'COMMON.VAR'
6351 include 'COMMON.GEO'
6352 double precision pizda(2,2),ggg1(3),ggg2(3)
6353 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6357 cd print *,'eello4:',i,j,k,l,jj,kk
6358 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6359 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6360 cold eij=facont_hb(jj,i)
6361 cold ekl=facont_hb(kk,k)
6363 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6365 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6366 gcorr_loc(k-1)=gcorr_loc(k-1)
6367 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6369 gcorr_loc(l-1)=gcorr_loc(l-1)
6370 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6372 gcorr_loc(j-1)=gcorr_loc(j-1)
6373 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6378 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6379 & -EAEAderx(2,2,lll,kkk,iii,1)
6380 cd derx(lll,kkk,iii)=0.0d0
6384 cd gcorr_loc(l-1)=0.0d0
6385 cd gcorr_loc(j-1)=0.0d0
6386 cd gcorr_loc(k-1)=0.0d0
6388 cd write (iout,*)'Contacts have occurred for peptide groups',
6389 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6390 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6391 if (j.lt.nres-1) then
6398 if (l.lt.nres-1) then
6406 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6407 ggg1(ll)=eel4*g_contij(ll,1)
6408 ggg2(ll)=eel4*g_contij(ll,2)
6409 ghalf=0.5d0*ggg1(ll)
6411 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6412 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6413 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6414 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6415 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6416 ghalf=0.5d0*ggg2(ll)
6418 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6419 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6420 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6421 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6426 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6427 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6432 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6433 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6439 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6444 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6448 cd write (2,*) iii,gcorr_loc(iii)
6452 cd write (2,*) 'ekont',ekont
6453 cd write (iout,*) 'eello4',ekont*eel4
6456 C---------------------------------------------------------------------------
6457 double precision function eello5(i,j,k,l,jj,kk)
6458 implicit real*8 (a-h,o-z)
6459 include 'DIMENSIONS'
6460 include 'sizesclu.dat'
6461 include 'COMMON.IOUNITS'
6462 include 'COMMON.CHAIN'
6463 include 'COMMON.DERIV'
6464 include 'COMMON.INTERACT'
6465 include 'COMMON.CONTACTS'
6466 include 'COMMON.TORSION'
6467 include 'COMMON.VAR'
6468 include 'COMMON.GEO'
6469 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6470 double precision ggg1(3),ggg2(3)
6471 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6476 C /l\ / \ \ / \ / \ / C
6477 C / \ / \ \ / \ / \ / C
6478 C j| o |l1 | o | o| o | | o |o C
6479 C \ |/k\| |/ \| / |/ \| |/ \| C
6480 C \i/ \ / \ / / \ / \ C
6482 C (I) (II) (III) (IV) C
6484 C eello5_1 eello5_2 eello5_3 eello5_4 C
6486 C Antiparallel chains C
6489 C /j\ / \ \ / \ / \ / C
6490 C / \ / \ \ / \ / \ / C
6491 C j1| o |l | o | o| o | | o |o C
6492 C \ |/k\| |/ \| / |/ \| |/ \| C
6493 C \i/ \ / \ / / \ / \ C
6495 C (I) (II) (III) (IV) C
6497 C eello5_1 eello5_2 eello5_3 eello5_4 C
6499 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6501 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6502 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6507 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6509 itk=itortyp(itype(k))
6510 itl=itortyp(itype(l))
6511 itj=itortyp(itype(j))
6516 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6517 cd & eel5_3_num,eel5_4_num)
6521 derx(lll,kkk,iii)=0.0d0
6525 cd eij=facont_hb(jj,i)
6526 cd ekl=facont_hb(kk,k)
6528 cd write (iout,*)'Contacts have occurred for peptide groups',
6529 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6531 C Contribution from the graph I.
6532 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6533 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6534 call transpose2(EUg(1,1,k),auxmat(1,1))
6535 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6536 vv(1)=pizda(1,1)-pizda(2,2)
6537 vv(2)=pizda(1,2)+pizda(2,1)
6538 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6539 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6541 C Explicit gradient in virtual-dihedral angles.
6542 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6543 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6544 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6545 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6546 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6547 vv(1)=pizda(1,1)-pizda(2,2)
6548 vv(2)=pizda(1,2)+pizda(2,1)
6549 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6550 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6551 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6552 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6553 vv(1)=pizda(1,1)-pizda(2,2)
6554 vv(2)=pizda(1,2)+pizda(2,1)
6556 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6557 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6558 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6560 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6561 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6562 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6564 C Cartesian gradient
6568 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6570 vv(1)=pizda(1,1)-pizda(2,2)
6571 vv(2)=pizda(1,2)+pizda(2,1)
6572 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6573 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6574 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6581 C Contribution from graph II
6582 call transpose2(EE(1,1,itk),auxmat(1,1))
6583 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6584 vv(1)=pizda(1,1)+pizda(2,2)
6585 vv(2)=pizda(2,1)-pizda(1,2)
6586 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6587 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6589 C Explicit gradient in virtual-dihedral angles.
6590 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6591 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6592 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6593 vv(1)=pizda(1,1)+pizda(2,2)
6594 vv(2)=pizda(2,1)-pizda(1,2)
6596 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6597 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6598 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6600 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6601 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6602 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6604 C Cartesian gradient
6608 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6610 vv(1)=pizda(1,1)+pizda(2,2)
6611 vv(2)=pizda(2,1)-pizda(1,2)
6612 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6613 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6614 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6623 C Parallel orientation
6624 C Contribution from graph III
6625 call transpose2(EUg(1,1,l),auxmat(1,1))
6626 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6627 vv(1)=pizda(1,1)-pizda(2,2)
6628 vv(2)=pizda(1,2)+pizda(2,1)
6629 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6630 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6632 C Explicit gradient in virtual-dihedral angles.
6633 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6634 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6635 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6636 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6637 vv(1)=pizda(1,1)-pizda(2,2)
6638 vv(2)=pizda(1,2)+pizda(2,1)
6639 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6640 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6641 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6642 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6643 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6644 vv(1)=pizda(1,1)-pizda(2,2)
6645 vv(2)=pizda(1,2)+pizda(2,1)
6646 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6647 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6648 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6649 C Cartesian gradient
6653 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6655 vv(1)=pizda(1,1)-pizda(2,2)
6656 vv(2)=pizda(1,2)+pizda(2,1)
6657 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6658 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6659 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6665 C Contribution from graph IV
6667 call transpose2(EE(1,1,itl),auxmat(1,1))
6668 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6669 vv(1)=pizda(1,1)+pizda(2,2)
6670 vv(2)=pizda(2,1)-pizda(1,2)
6671 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6672 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6674 C Explicit gradient in virtual-dihedral angles.
6675 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6676 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6677 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6678 vv(1)=pizda(1,1)+pizda(2,2)
6679 vv(2)=pizda(2,1)-pizda(1,2)
6680 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6681 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6682 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6683 C Cartesian gradient
6687 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6689 vv(1)=pizda(1,1)+pizda(2,2)
6690 vv(2)=pizda(2,1)-pizda(1,2)
6691 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6692 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6693 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6699 C Antiparallel orientation
6700 C Contribution from graph III
6702 call transpose2(EUg(1,1,j),auxmat(1,1))
6703 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6704 vv(1)=pizda(1,1)-pizda(2,2)
6705 vv(2)=pizda(1,2)+pizda(2,1)
6706 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6707 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6709 C Explicit gradient in virtual-dihedral angles.
6710 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6711 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6712 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6713 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6714 vv(1)=pizda(1,1)-pizda(2,2)
6715 vv(2)=pizda(1,2)+pizda(2,1)
6716 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6717 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6718 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6719 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6720 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6721 vv(1)=pizda(1,1)-pizda(2,2)
6722 vv(2)=pizda(1,2)+pizda(2,1)
6723 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6724 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6725 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6726 C Cartesian gradient
6730 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6732 vv(1)=pizda(1,1)-pizda(2,2)
6733 vv(2)=pizda(1,2)+pizda(2,1)
6734 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6735 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6736 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6742 C Contribution from graph IV
6744 call transpose2(EE(1,1,itj),auxmat(1,1))
6745 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6746 vv(1)=pizda(1,1)+pizda(2,2)
6747 vv(2)=pizda(2,1)-pizda(1,2)
6748 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6749 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6751 C Explicit gradient in virtual-dihedral angles.
6752 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6753 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6754 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6755 vv(1)=pizda(1,1)+pizda(2,2)
6756 vv(2)=pizda(2,1)-pizda(1,2)
6757 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6758 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6759 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6760 C Cartesian gradient
6764 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6766 vv(1)=pizda(1,1)+pizda(2,2)
6767 vv(2)=pizda(2,1)-pizda(1,2)
6768 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6769 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6770 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6777 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6778 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6779 cd write (2,*) 'ijkl',i,j,k,l
6780 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6781 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6783 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6784 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6785 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6786 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6788 if (j.lt.nres-1) then
6795 if (l.lt.nres-1) then
6805 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6807 ggg1(ll)=eel5*g_contij(ll,1)
6808 ggg2(ll)=eel5*g_contij(ll,2)
6809 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6810 ghalf=0.5d0*ggg1(ll)
6812 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6813 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6814 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6815 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6816 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6817 ghalf=0.5d0*ggg2(ll)
6819 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6820 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6821 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6822 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6827 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6828 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6833 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6834 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6840 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6845 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6849 cd write (2,*) iii,g_corr5_loc(iii)
6853 cd write (2,*) 'ekont',ekont
6854 cd write (iout,*) 'eello5',ekont*eel5
6857 c--------------------------------------------------------------------------
6858 double precision function eello6(i,j,k,l,jj,kk)
6859 implicit real*8 (a-h,o-z)
6860 include 'DIMENSIONS'
6861 include 'sizesclu.dat'
6862 include 'COMMON.IOUNITS'
6863 include 'COMMON.CHAIN'
6864 include 'COMMON.DERIV'
6865 include 'COMMON.INTERACT'
6866 include 'COMMON.CONTACTS'
6867 include 'COMMON.TORSION'
6868 include 'COMMON.VAR'
6869 include 'COMMON.GEO'
6870 include 'COMMON.FFIELD'
6871 double precision ggg1(3),ggg2(3)
6872 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6877 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6885 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6886 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6890 derx(lll,kkk,iii)=0.0d0
6894 cd eij=facont_hb(jj,i)
6895 cd ekl=facont_hb(kk,k)
6901 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6902 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6903 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6904 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6905 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6906 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6908 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6909 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6910 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6911 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6912 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6913 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6917 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6919 C If turn contributions are considered, they will be handled separately.
6920 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6921 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6922 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6923 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6924 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6925 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6926 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6929 if (j.lt.nres-1) then
6936 if (l.lt.nres-1) then
6944 ggg1(ll)=eel6*g_contij(ll,1)
6945 ggg2(ll)=eel6*g_contij(ll,2)
6946 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6947 ghalf=0.5d0*ggg1(ll)
6949 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6950 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6951 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6952 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6953 ghalf=0.5d0*ggg2(ll)
6954 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6956 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6957 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6958 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6959 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6964 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6965 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6970 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6971 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6977 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6982 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6986 cd write (2,*) iii,g_corr6_loc(iii)
6990 cd write (2,*) 'ekont',ekont
6991 cd write (iout,*) 'eello6',ekont*eel6
6994 c--------------------------------------------------------------------------
6995 double precision function eello6_graph1(i,j,k,l,imat,swap)
6996 implicit real*8 (a-h,o-z)
6997 include 'DIMENSIONS'
6998 include 'sizesclu.dat'
6999 include 'COMMON.IOUNITS'
7000 include 'COMMON.CHAIN'
7001 include 'COMMON.DERIV'
7002 include 'COMMON.INTERACT'
7003 include 'COMMON.CONTACTS'
7004 include 'COMMON.TORSION'
7005 include 'COMMON.VAR'
7006 include 'COMMON.GEO'
7007 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7011 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7013 C Parallel Antiparallel C
7019 C \ j|/k\| / \ |/k\|l / C
7024 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7025 itk=itortyp(itype(k))
7026 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7027 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7028 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7029 call transpose2(EUgC(1,1,k),auxmat(1,1))
7030 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7031 vv1(1)=pizda1(1,1)-pizda1(2,2)
7032 vv1(2)=pizda1(1,2)+pizda1(2,1)
7033 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7034 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7035 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7036 s5=scalar2(vv(1),Dtobr2(1,i))
7037 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7038 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7039 if (.not. calc_grad) return
7040 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7041 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7042 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7043 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7044 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7045 & +scalar2(vv(1),Dtobr2der(1,i)))
7046 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7047 vv1(1)=pizda1(1,1)-pizda1(2,2)
7048 vv1(2)=pizda1(1,2)+pizda1(2,1)
7049 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7050 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7052 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7053 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7054 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7055 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7056 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7058 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7059 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7060 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7061 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7062 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7064 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7065 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7066 vv1(1)=pizda1(1,1)-pizda1(2,2)
7067 vv1(2)=pizda1(1,2)+pizda1(2,1)
7068 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7069 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7070 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7071 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7080 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7081 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7082 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7083 call transpose2(EUgC(1,1,k),auxmat(1,1))
7084 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7086 vv1(1)=pizda1(1,1)-pizda1(2,2)
7087 vv1(2)=pizda1(1,2)+pizda1(2,1)
7088 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7089 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7090 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7091 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7092 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7093 s5=scalar2(vv(1),Dtobr2(1,i))
7094 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7100 c----------------------------------------------------------------------------
7101 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7102 implicit real*8 (a-h,o-z)
7103 include 'DIMENSIONS'
7104 include 'sizesclu.dat'
7105 include 'COMMON.IOUNITS'
7106 include 'COMMON.CHAIN'
7107 include 'COMMON.DERIV'
7108 include 'COMMON.INTERACT'
7109 include 'COMMON.CONTACTS'
7110 include 'COMMON.TORSION'
7111 include 'COMMON.VAR'
7112 include 'COMMON.GEO'
7114 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7115 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7118 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7120 C Parallel Antiparallel C
7126 C \ j|/k\| \ |/k\|l C
7131 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7132 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7133 C AL 7/4/01 s1 would occur in the sixth-order moment,
7134 C but not in a cluster cumulant
7136 s1=dip(1,jj,i)*dip(1,kk,k)
7138 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7139 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7140 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7141 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7142 call transpose2(EUg(1,1,k),auxmat(1,1))
7143 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7144 vv(1)=pizda(1,1)-pizda(2,2)
7145 vv(2)=pizda(1,2)+pizda(2,1)
7146 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7147 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7149 eello6_graph2=-(s1+s2+s3+s4)
7151 eello6_graph2=-(s2+s3+s4)
7154 if (.not. calc_grad) return
7155 C Derivatives in gamma(i-1)
7158 s1=dipderg(1,jj,i)*dip(1,kk,k)
7160 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7161 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7162 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7163 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7165 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7167 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7169 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7171 C Derivatives in gamma(k-1)
7173 s1=dip(1,jj,i)*dipderg(1,kk,k)
7175 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7176 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7177 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7178 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7179 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7180 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7181 vv(1)=pizda(1,1)-pizda(2,2)
7182 vv(2)=pizda(1,2)+pizda(2,1)
7183 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7185 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7187 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7189 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7190 C Derivatives in gamma(j-1) or gamma(l-1)
7193 s1=dipderg(3,jj,i)*dip(1,kk,k)
7195 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7196 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7197 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7198 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7199 vv(1)=pizda(1,1)-pizda(2,2)
7200 vv(2)=pizda(1,2)+pizda(2,1)
7201 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7204 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7206 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7209 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7210 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7212 C Derivatives in gamma(l-1) or gamma(j-1)
7215 s1=dip(1,jj,i)*dipderg(3,kk,k)
7217 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7218 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7219 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7220 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7221 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7222 vv(1)=pizda(1,1)-pizda(2,2)
7223 vv(2)=pizda(1,2)+pizda(2,1)
7224 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7227 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7229 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7232 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7233 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7235 C Cartesian derivatives.
7237 write (2,*) 'In eello6_graph2'
7239 write (2,*) 'iii=',iii
7241 write (2,*) 'kkk=',kkk
7243 write (2,'(3(2f10.5),5x)')
7244 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7254 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7256 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7259 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7261 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7262 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7264 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7265 call transpose2(EUg(1,1,k),auxmat(1,1))
7266 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7268 vv(1)=pizda(1,1)-pizda(2,2)
7269 vv(2)=pizda(1,2)+pizda(2,1)
7270 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7271 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7273 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7275 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7278 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7280 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7287 c----------------------------------------------------------------------------
7288 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7289 implicit real*8 (a-h,o-z)
7290 include 'DIMENSIONS'
7291 include 'sizesclu.dat'
7292 include 'COMMON.IOUNITS'
7293 include 'COMMON.CHAIN'
7294 include 'COMMON.DERIV'
7295 include 'COMMON.INTERACT'
7296 include 'COMMON.CONTACTS'
7297 include 'COMMON.TORSION'
7298 include 'COMMON.VAR'
7299 include 'COMMON.GEO'
7300 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7302 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7304 C Parallel Antiparallel C
7310 C j|/k\| / |/k\|l / C
7315 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7317 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7318 C energy moment and not to the cluster cumulant.
7319 iti=itortyp(itype(i))
7320 if (j.lt.nres-1) then
7321 itj1=itortyp(itype(j+1))
7325 itk=itortyp(itype(k))
7326 itk1=itortyp(itype(k+1))
7327 if (l.lt.nres-1) then
7328 itl1=itortyp(itype(l+1))
7333 s1=dip(4,jj,i)*dip(4,kk,k)
7335 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7336 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7337 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7338 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7339 call transpose2(EE(1,1,itk),auxmat(1,1))
7340 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7341 vv(1)=pizda(1,1)+pizda(2,2)
7342 vv(2)=pizda(2,1)-pizda(1,2)
7343 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7344 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7346 eello6_graph3=-(s1+s2+s3+s4)
7348 eello6_graph3=-(s2+s3+s4)
7351 if (.not. calc_grad) return
7352 C Derivatives in gamma(k-1)
7353 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7354 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7355 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7356 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7357 C Derivatives in gamma(l-1)
7358 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7359 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7360 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7361 vv(1)=pizda(1,1)+pizda(2,2)
7362 vv(2)=pizda(2,1)-pizda(1,2)
7363 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7364 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7365 C Cartesian derivatives.
7371 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7373 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7376 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7378 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7379 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7381 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7382 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7384 vv(1)=pizda(1,1)+pizda(2,2)
7385 vv(2)=pizda(2,1)-pizda(1,2)
7386 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7390 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7393 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7395 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7397 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7403 c----------------------------------------------------------------------------
7404 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7405 implicit real*8 (a-h,o-z)
7406 include 'DIMENSIONS'
7407 include 'sizesclu.dat'
7408 include 'COMMON.IOUNITS'
7409 include 'COMMON.CHAIN'
7410 include 'COMMON.DERIV'
7411 include 'COMMON.INTERACT'
7412 include 'COMMON.CONTACTS'
7413 include 'COMMON.TORSION'
7414 include 'COMMON.VAR'
7415 include 'COMMON.GEO'
7416 include 'COMMON.FFIELD'
7417 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7418 & auxvec1(2),auxmat1(2,2)
7420 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7422 C Parallel Antiparallel C
7428 C \ j|/k\| \ |/k\|l C
7433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7435 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7436 C energy moment and not to the cluster cumulant.
7437 cd write (2,*) 'eello_graph4: wturn6',wturn6
7438 iti=itortyp(itype(i))
7439 itj=itortyp(itype(j))
7440 if (j.lt.nres-1) then
7441 itj1=itortyp(itype(j+1))
7445 itk=itortyp(itype(k))
7446 if (k.lt.nres-1) then
7447 itk1=itortyp(itype(k+1))
7451 itl=itortyp(itype(l))
7452 if (l.lt.nres-1) then
7453 itl1=itortyp(itype(l+1))
7457 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7458 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7459 cd & ' itl',itl,' itl1',itl1
7462 s1=dip(3,jj,i)*dip(3,kk,k)
7464 s1=dip(2,jj,j)*dip(2,kk,l)
7467 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7468 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7470 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7471 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7473 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7474 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7476 call transpose2(EUg(1,1,k),auxmat(1,1))
7477 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7478 vv(1)=pizda(1,1)-pizda(2,2)
7479 vv(2)=pizda(2,1)+pizda(1,2)
7480 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7481 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7483 eello6_graph4=-(s1+s2+s3+s4)
7485 eello6_graph4=-(s2+s3+s4)
7487 if (.not. calc_grad) return
7488 C Derivatives in gamma(i-1)
7492 s1=dipderg(2,jj,i)*dip(3,kk,k)
7494 s1=dipderg(4,jj,j)*dip(2,kk,l)
7497 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7499 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7500 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7502 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7503 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7505 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7506 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7507 cd write (2,*) 'turn6 derivatives'
7509 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7511 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7515 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7517 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7521 C Derivatives in gamma(k-1)
7524 s1=dip(3,jj,i)*dipderg(2,kk,k)
7526 s1=dip(2,jj,j)*dipderg(4,kk,l)
7529 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7530 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7532 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7533 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7535 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7536 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7538 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7539 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7540 vv(1)=pizda(1,1)-pizda(2,2)
7541 vv(2)=pizda(2,1)+pizda(1,2)
7542 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7543 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7545 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7547 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7551 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7553 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7556 C Derivatives in gamma(j-1) or gamma(l-1)
7557 if (l.eq.j+1 .and. l.gt.1) then
7558 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7559 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7560 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7561 vv(1)=pizda(1,1)-pizda(2,2)
7562 vv(2)=pizda(2,1)+pizda(1,2)
7563 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7564 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7565 else if (j.gt.1) then
7566 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7567 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7568 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7569 vv(1)=pizda(1,1)-pizda(2,2)
7570 vv(2)=pizda(2,1)+pizda(1,2)
7571 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7572 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7573 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7575 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7578 C Cartesian derivatives.
7585 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7587 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7591 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7593 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7597 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7599 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7601 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7602 & b1(1,itj1),auxvec(1))
7603 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7605 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7606 & b1(1,itl1),auxvec(1))
7607 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7609 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(2,1)+pizda(1,2)
7613 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7615 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7617 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7620 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7623 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7626 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7628 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7634 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7636 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7639 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7641 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7649 c----------------------------------------------------------------------------
7650 double precision function eello_turn6(i,jj,kk)
7651 implicit real*8 (a-h,o-z)
7652 include 'DIMENSIONS'
7653 include 'sizesclu.dat'
7654 include 'COMMON.IOUNITS'
7655 include 'COMMON.CHAIN'
7656 include 'COMMON.DERIV'
7657 include 'COMMON.INTERACT'
7658 include 'COMMON.CONTACTS'
7659 include 'COMMON.TORSION'
7660 include 'COMMON.VAR'
7661 include 'COMMON.GEO'
7662 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7663 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7665 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7666 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7667 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7668 C the respective energy moment and not to the cluster cumulant.
7673 iti=itortyp(itype(i))
7674 itk=itortyp(itype(k))
7675 itk1=itortyp(itype(k+1))
7676 itl=itortyp(itype(l))
7677 itj=itortyp(itype(j))
7678 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7679 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7680 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7685 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7687 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7691 derx_turn(lll,kkk,iii)=0.0d0
7698 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7700 cd write (2,*) 'eello6_5',eello6_5
7702 call transpose2(AEA(1,1,1),auxmat(1,1))
7703 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7704 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7705 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7709 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7710 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7711 s2 = scalar2(b1(1,itk),vtemp1(1))
7713 call transpose2(AEA(1,1,2),atemp(1,1))
7714 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7715 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7716 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7720 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7721 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7722 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7724 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7725 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7726 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7727 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7728 ss13 = scalar2(b1(1,itk),vtemp4(1))
7729 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7733 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7739 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7741 C Derivatives in gamma(i+2)
7743 call transpose2(AEA(1,1,1),auxmatd(1,1))
7744 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7745 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7746 call transpose2(AEAderg(1,1,2),atempd(1,1))
7747 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7748 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7752 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7753 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7754 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7760 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7761 C Derivatives in gamma(i+3)
7763 call transpose2(AEA(1,1,1),auxmatd(1,1))
7764 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7765 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7766 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7770 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7771 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7772 s2d = scalar2(b1(1,itk),vtemp1d(1))
7774 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7775 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7777 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7779 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7780 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7781 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7791 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7792 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7794 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7795 & -0.5d0*ekont*(s2d+s12d)
7797 C Derivatives in gamma(i+4)
7798 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7799 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7800 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7802 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7803 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7804 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7814 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7816 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7818 C Derivatives in gamma(i+5)
7820 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7821 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7822 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7826 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7827 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7828 s2d = scalar2(b1(1,itk),vtemp1d(1))
7830 call transpose2(AEA(1,1,2),atempd(1,1))
7831 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7832 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7836 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7837 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7839 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7840 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7841 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7851 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7852 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7854 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7855 & -0.5d0*ekont*(s2d+s12d)
7857 C Cartesian derivatives
7862 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7863 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7864 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7868 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7869 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7871 s2d = scalar2(b1(1,itk),vtemp1d(1))
7873 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7874 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7875 s8d = -(atempd(1,1)+atempd(2,2))*
7876 & scalar2(cc(1,1,itl),vtemp2(1))
7880 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7882 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7883 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7890 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7893 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7897 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7898 & - 0.5d0*(s8d+s12d)
7900 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7909 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7911 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7912 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7913 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7914 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7915 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7917 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7918 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7919 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7923 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7924 cd & 16*eel_turn6_num
7926 if (j.lt.nres-1) then
7933 if (l.lt.nres-1) then
7941 ggg1(ll)=eel_turn6*g_contij(ll,1)
7942 ggg2(ll)=eel_turn6*g_contij(ll,2)
7943 ghalf=0.5d0*ggg1(ll)
7945 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7946 & +ekont*derx_turn(ll,2,1)
7947 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7948 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7949 & +ekont*derx_turn(ll,4,1)
7950 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7951 ghalf=0.5d0*ggg2(ll)
7953 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7954 & +ekont*derx_turn(ll,2,2)
7955 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7956 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7957 & +ekont*derx_turn(ll,4,2)
7958 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7963 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7968 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7974 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7979 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7983 cd write (2,*) iii,g_corr6_loc(iii)
7986 eello_turn6=ekont*eel_turn6
7987 cd write (2,*) 'ekont',ekont
7988 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7991 crc-------------------------------------------------
7992 SUBROUTINE MATVEC2(A1,V1,V2)
7993 implicit real*8 (a-h,o-z)
7994 include 'DIMENSIONS'
7995 DIMENSION A1(2,2),V1(2),V2(2)
7999 c 3 VI=VI+A1(I,K)*V1(K)
8003 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8004 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8009 C---------------------------------------
8010 SUBROUTINE MATMAT2(A1,A2,A3)
8011 implicit real*8 (a-h,o-z)
8012 include 'DIMENSIONS'
8013 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8014 c DIMENSION AI3(2,2)
8018 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8024 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8025 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8026 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8027 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8035 c-------------------------------------------------------------------------
8036 double precision function scalar2(u,v)
8038 double precision u(2),v(2)
8041 scalar2=u(1)*v(1)+u(2)*v(2)
8045 C-----------------------------------------------------------------------------
8047 subroutine transpose2(a,at)
8049 double precision a(2,2),at(2,2)
8056 c--------------------------------------------------------------------------
8057 subroutine transpose(n,a,at)
8060 double precision a(n,n),at(n,n)
8068 C---------------------------------------------------------------------------
8069 subroutine prodmat3(a1,a2,kk,transp,prod)
8072 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8074 crc double precision auxmat(2,2),prod_(2,2)
8077 crc call transpose2(kk(1,1),auxmat(1,1))
8078 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8079 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8081 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8082 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8083 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8084 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8085 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8086 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8087 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8088 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8091 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8092 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8094 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8095 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8096 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8097 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8098 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8099 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8100 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8101 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8104 c call transpose2(a2(1,1),a2t(1,1))
8107 crc print *,((prod_(i,j),i=1,2),j=1,2)
8108 crc print *,((prod(i,j),i=1,2),j=1,2)
8112 C-----------------------------------------------------------------------------
8113 double precision function scalar(u,v)
8115 double precision u(3),v(3)