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'
2881 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2882 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2883 if (link_end.eq.0) return
2884 do i=link_start,link_end
2885 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2886 C CA-CA distance used in regularization of structure.
2889 C iii and jjj point to the residues for which the distance is assigned.
2890 if (ii.gt.nres) then
2897 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2898 c & dhpb(i),dhpb1(i),forcon(i)
2899 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2900 C distance and angle dependent SS bond potential.
2901 if (.not.dyn_ss .and. i.le.nss) then
2902 C 15/02/13 CC dynamic SSbond - additional check
2903 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2904 call ssbond_ene(iii,jjj,eij)
2906 cd write (iout,*) "eij",eij
2908 else if (ii.gt.nres .and. jj.gt.nres) then
2909 c Restraints from contact prediction
2911 if (dhpb1(i).gt.0.0d0) then
2912 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2913 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2914 c write (iout,*) "beta nmr",
2915 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2919 C Get the force constant corresponding to this distance.
2921 C Calculate the contribution to energy.
2922 ehpb=ehpb+waga*rdis*rdis
2923 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2925 C Evaluate gradient.
2930 ggg(j)=fac*(c(j,jj)-c(j,ii))
2933 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2934 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2937 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2938 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2941 C Calculate the distance between the two points and its difference from the
2944 if (dhpb1(i).gt.0.0d0) then
2945 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2946 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2947 c write (iout,*) "alph nmr",
2948 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2951 C Get the force constant corresponding to this distance.
2953 C Calculate the contribution to energy.
2954 ehpb=ehpb+waga*rdis*rdis
2955 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2957 C Evaluate gradient.
2961 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2962 cd & ' waga=',waga,' fac=',fac
2964 ggg(j)=fac*(c(j,jj)-c(j,ii))
2966 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2967 C If this is a SC-SC distance, we need to calculate the contributions to the
2968 C Cartesian gradient in the SC vectors (ghpbx).
2971 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2972 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2976 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2977 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2984 C--------------------------------------------------------------------------
2985 subroutine ssbond_ene(i,j,eij)
2987 C Calculate the distance and angle dependent SS-bond potential energy
2988 C using a free-energy function derived based on RHF/6-31G** ab initio
2989 C calculations of diethyl disulfide.
2991 C A. Liwo and U. Kozlowska, 11/24/03
2993 implicit real*8 (a-h,o-z)
2994 include 'DIMENSIONS'
2995 include 'sizesclu.dat'
2996 include 'COMMON.SBRIDGE'
2997 include 'COMMON.CHAIN'
2998 include 'COMMON.DERIV'
2999 include 'COMMON.LOCAL'
3000 include 'COMMON.INTERACT'
3001 include 'COMMON.VAR'
3002 include 'COMMON.IOUNITS'
3003 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3008 dxi=dc_norm(1,nres+i)
3009 dyi=dc_norm(2,nres+i)
3010 dzi=dc_norm(3,nres+i)
3011 dsci_inv=dsc_inv(itypi)
3013 dscj_inv=dsc_inv(itypj)
3017 dxj=dc_norm(1,nres+j)
3018 dyj=dc_norm(2,nres+j)
3019 dzj=dc_norm(3,nres+j)
3020 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3025 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3026 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3027 om12=dxi*dxj+dyi*dyj+dzi*dzj
3029 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3030 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3036 deltat12=om2-om1+2.0d0
3038 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3039 & +akct*deltad*deltat12+ebr
3040 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3041 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3042 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3043 c & " deltat12",deltat12," eij",eij
3044 ed=2*akcm*deltad+akct*deltat12
3046 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3047 eom1=-2*akth*deltat1-pom1-om2*pom2
3048 eom2= 2*akth*deltat2+pom1-om1*pom2
3051 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3054 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3055 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3056 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3057 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3060 C Calculate the components of the gradient in DC and X
3064 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3070 C--------------------------------------------------------------------------
3073 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3074 subroutine e_modeller(ehomology_constr)
3075 implicit real*8 (a-h,o-z)
3077 include 'DIMENSIONS'
3079 integer nnn, i, j, k, ki, irec, l
3080 integer katy, odleglosci, test7
3081 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3082 real*8 distance(max_template),distancek(max_template),
3083 & min_odl,godl(max_template),dih_diff(max_template)
3086 c FP - 30/10/2014 Temporary specifications for homology restraints
3088 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3090 double precision, dimension (maxres) :: guscdiff,usc_diff
3091 double precision, dimension (max_template) ::
3092 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3095 include 'COMMON.SBRIDGE'
3096 include 'COMMON.CHAIN'
3097 include 'COMMON.GEO'
3098 include 'COMMON.DERIV'
3099 include 'COMMON.LOCAL'
3100 include 'COMMON.INTERACT'
3101 include 'COMMON.VAR'
3102 include 'COMMON.IOUNITS'
3103 include 'COMMON.CONTROL'
3104 include 'COMMON.HOMRESTR'
3106 include 'COMMON.SETUP'
3107 include 'COMMON.NAMES'
3110 distancek(i)=9999999.9
3115 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3117 C AL 5/2/14 - Introduce list of restraints
3118 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3120 write(iout,*) "------- dist restrs start -------"
3121 write (iout,*) "link_start_homo",link_start_homo,
3122 & " link_end_homo",link_end_homo
3124 do ii = link_start_homo,link_end_homo
3128 c write (iout,*) "dij(",i,j,") =",dij
3129 do k=1,constr_homology
3130 if(.not.l_homo(k,ii)) cycle
3131 distance(k)=odl(k,ii)-dij
3132 c write (iout,*) "distance(",k,") =",distance(k)
3134 c For Gaussian-type Urestr
3136 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3137 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3138 c write (iout,*) "distancek(",k,") =",distancek(k)
3139 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3141 c For Lorentzian-type Urestr
3143 if (waga_dist.lt.0.0d0) then
3144 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3145 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3146 & (distance(k)**2+sigma_odlir(k,ii)**2))
3150 c min_odl=minval(distancek)
3151 do kk=1,constr_homology
3152 if(l_homo(kk,ii)) then
3153 min_odl=distancek(kk)
3157 do kk=1,constr_homology
3158 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3159 & min_odl=distancek(kk)
3161 c write (iout,* )"min_odl",min_odl
3163 write (iout,*) "ij dij",i,j,dij
3164 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3165 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3166 write (iout,* )"min_odl",min_odl
3169 do k=1,constr_homology
3170 c Nie wiem po co to liczycie jeszcze raz!
3171 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3172 c & (2*(sigma_odl(i,j,k))**2))
3173 if(.not.l_homo(k,ii)) cycle
3174 if (waga_dist.ge.0.0d0) then
3176 c For Gaussian-type Urestr
3178 godl(k)=dexp(-distancek(k)+min_odl)
3179 odleg2=odleg2+godl(k)
3181 c For Lorentzian-type Urestr
3184 odleg2=odleg2+distancek(k)
3187 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3188 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3189 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3190 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3193 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3194 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3196 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3197 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3199 if (waga_dist.ge.0.0d0) then
3201 c For Gaussian-type Urestr
3203 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3205 c For Lorentzian-type Urestr
3208 odleg=odleg+odleg2/constr_homology
3212 c write (iout,*) "odleg",odleg ! sum of -ln-s
3215 c For Gaussian-type Urestr
3217 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3219 do k=1,constr_homology
3220 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3221 c & *waga_dist)+min_odl
3222 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3224 if(.not.l_homo(k,ii)) cycle
3225 if (waga_dist.ge.0.0d0) then
3226 c For Gaussian-type Urestr
3228 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3230 c For Lorentzian-type Urestr
3233 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3234 & sigma_odlir(k,ii)**2)**2)
3236 sum_sgodl=sum_sgodl+sgodl
3238 c sgodl2=sgodl2+sgodl
3239 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3240 c write(iout,*) "constr_homology=",constr_homology
3241 c write(iout,*) i, j, k, "TEST K"
3243 if (waga_dist.ge.0.0d0) then
3245 c For Gaussian-type Urestr
3247 grad_odl3=waga_homology(iset)*waga_dist
3248 & *sum_sgodl/(sum_godl*dij)
3250 c For Lorentzian-type Urestr
3253 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3254 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3255 grad_odl3=-waga_homology(iset)*waga_dist*
3256 & sum_sgodl/(constr_homology*dij)
3259 c grad_odl3=sum_sgodl/(sum_godl*dij)
3262 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3263 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3264 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3266 ccc write(iout,*) godl, sgodl, grad_odl3
3268 c grad_odl=grad_odl+grad_odl3
3271 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3272 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3273 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3274 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3275 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3276 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3277 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3278 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3279 c if (i.eq.25.and.j.eq.27) then
3280 c write(iout,*) "jik",jik,"i",i,"j",j
3281 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3282 c write(iout,*) "grad_odl3",grad_odl3
3283 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3284 c write(iout,*) "ggodl",ggodl
3285 c write(iout,*) "ghpbc(",jik,i,")",
3286 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3291 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3292 ccc & dLOG(odleg2),"-odleg=", -odleg
3294 enddo ! ii-loop for dist
3296 write(iout,*) "------- dist restrs end -------"
3297 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3298 c & waga_d.eq.1.0d0) call sum_gradient
3300 c Pseudo-energy and gradient from dihedral-angle restraints from
3301 c homology templates
3302 c write (iout,*) "End of distance loop"
3305 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3307 write(iout,*) "------- dih restrs start -------"
3308 do i=idihconstr_start_homo,idihconstr_end_homo
3309 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3312 do i=idihconstr_start_homo,idihconstr_end_homo
3314 c betai=beta(i,i+1,i+2,i+3)
3316 c write (iout,*) "betai =",betai
3317 do k=1,constr_homology
3318 dih_diff(k)=pinorm(dih(k,i)-betai)
3319 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3320 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3321 c & -(6.28318-dih_diff(i,k))
3322 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3323 c & 6.28318+dih_diff(i,k)
3325 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3326 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3329 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3332 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3333 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3335 write (iout,*) "i",i," betai",betai," kat2",kat2
3336 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3338 if (kat2.le.1.0d-14) cycle
3339 kat=kat-dLOG(kat2/constr_homology)
3340 c write (iout,*) "kat",kat ! sum of -ln-s
3342 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3343 ccc & dLOG(kat2), "-kat=", -kat
3346 c ----------------------------------------------------------------------
3348 c ----------------------------------------------------------------------
3352 do k=1,constr_homology
3353 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3354 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3355 sum_sgdih=sum_sgdih+sgdih
3357 c grad_dih3=sum_sgdih/sum_gdih
3358 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3360 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3361 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3362 ccc & gloc(nphi+i-3,icg)
3363 gloc(i,icg)=gloc(i,icg)+grad_dih3
3365 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3367 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3368 ccc & gloc(nphi+i-3,icg)
3370 enddo ! i-loop for dih
3372 write(iout,*) "------- dih restrs end -------"
3375 c Pseudo-energy and gradient for theta angle restraints from
3376 c homology templates
3377 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3381 c For constr_homology reference structures (FP)
3383 c Uconst_back_tot=0.0d0
3386 c Econstr_back legacy
3389 c do i=ithet_start,ithet_end
3392 c do i=loc_start,loc_end
3395 duscdiffx(j,i)=0.0d0
3401 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3402 c write (iout,*) "waga_theta",waga_theta
3403 if (waga_theta.gt.0.0d0) then
3405 write (iout,*) "usampl",usampl
3406 write(iout,*) "------- theta restrs start -------"
3407 c do i=ithet_start,ithet_end
3408 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3411 c write (iout,*) "maxres",maxres,"nres",nres
3413 do i=ithet_start,ithet_end
3416 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3418 c Deviation of theta angles wrt constr_homology ref structures
3420 utheta_i=0.0d0 ! argument of Gaussian for single k
3421 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3422 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3423 c over residues in a fragment
3424 c write (iout,*) "theta(",i,")=",theta(i)
3425 do k=1,constr_homology
3427 c dtheta_i=theta(j)-thetaref(j,iref)
3428 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3429 theta_diff(k)=thetatpl(k,i)-theta(i)
3431 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3432 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3433 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3434 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3435 c Gradient for single Gaussian restraint in subr Econstr_back
3436 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3439 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3440 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3444 c Gradient for multiple Gaussian restraint
3445 sum_gtheta=gutheta_i
3447 do k=1,constr_homology
3448 c New generalized expr for multiple Gaussian from Econstr_back
3449 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3451 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3452 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3455 c Final value of gradient using same var as in Econstr_back
3456 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3457 & *waga_homology(iset)
3458 c dutheta(i)=sum_sgtheta/sum_gtheta
3460 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3462 Eval=Eval-dLOG(gutheta_i/constr_homology)
3463 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3464 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3465 c Uconst_back=Uconst_back+utheta(i)
3466 enddo ! (i-loop for theta)
3468 write(iout,*) "------- theta restrs end -------"
3472 c Deviation of local SC geometry
3474 c Separation of two i-loops (instructed by AL - 11/3/2014)
3476 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3477 c write (iout,*) "waga_d",waga_d
3480 write(iout,*) "------- SC restrs start -------"
3481 write (iout,*) "Initial duscdiff,duscdiffx"
3482 do i=loc_start,loc_end
3483 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3484 & (duscdiffx(jik,i),jik=1,3)
3487 do i=loc_start,loc_end
3488 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3489 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3490 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3491 c write(iout,*) "xxtab, yytab, zztab"
3492 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3493 do k=1,constr_homology
3495 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3496 c Original sign inverted for calc of gradients (s. Econstr_back)
3497 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3498 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3499 c write(iout,*) "dxx, dyy, dzz"
3500 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3502 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3503 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3504 c uscdiffk(k)=usc_diff(i)
3505 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3506 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3507 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3508 c & xxref(j),yyref(j),zzref(j)
3513 c Generalized expression for multiple Gaussian acc to that for a single
3514 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3516 c Original implementation
3517 c sum_guscdiff=guscdiff(i)
3519 c sum_sguscdiff=0.0d0
3520 c do k=1,constr_homology
3521 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3522 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3523 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3526 c Implementation of new expressions for gradient (Jan. 2015)
3528 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3530 do k=1,constr_homology
3532 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3533 c before. Now the drivatives should be correct
3535 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3536 c Original sign inverted for calc of gradients (s. Econstr_back)
3537 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3538 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3540 c New implementation
3542 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3543 & sigma_d(k,i) ! for the grad wrt r'
3544 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3547 c New implementation
3548 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3550 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3551 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3552 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3553 duscdiff(jik,i)=duscdiff(jik,i)+
3554 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3555 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3556 duscdiffx(jik,i)=duscdiffx(jik,i)+
3557 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3558 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3561 write(iout,*) "jik",jik,"i",i
3562 write(iout,*) "dxx, dyy, dzz"
3563 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3564 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3565 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3566 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3567 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3568 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3569 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3570 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3571 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3572 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3573 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3574 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3575 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3576 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3577 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3584 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3585 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3587 c write (iout,*) i," uscdiff",uscdiff(i)
3589 c Put together deviations from local geometry
3591 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3592 c & wfrag_back(3,i,iset)*uscdiff(i)
3593 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3594 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3595 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3596 c Uconst_back=Uconst_back+usc_diff(i)
3598 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3600 c New implment: multiplied by sum_sguscdiff
3603 enddo ! (i-loop for dscdiff)
3608 write(iout,*) "------- SC restrs end -------"
3609 write (iout,*) "------ After SC loop in e_modeller ------"
3610 do i=loc_start,loc_end
3611 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3612 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3614 if (waga_theta.eq.1.0d0) then
3615 write (iout,*) "in e_modeller after SC restr end: dutheta"
3616 do i=ithet_start,ithet_end
3617 write (iout,*) i,dutheta(i)
3620 if (waga_d.eq.1.0d0) then
3621 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3623 write (iout,*) i,(duscdiff(j,i),j=1,3)
3624 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3629 c Total energy from homology restraints
3631 write (iout,*) "odleg",odleg," kat",kat
3632 write (iout,*) "odleg",odleg," kat",kat
3633 write (iout,*) "Eval",Eval," Erot",Erot
3634 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3635 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3636 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3637 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3640 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3642 c ehomology_constr=odleg+kat
3644 c For Lorentzian-type Urestr
3647 if (waga_dist.ge.0.0d0) then
3649 c For Gaussian-type Urestr
3651 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3652 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3653 c write (iout,*) "ehomology_constr=",ehomology_constr
3656 c For Lorentzian-type Urestr
3658 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3659 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3660 c write (iout,*) "ehomology_constr=",ehomology_constr
3663 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
3664 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3665 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
3666 write (iout,*) "ehomology_constr",ehomology_constr
3670 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3671 747 format(a12,i4,i4,i4,f8.3,f8.3)
3672 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3673 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3674 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3675 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3677 C--------------------------------------------------------------------------
3678 subroutine ebond(estr)
3680 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3682 implicit real*8 (a-h,o-z)
3683 include 'DIMENSIONS'
3684 include 'COMMON.LOCAL'
3685 include 'COMMON.GEO'
3686 include 'COMMON.INTERACT'
3687 include 'COMMON.DERIV'
3688 include 'COMMON.VAR'
3689 include 'COMMON.CHAIN'
3690 include 'COMMON.IOUNITS'
3691 include 'COMMON.NAMES'
3692 include 'COMMON.FFIELD'
3693 include 'COMMON.CONTROL'
3694 double precision u(3),ud(3)
3697 diff = vbld(i)-vbldp0
3698 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3701 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3706 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3713 diff=vbld(i+nres)-vbldsc0(1,iti)
3714 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3715 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3716 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3718 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3722 diff=vbld(i+nres)-vbldsc0(j,iti)
3723 ud(j)=aksc(j,iti)*diff
3724 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3738 uprod2=uprod2*u(k)*u(k)
3742 usumsqder=usumsqder+ud(j)*uprod2
3744 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3745 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3746 estr=estr+uprod/usum
3748 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3756 C--------------------------------------------------------------------------
3757 subroutine ebend(etheta)
3759 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3760 C angles gamma and its derivatives in consecutive thetas and gammas.
3762 implicit real*8 (a-h,o-z)
3763 include 'DIMENSIONS'
3764 include 'sizesclu.dat'
3765 include 'COMMON.LOCAL'
3766 include 'COMMON.GEO'
3767 include 'COMMON.INTERACT'
3768 include 'COMMON.DERIV'
3769 include 'COMMON.VAR'
3770 include 'COMMON.CHAIN'
3771 include 'COMMON.IOUNITS'
3772 include 'COMMON.NAMES'
3773 include 'COMMON.FFIELD'
3774 common /calcthet/ term1,term2,termm,diffak,ratak,
3775 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3776 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3777 double precision y(2),z(2)
3779 time11=dexp(-2*time)
3782 c write (iout,*) "nres",nres
3783 c write (*,'(a,i2)') 'EBEND ICG=',icg
3784 c write (iout,*) ithet_start,ithet_end
3785 do i=ithet_start,ithet_end
3786 C Zero the energy function and its derivative at 0 or pi.
3787 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3789 c if (i.gt.ithet_start .and.
3790 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3791 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3799 c if (i.lt.nres .and. itel(i).ne.0) then
3811 call proc_proc(phii,icrc)
3812 if (icrc.eq.1) phii=150.0
3826 call proc_proc(phii1,icrc)
3827 if (icrc.eq.1) phii1=150.0
3839 C Calculate the "mean" value of theta from the part of the distribution
3840 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3841 C In following comments this theta will be referred to as t_c.
3842 thet_pred_mean=0.0d0
3846 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3848 c write (iout,*) "thet_pred_mean",thet_pred_mean
3849 dthett=thet_pred_mean*ssd
3850 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3851 c write (iout,*) "thet_pred_mean",thet_pred_mean
3852 C Derivatives of the "mean" values in gamma1 and gamma2.
3853 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3854 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3855 if (theta(i).gt.pi-delta) then
3856 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3858 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3859 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3860 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3862 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3864 else if (theta(i).lt.delta) then
3865 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3866 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3867 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3869 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3870 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3873 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3876 etheta=etheta+ethetai
3877 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3878 c & rad2deg*phii,rad2deg*phii1,ethetai
3879 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3880 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3881 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3884 C Ufff.... We've done all this!!!
3887 C---------------------------------------------------------------------------
3888 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3890 implicit real*8 (a-h,o-z)
3891 include 'DIMENSIONS'
3892 include 'COMMON.LOCAL'
3893 include 'COMMON.IOUNITS'
3894 common /calcthet/ term1,term2,termm,diffak,ratak,
3895 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3896 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3897 C Calculate the contributions to both Gaussian lobes.
3898 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3899 C The "polynomial part" of the "standard deviation" of this part of
3903 sig=sig*thet_pred_mean+polthet(j,it)
3905 C Derivative of the "interior part" of the "standard deviation of the"
3906 C gamma-dependent Gaussian lobe in t_c.
3907 sigtc=3*polthet(3,it)
3909 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3912 C Set the parameters of both Gaussian lobes of the distribution.
3913 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3914 fac=sig*sig+sigc0(it)
3917 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3918 sigsqtc=-4.0D0*sigcsq*sigtc
3919 c print *,i,sig,sigtc,sigsqtc
3920 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3921 sigtc=-sigtc/(fac*fac)
3922 C Following variable is sigma(t_c)**(-2)
3923 sigcsq=sigcsq*sigcsq
3925 sig0inv=1.0D0/sig0i**2
3926 delthec=thetai-thet_pred_mean
3927 delthe0=thetai-theta0i
3928 term1=-0.5D0*sigcsq*delthec*delthec
3929 term2=-0.5D0*sig0inv*delthe0*delthe0
3930 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3931 C NaNs in taking the logarithm. We extract the largest exponent which is added
3932 C to the energy (this being the log of the distribution) at the end of energy
3933 C term evaluation for this virtual-bond angle.
3934 if (term1.gt.term2) then
3936 term2=dexp(term2-termm)
3940 term1=dexp(term1-termm)
3943 C The ratio between the gamma-independent and gamma-dependent lobes of
3944 C the distribution is a Gaussian function of thet_pred_mean too.
3945 diffak=gthet(2,it)-thet_pred_mean
3946 ratak=diffak/gthet(3,it)**2
3947 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3948 C Let's differentiate it in thet_pred_mean NOW.
3950 C Now put together the distribution terms to make complete distribution.
3951 termexp=term1+ak*term2
3952 termpre=sigc+ak*sig0i
3953 C Contribution of the bending energy from this theta is just the -log of
3954 C the sum of the contributions from the two lobes and the pre-exponential
3955 C factor. Simple enough, isn't it?
3956 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3957 C NOW the derivatives!!!
3958 C 6/6/97 Take into account the deformation.
3959 E_theta=(delthec*sigcsq*term1
3960 & +ak*delthe0*sig0inv*term2)/termexp
3961 E_tc=((sigtc+aktc*sig0i)/termpre
3962 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3963 & aktc*term2)/termexp)
3966 c-----------------------------------------------------------------------------
3967 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3968 implicit real*8 (a-h,o-z)
3969 include 'DIMENSIONS'
3970 include 'COMMON.LOCAL'
3971 include 'COMMON.IOUNITS'
3972 common /calcthet/ term1,term2,termm,diffak,ratak,
3973 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3974 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3975 delthec=thetai-thet_pred_mean
3976 delthe0=thetai-theta0i
3977 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3978 t3 = thetai-thet_pred_mean
3982 t14 = t12+t6*sigsqtc
3984 t21 = thetai-theta0i
3990 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3991 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3992 & *(-t12*t9-ak*sig0inv*t27)
3996 C--------------------------------------------------------------------------
3997 subroutine ebend(etheta)
3999 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4000 C angles gamma and its derivatives in consecutive thetas and gammas.
4001 C ab initio-derived potentials from
4002 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4004 implicit real*8 (a-h,o-z)
4005 include 'DIMENSIONS'
4006 include 'COMMON.LOCAL'
4007 include 'COMMON.GEO'
4008 include 'COMMON.INTERACT'
4009 include 'COMMON.DERIV'
4010 include 'COMMON.VAR'
4011 include 'COMMON.CHAIN'
4012 include 'COMMON.IOUNITS'
4013 include 'COMMON.NAMES'
4014 include 'COMMON.FFIELD'
4015 include 'COMMON.CONTROL'
4016 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4017 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4018 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4019 & sinph1ph2(maxdouble,maxdouble)
4020 logical lprn /.false./, lprn1 /.false./
4022 do i=ithet_start,ithet_end
4023 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4024 & (itype(i).eq.ntyp1)) cycle
4028 theti2=0.5d0*theta(i)
4029 ityp2=ithetyp(itype(i-1))
4031 coskt(k)=dcos(k*theti2)
4032 sinkt(k)=dsin(k*theti2)
4034 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4037 if (phii.ne.phii) phii=150.0
4041 ityp1=ithetyp(itype(i-2))
4043 cosph1(k)=dcos(k*phii)
4044 sinph1(k)=dsin(k*phii)
4048 ityp1=ithetyp(itype(i-2))
4054 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4057 if (phii1.ne.phii1) phii1=150.0
4062 ityp3=ithetyp(itype(i))
4064 cosph2(k)=dcos(k*phii1)
4065 sinph2(k)=dsin(k*phii1)
4069 ityp3=ithetyp(itype(i))
4075 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4076 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4078 ethetai=aa0thet(ityp1,ityp2,ityp3)
4081 ccl=cosph1(l)*cosph2(k-l)
4082 ssl=sinph1(l)*sinph2(k-l)
4083 scl=sinph1(l)*cosph2(k-l)
4084 csl=cosph1(l)*sinph2(k-l)
4085 cosph1ph2(l,k)=ccl-ssl
4086 cosph1ph2(k,l)=ccl+ssl
4087 sinph1ph2(l,k)=scl+csl
4088 sinph1ph2(k,l)=scl-csl
4092 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4093 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4094 write (iout,*) "coskt and sinkt"
4096 write (iout,*) k,coskt(k),sinkt(k)
4100 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4101 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4104 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4105 & " ethetai",ethetai
4108 write (iout,*) "cosph and sinph"
4110 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4112 write (iout,*) "cosph1ph2 and sinph2ph2"
4115 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4116 & sinph1ph2(l,k),sinph1ph2(k,l)
4119 write(iout,*) "ethetai",ethetai
4123 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4124 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4125 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4126 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4127 ethetai=ethetai+sinkt(m)*aux
4128 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4129 dephii=dephii+k*sinkt(m)*(
4130 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4131 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4132 dephii1=dephii1+k*sinkt(m)*(
4133 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4134 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4136 & write (iout,*) "m",m," k",k," bbthet",
4137 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4138 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4139 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4140 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4144 & write(iout,*) "ethetai",ethetai
4148 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4149 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4150 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4151 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4152 ethetai=ethetai+sinkt(m)*aux
4153 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4154 dephii=dephii+l*sinkt(m)*(
4155 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4156 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4157 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4158 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4159 dephii1=dephii1+(k-l)*sinkt(m)*(
4160 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4161 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4162 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4163 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4165 write (iout,*) "m",m," k",k," l",l," ffthet",
4166 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4167 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4168 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4169 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4170 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4171 & cosph1ph2(k,l)*sinkt(m),
4172 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4179 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4180 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4181 & phii1*rad2deg,ethetai
4183 etheta=etheta+ethetai
4185 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4186 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4187 gloc(nphi+i-2,icg)=wang*dethetai
4193 c-----------------------------------------------------------------------------
4194 subroutine esc(escloc)
4195 C Calculate the local energy of a side chain and its derivatives in the
4196 C corresponding virtual-bond valence angles THETA and the spherical angles
4198 implicit real*8 (a-h,o-z)
4199 include 'DIMENSIONS'
4200 include 'sizesclu.dat'
4201 include 'COMMON.GEO'
4202 include 'COMMON.LOCAL'
4203 include 'COMMON.VAR'
4204 include 'COMMON.INTERACT'
4205 include 'COMMON.DERIV'
4206 include 'COMMON.CHAIN'
4207 include 'COMMON.IOUNITS'
4208 include 'COMMON.NAMES'
4209 include 'COMMON.FFIELD'
4210 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4211 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4212 common /sccalc/ time11,time12,time112,theti,it,nlobit
4215 c write (iout,'(a)') 'ESC'
4216 do i=loc_start,loc_end
4218 if (it.eq.10) goto 1
4220 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4221 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4222 theti=theta(i+1)-pipol
4226 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4228 if (x(2).gt.pi-delta) then
4232 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4234 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4235 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4237 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4238 & ddersc0(1),dersc(1))
4239 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4240 & ddersc0(3),dersc(3))
4242 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4244 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4245 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4246 & dersc0(2),esclocbi,dersc02)
4247 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4249 call splinthet(x(2),0.5d0*delta,ss,ssd)
4254 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4256 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4257 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4259 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4261 c write (iout,*) escloci
4262 else if (x(2).lt.delta) then
4266 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4268 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4269 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4271 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4272 & ddersc0(1),dersc(1))
4273 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4274 & ddersc0(3),dersc(3))
4276 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4278 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4279 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4280 & dersc0(2),esclocbi,dersc02)
4281 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4286 call splinthet(x(2),0.5d0*delta,ss,ssd)
4288 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4290 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4291 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4293 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4294 c write (iout,*) escloci
4296 call enesc(x,escloci,dersc,ddummy,.false.)
4299 escloc=escloc+escloci
4300 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4302 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4304 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4305 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4310 C---------------------------------------------------------------------------
4311 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4312 implicit real*8 (a-h,o-z)
4313 include 'DIMENSIONS'
4314 include 'COMMON.GEO'
4315 include 'COMMON.LOCAL'
4316 include 'COMMON.IOUNITS'
4317 common /sccalc/ time11,time12,time112,theti,it,nlobit
4318 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4319 double precision contr(maxlob,-1:1)
4321 c write (iout,*) 'it=',it,' nlobit=',nlobit
4325 if (mixed) ddersc(j)=0.0d0
4329 C Because of periodicity of the dependence of the SC energy in omega we have
4330 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4331 C To avoid underflows, first compute & store the exponents.
4339 z(k)=x(k)-censc(k,j,it)
4344 Axk=Axk+gaussc(l,k,j,it)*z(l)
4350 expfac=expfac+Ax(k,j,iii)*z(k)
4358 C As in the case of ebend, we want to avoid underflows in exponentiation and
4359 C subsequent NaNs and INFs in energy calculation.
4360 C Find the largest exponent
4364 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4368 cd print *,'it=',it,' emin=',emin
4370 C Compute the contribution to SC energy and derivatives
4374 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4375 cd print *,'j=',j,' expfac=',expfac
4376 escloc_i=escloc_i+expfac
4378 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4382 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4383 & +gaussc(k,2,j,it))*expfac
4390 dersc(1)=dersc(1)/cos(theti)**2
4391 ddersc(1)=ddersc(1)/cos(theti)**2
4394 escloci=-(dlog(escloc_i)-emin)
4396 dersc(j)=dersc(j)/escloc_i
4400 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4405 C------------------------------------------------------------------------------
4406 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4407 implicit real*8 (a-h,o-z)
4408 include 'DIMENSIONS'
4409 include 'COMMON.GEO'
4410 include 'COMMON.LOCAL'
4411 include 'COMMON.IOUNITS'
4412 common /sccalc/ time11,time12,time112,theti,it,nlobit
4413 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4414 double precision contr(maxlob)
4425 z(k)=x(k)-censc(k,j,it)
4431 Axk=Axk+gaussc(l,k,j,it)*z(l)
4437 expfac=expfac+Ax(k,j)*z(k)
4442 C As in the case of ebend, we want to avoid underflows in exponentiation and
4443 C subsequent NaNs and INFs in energy calculation.
4444 C Find the largest exponent
4447 if (emin.gt.contr(j)) emin=contr(j)
4451 C Compute the contribution to SC energy and derivatives
4455 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4456 escloc_i=escloc_i+expfac
4458 dersc(k)=dersc(k)+Ax(k,j)*expfac
4460 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4461 & +gaussc(1,2,j,it))*expfac
4465 dersc(1)=dersc(1)/cos(theti)**2
4466 dersc12=dersc12/cos(theti)**2
4467 escloci=-(dlog(escloc_i)-emin)
4469 dersc(j)=dersc(j)/escloc_i
4471 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4475 c----------------------------------------------------------------------------------
4476 subroutine esc(escloc)
4477 C Calculate the local energy of a side chain and its derivatives in the
4478 C corresponding virtual-bond valence angles THETA and the spherical angles
4479 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4480 C added by Urszula Kozlowska. 07/11/2007
4482 implicit real*8 (a-h,o-z)
4483 include 'DIMENSIONS'
4484 include 'COMMON.GEO'
4485 include 'COMMON.LOCAL'
4486 include 'COMMON.VAR'
4487 include 'COMMON.SCROT'
4488 include 'COMMON.INTERACT'
4489 include 'COMMON.DERIV'
4490 include 'COMMON.CHAIN'
4491 include 'COMMON.IOUNITS'
4492 include 'COMMON.NAMES'
4493 include 'COMMON.FFIELD'
4494 include 'COMMON.CONTROL'
4495 include 'COMMON.VECTORS'
4496 double precision x_prime(3),y_prime(3),z_prime(3)
4497 & , sumene,dsc_i,dp2_i,x(65),
4498 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4499 & de_dxx,de_dyy,de_dzz,de_dt
4500 double precision s1_t,s1_6_t,s2_t,s2_6_t
4502 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4503 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4504 & dt_dCi(3),dt_dCi1(3)
4505 common /sccalc/ time11,time12,time112,theti,it,nlobit
4508 do i=loc_start,loc_end
4509 costtab(i+1) =dcos(theta(i+1))
4510 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4511 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4512 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4513 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4514 cosfac=dsqrt(cosfac2)
4515 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4516 sinfac=dsqrt(sinfac2)
4518 if (it.eq.10) goto 1
4520 C Compute the axes of tghe local cartesian coordinates system; store in
4521 c x_prime, y_prime and z_prime
4528 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4529 C & dc_norm(3,i+nres)
4531 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4532 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4535 z_prime(j) = -uz(j,i-1)
4538 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4539 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4540 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4541 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4542 c & " xy",scalar(x_prime(1),y_prime(1)),
4543 c & " xz",scalar(x_prime(1),z_prime(1)),
4544 c & " yy",scalar(y_prime(1),y_prime(1)),
4545 c & " yz",scalar(y_prime(1),z_prime(1)),
4546 c & " zz",scalar(z_prime(1),z_prime(1))
4548 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4549 C to local coordinate system. Store in xx, yy, zz.
4555 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4556 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4557 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4564 C Compute the energy of the ith side cbain
4566 c write (2,*) "xx",xx," yy",yy," zz",zz
4569 x(j) = sc_parmin(j,it)
4572 Cc diagnostics - remove later
4574 yy1 = dsin(alph(2))*dcos(omeg(2))
4575 zz1 = -dsin(alph(2))*dsin(omeg(2))
4576 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4577 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4579 C," --- ", xx_w,yy_w,zz_w
4582 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4583 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4585 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4586 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4588 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4589 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4590 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4591 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4592 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4594 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4595 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4596 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4597 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4598 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4600 dsc_i = 0.743d0+x(61)
4602 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4603 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4604 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4605 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4606 s1=(1+x(63))/(0.1d0 + dscp1)
4607 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4608 s2=(1+x(65))/(0.1d0 + dscp2)
4609 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4610 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4611 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4612 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4614 c & dscp1,dscp2,sumene
4615 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4616 escloc = escloc + sumene
4617 c write (2,*) "escloc",escloc
4618 if (.not. calc_grad) goto 1
4621 C This section to check the numerical derivatives of the energy of ith side
4622 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4623 C #define DEBUG in the code to turn it on.
4625 write (2,*) "sumene =",sumene
4629 write (2,*) xx,yy,zz
4630 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4631 de_dxx_num=(sumenep-sumene)/aincr
4633 write (2,*) "xx+ sumene from enesc=",sumenep
4636 write (2,*) xx,yy,zz
4637 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4638 de_dyy_num=(sumenep-sumene)/aincr
4640 write (2,*) "yy+ sumene from enesc=",sumenep
4643 write (2,*) xx,yy,zz
4644 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4645 de_dzz_num=(sumenep-sumene)/aincr
4647 write (2,*) "zz+ sumene from enesc=",sumenep
4648 costsave=cost2tab(i+1)
4649 sintsave=sint2tab(i+1)
4650 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4651 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4652 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4653 de_dt_num=(sumenep-sumene)/aincr
4654 write (2,*) " t+ sumene from enesc=",sumenep
4655 cost2tab(i+1)=costsave
4656 sint2tab(i+1)=sintsave
4657 C End of diagnostics section.
4660 C Compute the gradient of esc
4662 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4663 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4664 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4665 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4666 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4667 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4668 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4669 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4670 pom1=(sumene3*sint2tab(i+1)+sumene1)
4671 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4672 pom2=(sumene4*cost2tab(i+1)+sumene2)
4673 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4674 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4675 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4676 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4678 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4679 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4680 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4682 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4683 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4684 & +(pom1+pom2)*pom_dx
4686 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4689 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4690 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4691 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4693 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4694 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4695 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4696 & +x(59)*zz**2 +x(60)*xx*zz
4697 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4698 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4699 & +(pom1-pom2)*pom_dy
4701 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4704 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4705 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4706 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4707 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4708 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4709 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4710 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4711 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4713 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4716 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4717 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4718 & +pom1*pom_dt1+pom2*pom_dt2
4720 write(2,*), "de_dt = ", de_dt,de_dt_num
4724 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4725 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4726 cosfac2xx=cosfac2*xx
4727 sinfac2yy=sinfac2*yy
4729 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4731 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4733 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4734 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4735 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4736 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4737 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4738 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4739 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4740 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4741 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4742 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4746 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4747 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4750 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4751 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4752 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4754 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4755 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4759 dXX_Ctab(k,i)=dXX_Ci(k)
4760 dXX_C1tab(k,i)=dXX_Ci1(k)
4761 dYY_Ctab(k,i)=dYY_Ci(k)
4762 dYY_C1tab(k,i)=dYY_Ci1(k)
4763 dZZ_Ctab(k,i)=dZZ_Ci(k)
4764 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4765 dXX_XYZtab(k,i)=dXX_XYZ(k)
4766 dYY_XYZtab(k,i)=dYY_XYZ(k)
4767 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4771 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4772 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4773 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4774 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4775 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4777 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4778 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4779 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4780 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4781 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4782 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4783 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4784 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4786 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4787 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4789 C to check gradient call subroutine check_grad
4796 c------------------------------------------------------------------------------
4797 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4799 C This procedure calculates two-body contact function g(rij) and its derivative:
4802 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4805 C where x=(rij-r0ij)/delta
4807 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4810 double precision rij,r0ij,eps0ij,fcont,fprimcont
4811 double precision x,x2,x4,delta
4815 if (x.lt.-1.0D0) then
4818 else if (x.le.1.0D0) then
4821 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4822 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4829 c------------------------------------------------------------------------------
4830 subroutine splinthet(theti,delta,ss,ssder)
4831 implicit real*8 (a-h,o-z)
4832 include 'DIMENSIONS'
4833 include 'sizesclu.dat'
4834 include 'COMMON.VAR'
4835 include 'COMMON.GEO'
4838 if (theti.gt.pipol) then
4839 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4841 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4846 c------------------------------------------------------------------------------
4847 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4849 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4850 double precision ksi,ksi2,ksi3,a1,a2,a3
4851 a1=fprim0*delta/(f1-f0)
4857 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4858 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4861 c------------------------------------------------------------------------------
4862 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4864 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4865 double precision ksi,ksi2,ksi3,a1,a2,a3
4870 a2=3*(f1x-f0x)-2*fprim0x*delta
4871 a3=fprim0x*delta-2*(f1x-f0x)
4872 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4875 C-----------------------------------------------------------------------------
4877 C-----------------------------------------------------------------------------
4878 subroutine etor(etors,edihcnstr,fact)
4879 implicit real*8 (a-h,o-z)
4880 include 'DIMENSIONS'
4881 include 'sizesclu.dat'
4882 include 'COMMON.VAR'
4883 include 'COMMON.GEO'
4884 include 'COMMON.LOCAL'
4885 include 'COMMON.TORSION'
4886 include 'COMMON.INTERACT'
4887 include 'COMMON.DERIV'
4888 include 'COMMON.CHAIN'
4889 include 'COMMON.NAMES'
4890 include 'COMMON.IOUNITS'
4891 include 'COMMON.FFIELD'
4892 include 'COMMON.TORCNSTR'
4894 C Set lprn=.true. for debugging
4898 do i=iphi_start,iphi_end
4899 itori=itortyp(itype(i-2))
4900 itori1=itortyp(itype(i-1))
4903 C Proline-Proline pair is a special case...
4904 if (itori.eq.3 .and. itori1.eq.3) then
4905 if (phii.gt.-dwapi3) then
4907 fac=1.0D0/(1.0D0-cosphi)
4908 etorsi=v1(1,3,3)*fac
4909 etorsi=etorsi+etorsi
4910 etors=etors+etorsi-v1(1,3,3)
4911 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4914 v1ij=v1(j+1,itori,itori1)
4915 v2ij=v2(j+1,itori,itori1)
4918 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4919 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4923 v1ij=v1(j,itori,itori1)
4924 v2ij=v2(j,itori,itori1)
4927 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4928 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4932 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4933 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4934 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4935 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4936 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4938 ! 6/20/98 - dihedral angle constraints
4941 itori=idih_constr(i)
4943 difi=pinorm(phii-phi0(i))
4944 if (difi.gt.drange(i)) then
4946 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4947 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4948 else if (difi.lt.-drange(i)) then
4950 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4951 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4953 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4954 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4956 write (iout,*) 'edihcnstr',edihcnstr
4959 c------------------------------------------------------------------------------
4961 subroutine etor(etors,edihcnstr,fact)
4962 implicit real*8 (a-h,o-z)
4963 include 'DIMENSIONS'
4964 include 'sizesclu.dat'
4965 include 'COMMON.VAR'
4966 include 'COMMON.GEO'
4967 include 'COMMON.LOCAL'
4968 include 'COMMON.TORSION'
4969 include 'COMMON.INTERACT'
4970 include 'COMMON.DERIV'
4971 include 'COMMON.CHAIN'
4972 include 'COMMON.NAMES'
4973 include 'COMMON.IOUNITS'
4974 include 'COMMON.FFIELD'
4975 include 'COMMON.TORCNSTR'
4977 C Set lprn=.true. for debugging
4981 do i=iphi_start,iphi_end
4982 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4983 itori=itortyp(itype(i-2))
4984 itori1=itortyp(itype(i-1))
4987 C Regular cosine and sine terms
4988 do j=1,nterm(itori,itori1)
4989 v1ij=v1(j,itori,itori1)
4990 v2ij=v2(j,itori,itori1)
4993 etors=etors+v1ij*cosphi+v2ij*sinphi
4994 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4998 C E = SUM ----------------------------------- - v1
4999 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5001 cosphi=dcos(0.5d0*phii)
5002 sinphi=dsin(0.5d0*phii)
5003 do j=1,nlor(itori,itori1)
5004 vl1ij=vlor1(j,itori,itori1)
5005 vl2ij=vlor2(j,itori,itori1)
5006 vl3ij=vlor3(j,itori,itori1)
5007 pom=vl2ij*cosphi+vl3ij*sinphi
5008 pom1=1.0d0/(pom*pom+1.0d0)
5009 etors=etors+vl1ij*pom1
5011 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5013 C Subtract the constant term
5014 etors=etors-v0(itori,itori1)
5016 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5017 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5018 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5019 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5020 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5023 ! 6/20/98 - dihedral angle constraints
5025 c write (iout,*) "Dihedral angle restraint energy"
5027 itori=idih_constr(i)
5029 difi=pinorm(phii-phi0(i))
5030 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5031 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
5032 if (difi.gt.drange(i)) then
5034 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5035 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5036 c write (iout,*) 0.25d0*ftors*difi**4
5037 else if (difi.lt.-drange(i)) then
5039 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5040 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5041 c write (iout,*) 0.25d0*ftors*difi**4
5044 c write (iout,*) 'edihcnstr',edihcnstr
5047 c----------------------------------------------------------------------------
5048 subroutine etor_d(etors_d,fact2)
5049 C 6/23/01 Compute double torsional energy
5050 implicit real*8 (a-h,o-z)
5051 include 'DIMENSIONS'
5052 include 'sizesclu.dat'
5053 include 'COMMON.VAR'
5054 include 'COMMON.GEO'
5055 include 'COMMON.LOCAL'
5056 include 'COMMON.TORSION'
5057 include 'COMMON.INTERACT'
5058 include 'COMMON.DERIV'
5059 include 'COMMON.CHAIN'
5060 include 'COMMON.NAMES'
5061 include 'COMMON.IOUNITS'
5062 include 'COMMON.FFIELD'
5063 include 'COMMON.TORCNSTR'
5065 C Set lprn=.true. for debugging
5069 do i=iphi_start,iphi_end-1
5070 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5072 itori=itortyp(itype(i-2))
5073 itori1=itortyp(itype(i-1))
5074 itori2=itortyp(itype(i))
5079 C Regular cosine and sine terms
5080 do j=1,ntermd_1(itori,itori1,itori2)
5081 v1cij=v1c(1,j,itori,itori1,itori2)
5082 v1sij=v1s(1,j,itori,itori1,itori2)
5083 v2cij=v1c(2,j,itori,itori1,itori2)
5084 v2sij=v1s(2,j,itori,itori1,itori2)
5085 cosphi1=dcos(j*phii)
5086 sinphi1=dsin(j*phii)
5087 cosphi2=dcos(j*phii1)
5088 sinphi2=dsin(j*phii1)
5089 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5090 & v2cij*cosphi2+v2sij*sinphi2
5091 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5092 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5094 do k=2,ntermd_2(itori,itori1,itori2)
5096 v1cdij = v2c(k,l,itori,itori1,itori2)
5097 v2cdij = v2c(l,k,itori,itori1,itori2)
5098 v1sdij = v2s(k,l,itori,itori1,itori2)
5099 v2sdij = v2s(l,k,itori,itori1,itori2)
5100 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5101 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5102 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5103 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5104 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5105 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5106 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5107 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5108 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5109 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5112 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5113 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5119 c------------------------------------------------------------------------------
5120 subroutine eback_sc_corr(esccor,fact)
5121 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5122 c conformational states; temporarily implemented as differences
5123 c between UNRES torsional potentials (dependent on three types of
5124 c residues) and the torsional potentials dependent on all 20 types
5125 c of residues computed from AM1 energy surfaces of terminally-blocked
5126 c amino-acid residues.
5127 implicit real*8 (a-h,o-z)
5128 include 'DIMENSIONS'
5129 include 'COMMON.VAR'
5130 include 'COMMON.GEO'
5131 include 'COMMON.LOCAL'
5132 include 'COMMON.TORSION'
5133 include 'COMMON.SCCOR'
5134 include 'COMMON.INTERACT'
5135 include 'COMMON.DERIV'
5136 include 'COMMON.CHAIN'
5137 include 'COMMON.NAMES'
5138 include 'COMMON.IOUNITS'
5139 include 'COMMON.FFIELD'
5140 include 'COMMON.CONTROL'
5142 C Set lprn=.true. for debugging
5145 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5147 do i=itau_start,itau_end
5149 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5150 isccori=isccortyp(itype(i-2))
5151 isccori1=isccortyp(itype(i-1))
5153 cccc Added 9 May 2012
5154 cc Tauangle is torsional engle depending on the value of first digit
5155 c(see comment below)
5156 cc Omicron is flat angle depending on the value of first digit
5157 c(see comment below)
5160 do intertyp=1,3 !intertyp
5161 cc Added 09 May 2012 (Adasko)
5162 cc Intertyp means interaction type of backbone mainchain correlation:
5163 c 1 = SC...Ca...Ca...Ca
5164 c 2 = Ca...Ca...Ca...SC
5165 c 3 = SC...Ca...Ca...SCi
5167 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5168 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5169 & (itype(i-1).eq.21)))
5170 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5171 & .or.(itype(i-2).eq.21)))
5172 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5173 & (itype(i-1).eq.21)))) cycle
5174 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5175 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5177 do j=1,nterm_sccor(isccori,isccori1)
5178 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5179 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5180 cosphi=dcos(j*tauangle(intertyp,i))
5181 sinphi=dsin(j*tauangle(intertyp,i))
5182 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5184 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5186 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5188 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5189 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5190 c &gloc_sc(intertyp,i-3,icg)
5192 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5193 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5194 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5195 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5196 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5199 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5205 c------------------------------------------------------------------------------
5206 subroutine multibody(ecorr)
5207 C This subroutine calculates multi-body contributions to energy following
5208 C the idea of Skolnick et al. If side chains I and J make a contact and
5209 C at the same time side chains I+1 and J+1 make a contact, an extra
5210 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5211 implicit real*8 (a-h,o-z)
5212 include 'DIMENSIONS'
5213 include 'COMMON.IOUNITS'
5214 include 'COMMON.DERIV'
5215 include 'COMMON.INTERACT'
5216 include 'COMMON.CONTACTS'
5217 double precision gx(3),gx1(3)
5220 C Set lprn=.true. for debugging
5224 write (iout,'(a)') 'Contact function values:'
5226 write (iout,'(i2,20(1x,i2,f10.5))')
5227 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5242 num_conti=num_cont(i)
5243 num_conti1=num_cont(i1)
5248 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5249 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5250 cd & ' ishift=',ishift
5251 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5252 C The system gains extra energy.
5253 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5254 endif ! j1==j+-ishift
5263 c------------------------------------------------------------------------------
5264 double precision function esccorr(i,j,k,l,jj,kk)
5265 implicit real*8 (a-h,o-z)
5266 include 'DIMENSIONS'
5267 include 'COMMON.IOUNITS'
5268 include 'COMMON.DERIV'
5269 include 'COMMON.INTERACT'
5270 include 'COMMON.CONTACTS'
5271 double precision gx(3),gx1(3)
5276 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5277 C Calculate the multi-body contribution to energy.
5278 C Calculate multi-body contributions to the gradient.
5279 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5280 cd & k,l,(gacont(m,kk,k),m=1,3)
5282 gx(m) =ekl*gacont(m,jj,i)
5283 gx1(m)=eij*gacont(m,kk,k)
5284 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5285 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5286 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5287 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5291 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5296 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5302 c------------------------------------------------------------------------------
5304 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5305 implicit real*8 (a-h,o-z)
5306 include 'DIMENSIONS'
5307 integer dimen1,dimen2,atom,indx
5308 double precision buffer(dimen1,dimen2)
5309 double precision zapas
5310 common /contacts_hb/ zapas(3,20,maxres,7),
5311 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5312 & num_cont_hb(maxres),jcont_hb(20,maxres)
5313 num_kont=num_cont_hb(atom)
5317 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5320 buffer(i,indx+22)=facont_hb(i,atom)
5321 buffer(i,indx+23)=ees0p(i,atom)
5322 buffer(i,indx+24)=ees0m(i,atom)
5323 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5325 buffer(1,indx+26)=dfloat(num_kont)
5328 c------------------------------------------------------------------------------
5329 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5330 implicit real*8 (a-h,o-z)
5331 include 'DIMENSIONS'
5332 integer dimen1,dimen2,atom,indx
5333 double precision buffer(dimen1,dimen2)
5334 double precision zapas
5335 common /contacts_hb/ zapas(3,20,maxres,7),
5336 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5337 & num_cont_hb(maxres),jcont_hb(20,maxres)
5338 num_kont=buffer(1,indx+26)
5339 num_kont_old=num_cont_hb(atom)
5340 num_cont_hb(atom)=num_kont+num_kont_old
5345 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5348 facont_hb(ii,atom)=buffer(i,indx+22)
5349 ees0p(ii,atom)=buffer(i,indx+23)
5350 ees0m(ii,atom)=buffer(i,indx+24)
5351 jcont_hb(ii,atom)=buffer(i,indx+25)
5355 c------------------------------------------------------------------------------
5357 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5358 C This subroutine calculates multi-body contributions to hydrogen-bonding
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 include 'sizesclu.dat'
5362 include 'COMMON.IOUNITS'
5364 include 'COMMON.INFO'
5366 include 'COMMON.FFIELD'
5367 include 'COMMON.DERIV'
5368 include 'COMMON.INTERACT'
5369 include 'COMMON.CONTACTS'
5371 parameter (max_cont=maxconts)
5372 parameter (max_dim=2*(8*3+2))
5373 parameter (msglen1=max_cont*max_dim*4)
5374 parameter (msglen2=2*msglen1)
5375 integer source,CorrelType,CorrelID,Error
5376 double precision buffer(max_cont,max_dim)
5378 double precision gx(3),gx1(3)
5381 C Set lprn=.true. for debugging
5386 if (fgProcs.le.1) goto 30
5388 write (iout,'(a)') 'Contact function values:'
5390 write (iout,'(2i3,50(1x,i2,f5.2))')
5391 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5392 & j=1,num_cont_hb(i))
5395 C Caution! Following code assumes that electrostatic interactions concerning
5396 C a given atom are split among at most two processors!
5406 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5409 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5410 if (MyRank.gt.0) then
5411 C Send correlation contributions to the preceding processor
5413 nn=num_cont_hb(iatel_s)
5414 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5415 cd write (iout,*) 'The BUFFER array:'
5417 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5419 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5421 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5422 C Clear the contacts of the atom passed to the neighboring processor
5423 nn=num_cont_hb(iatel_s+1)
5425 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5427 num_cont_hb(iatel_s)=0
5429 cd write (iout,*) 'Processor ',MyID,MyRank,
5430 cd & ' is sending correlation contribution to processor',MyID-1,
5431 cd & ' msglen=',msglen
5432 cd write (*,*) 'Processor ',MyID,MyRank,
5433 cd & ' is sending correlation contribution to processor',MyID-1,
5434 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5435 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5436 cd write (iout,*) 'Processor ',MyID,
5437 cd & ' has sent correlation contribution to processor',MyID-1,
5438 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5439 cd write (*,*) 'Processor ',MyID,
5440 cd & ' has sent correlation contribution to processor',MyID-1,
5441 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5443 endif ! (MyRank.gt.0)
5447 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5448 if (MyRank.lt.fgProcs-1) then
5449 C Receive correlation contributions from the next processor
5451 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5452 cd write (iout,*) 'Processor',MyID,
5453 cd & ' is receiving correlation contribution from processor',MyID+1,
5454 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5455 cd write (*,*) 'Processor',MyID,
5456 cd & ' is receiving correlation contribution from processor',MyID+1,
5457 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5459 do while (nbytes.le.0)
5460 call mp_probe(MyID+1,CorrelType,nbytes)
5462 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5463 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5464 cd write (iout,*) 'Processor',MyID,
5465 cd & ' has received correlation contribution from processor',MyID+1,
5466 cd & ' msglen=',msglen,' nbytes=',nbytes
5467 cd write (iout,*) 'The received BUFFER array:'
5469 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5471 if (msglen.eq.msglen1) then
5472 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5473 else if (msglen.eq.msglen2) then
5474 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5475 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5478 & 'ERROR!!!! message length changed while processing correlations.'
5480 & 'ERROR!!!! message length changed while processing correlations.'
5481 call mp_stopall(Error)
5482 endif ! msglen.eq.msglen1
5483 endif ! MyRank.lt.fgProcs-1
5490 write (iout,'(a)') 'Contact function values:'
5492 write (iout,'(2i3,50(1x,i2,f5.2))')
5493 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5494 & j=1,num_cont_hb(i))
5498 C Remove the loop below after debugging !!!
5505 C Calculate the local-electrostatic correlation terms
5506 do i=iatel_s,iatel_e+1
5508 num_conti=num_cont_hb(i)
5509 num_conti1=num_cont_hb(i+1)
5514 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5515 c & ' jj=',jj,' kk=',kk
5516 if (j1.eq.j+1 .or. j1.eq.j-1) then
5517 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5518 C The system gains extra energy.
5519 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5521 else if (j1.eq.j) then
5522 C Contacts I-J and I-(J+1) occur simultaneously.
5523 C The system loses extra energy.
5524 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5529 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5530 c & ' jj=',jj,' kk=',kk
5532 C Contacts I-J and (I+1)-J occur simultaneously.
5533 C The system loses extra energy.
5534 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5541 c------------------------------------------------------------------------------
5542 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5544 C This subroutine calculates multi-body contributions to hydrogen-bonding
5545 implicit real*8 (a-h,o-z)
5546 include 'DIMENSIONS'
5547 include 'sizesclu.dat'
5548 include 'COMMON.IOUNITS'
5550 include 'COMMON.INFO'
5552 include 'COMMON.FFIELD'
5553 include 'COMMON.DERIV'
5554 include 'COMMON.INTERACT'
5555 include 'COMMON.CONTACTS'
5557 parameter (max_cont=maxconts)
5558 parameter (max_dim=2*(8*3+2))
5559 parameter (msglen1=max_cont*max_dim*4)
5560 parameter (msglen2=2*msglen1)
5561 integer source,CorrelType,CorrelID,Error
5562 double precision buffer(max_cont,max_dim)
5564 double precision gx(3),gx1(3)
5567 C Set lprn=.true. for debugging
5574 if (fgProcs.le.1) goto 30
5576 write (iout,'(a)') 'Contact function values:'
5578 write (iout,'(2i3,50(1x,i2,f5.2))')
5579 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5580 & j=1,num_cont_hb(i))
5583 C Caution! Following code assumes that electrostatic interactions concerning
5584 C a given atom are split among at most two processors!
5594 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5597 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5598 if (MyRank.gt.0) then
5599 C Send correlation contributions to the preceding processor
5601 nn=num_cont_hb(iatel_s)
5602 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5603 cd write (iout,*) 'The BUFFER array:'
5605 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5607 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5609 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5610 C Clear the contacts of the atom passed to the neighboring processor
5611 nn=num_cont_hb(iatel_s+1)
5613 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5615 num_cont_hb(iatel_s)=0
5617 cd write (iout,*) 'Processor ',MyID,MyRank,
5618 cd & ' is sending correlation contribution to processor',MyID-1,
5619 cd & ' msglen=',msglen
5620 cd write (*,*) 'Processor ',MyID,MyRank,
5621 cd & ' is sending correlation contribution to processor',MyID-1,
5622 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5623 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5624 cd write (iout,*) 'Processor ',MyID,
5625 cd & ' has sent correlation contribution to processor',MyID-1,
5626 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5627 cd write (*,*) 'Processor ',MyID,
5628 cd & ' has sent correlation contribution to processor',MyID-1,
5629 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5631 endif ! (MyRank.gt.0)
5635 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5636 if (MyRank.lt.fgProcs-1) then
5637 C Receive correlation contributions from the next processor
5639 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5640 cd write (iout,*) 'Processor',MyID,
5641 cd & ' is receiving correlation contribution from processor',MyID+1,
5642 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5643 cd write (*,*) 'Processor',MyID,
5644 cd & ' is receiving correlation contribution from processor',MyID+1,
5645 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5647 do while (nbytes.le.0)
5648 call mp_probe(MyID+1,CorrelType,nbytes)
5650 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5651 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5652 cd write (iout,*) 'Processor',MyID,
5653 cd & ' has received correlation contribution from processor',MyID+1,
5654 cd & ' msglen=',msglen,' nbytes=',nbytes
5655 cd write (iout,*) 'The received BUFFER array:'
5657 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5659 if (msglen.eq.msglen1) then
5660 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5661 else if (msglen.eq.msglen2) then
5662 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5663 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5666 & 'ERROR!!!! message length changed while processing correlations.'
5668 & 'ERROR!!!! message length changed while processing correlations.'
5669 call mp_stopall(Error)
5670 endif ! msglen.eq.msglen1
5671 endif ! MyRank.lt.fgProcs-1
5678 write (iout,'(a)') 'Contact function values:'
5680 write (iout,'(2i3,50(1x,i2,f5.2))')
5681 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5682 & j=1,num_cont_hb(i))
5688 C Remove the loop below after debugging !!!
5695 C Calculate the dipole-dipole interaction energies
5696 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5697 do i=iatel_s,iatel_e+1
5698 num_conti=num_cont_hb(i)
5705 C Calculate the local-electrostatic correlation terms
5706 do i=iatel_s,iatel_e+1
5708 num_conti=num_cont_hb(i)
5709 num_conti1=num_cont_hb(i+1)
5714 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5715 c & ' jj=',jj,' kk=',kk
5716 if (j1.eq.j+1 .or. j1.eq.j-1) then
5717 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5718 C The system gains extra energy.
5720 sqd1=dsqrt(d_cont(jj,i))
5721 sqd2=dsqrt(d_cont(kk,i1))
5722 sred_geom = sqd1*sqd2
5723 IF (sred_geom.lt.cutoff_corr) THEN
5724 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5726 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5727 c & ' jj=',jj,' kk=',kk
5728 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5729 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5731 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5732 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5735 cd write (iout,*) 'sred_geom=',sred_geom,
5736 cd & ' ekont=',ekont,' fprim=',fprimcont
5737 call calc_eello(i,j,i+1,j1,jj,kk)
5738 if (wcorr4.gt.0.0d0)
5739 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5740 if (wcorr5.gt.0.0d0)
5741 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5742 c print *,"wcorr5",ecorr5
5743 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5744 cd write(2,*)'ijkl',i,j,i+1,j1
5745 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5746 & .or. wturn6.eq.0.0d0))then
5747 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5748 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5749 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5750 c & 'ecorr6=',ecorr6, wcorr6
5751 cd write (iout,'(4e15.5)') sred_geom,
5752 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5753 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5754 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5755 else if (wturn6.gt.0.0d0
5756 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5757 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5758 eturn6=eturn6+eello_turn6(i,jj,kk)
5759 cd write (2,*) 'multibody_eello:eturn6',eturn6
5763 else if (j1.eq.j) then
5764 C Contacts I-J and I-(J+1) occur simultaneously.
5765 C The system loses extra energy.
5766 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5771 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5772 c & ' jj=',jj,' kk=',kk
5774 C Contacts I-J and (I+1)-J occur simultaneously.
5775 C The system loses extra energy.
5776 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5783 c------------------------------------------------------------------------------
5784 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5785 implicit real*8 (a-h,o-z)
5786 include 'DIMENSIONS'
5787 include 'COMMON.IOUNITS'
5788 include 'COMMON.DERIV'
5789 include 'COMMON.INTERACT'
5790 include 'COMMON.CONTACTS'
5791 double precision gx(3),gx1(3)
5801 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5802 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5803 C Following 4 lines for diagnostics.
5808 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5810 c write (iout,*)'Contacts have occurred for peptide groups',
5811 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5812 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5813 C Calculate the multi-body contribution to energy.
5814 ecorr=ecorr+ekont*ees
5816 C Calculate multi-body contributions to the gradient.
5818 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5819 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5820 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5821 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5822 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5823 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5824 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5825 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5826 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5827 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5828 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5829 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5830 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5831 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5835 gradcorr(ll,m)=gradcorr(ll,m)+
5836 & ees*ekl*gacont_hbr(ll,jj,i)-
5837 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5838 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5843 gradcorr(ll,m)=gradcorr(ll,m)+
5844 & ees*eij*gacont_hbr(ll,kk,k)-
5845 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5846 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5853 C---------------------------------------------------------------------------
5854 subroutine dipole(i,j,jj)
5855 implicit real*8 (a-h,o-z)
5856 include 'DIMENSIONS'
5857 include 'sizesclu.dat'
5858 include 'COMMON.IOUNITS'
5859 include 'COMMON.CHAIN'
5860 include 'COMMON.FFIELD'
5861 include 'COMMON.DERIV'
5862 include 'COMMON.INTERACT'
5863 include 'COMMON.CONTACTS'
5864 include 'COMMON.TORSION'
5865 include 'COMMON.VAR'
5866 include 'COMMON.GEO'
5867 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5869 iti1 = itortyp(itype(i+1))
5870 if (j.lt.nres-1) then
5871 itj1 = itortyp(itype(j+1))
5876 dipi(iii,1)=Ub2(iii,i)
5877 dipderi(iii)=Ub2der(iii,i)
5878 dipi(iii,2)=b1(iii,iti1)
5879 dipj(iii,1)=Ub2(iii,j)
5880 dipderj(iii)=Ub2der(iii,j)
5881 dipj(iii,2)=b1(iii,itj1)
5885 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5888 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5891 if (.not.calc_grad) return
5896 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5900 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5905 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5906 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5908 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5910 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5912 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5916 C---------------------------------------------------------------------------
5917 subroutine calc_eello(i,j,k,l,jj,kk)
5919 C This subroutine computes matrices and vectors needed to calculate
5920 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5922 implicit real*8 (a-h,o-z)
5923 include 'DIMENSIONS'
5924 include 'sizesclu.dat'
5925 include 'COMMON.IOUNITS'
5926 include 'COMMON.CHAIN'
5927 include 'COMMON.DERIV'
5928 include 'COMMON.INTERACT'
5929 include 'COMMON.CONTACTS'
5930 include 'COMMON.TORSION'
5931 include 'COMMON.VAR'
5932 include 'COMMON.GEO'
5933 include 'COMMON.FFIELD'
5934 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5935 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5938 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5939 cd & ' jj=',jj,' kk=',kk
5940 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5943 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5944 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5947 call transpose2(aa1(1,1),aa1t(1,1))
5948 call transpose2(aa2(1,1),aa2t(1,1))
5951 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5952 & aa1tder(1,1,lll,kkk))
5953 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5954 & aa2tder(1,1,lll,kkk))
5958 C parallel orientation of the two CA-CA-CA frames.
5960 iti=itortyp(itype(i))
5964 itk1=itortyp(itype(k+1))
5965 itj=itortyp(itype(j))
5966 if (l.lt.nres-1) then
5967 itl1=itortyp(itype(l+1))
5971 C A1 kernel(j+1) A2T
5973 cd write (iout,'(3f10.5,5x,3f10.5)')
5974 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5976 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5977 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5978 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5979 C Following matrices are needed only for 6-th order cumulants
5980 IF (wcorr6.gt.0.0d0) THEN
5981 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5982 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5983 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5984 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5985 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5986 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5987 & ADtEAderx(1,1,1,1,1,1))
5989 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5990 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5991 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5992 & ADtEA1derx(1,1,1,1,1,1))
5994 C End 6-th order cumulants
5997 cd write (2,*) 'In calc_eello6'
5999 cd write (2,*) 'iii=',iii
6001 cd write (2,*) 'kkk=',kkk
6003 cd write (2,'(3(2f10.5),5x)')
6004 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6009 call transpose2(EUgder(1,1,k),auxmat(1,1))
6010 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6011 call transpose2(EUg(1,1,k),auxmat(1,1))
6012 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6013 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6017 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6018 & EAEAderx(1,1,lll,kkk,iii,1))
6022 C A1T kernel(i+1) A2
6023 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6024 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6025 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6026 C Following matrices are needed only for 6-th order cumulants
6027 IF (wcorr6.gt.0.0d0) THEN
6028 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6029 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6030 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6031 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6032 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6033 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6034 & ADtEAderx(1,1,1,1,1,2))
6035 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6036 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6037 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6038 & ADtEA1derx(1,1,1,1,1,2))
6040 C End 6-th order cumulants
6041 call transpose2(EUgder(1,1,l),auxmat(1,1))
6042 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6043 call transpose2(EUg(1,1,l),auxmat(1,1))
6044 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6045 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6049 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6050 & EAEAderx(1,1,lll,kkk,iii,2))
6055 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6056 C They are needed only when the fifth- or the sixth-order cumulants are
6058 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6059 call transpose2(AEA(1,1,1),auxmat(1,1))
6060 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6061 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6062 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6063 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6064 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6065 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6066 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6067 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6068 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6069 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6070 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6071 call transpose2(AEA(1,1,2),auxmat(1,1))
6072 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6073 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6074 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6075 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6076 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6077 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6078 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6079 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6080 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6081 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6082 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6083 C Calculate the Cartesian derivatives of the vectors.
6087 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6088 call matvec2(auxmat(1,1),b1(1,iti),
6089 & AEAb1derx(1,lll,kkk,iii,1,1))
6090 call matvec2(auxmat(1,1),Ub2(1,i),
6091 & AEAb2derx(1,lll,kkk,iii,1,1))
6092 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6093 & AEAb1derx(1,lll,kkk,iii,2,1))
6094 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6095 & AEAb2derx(1,lll,kkk,iii,2,1))
6096 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6097 call matvec2(auxmat(1,1),b1(1,itj),
6098 & AEAb1derx(1,lll,kkk,iii,1,2))
6099 call matvec2(auxmat(1,1),Ub2(1,j),
6100 & AEAb2derx(1,lll,kkk,iii,1,2))
6101 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6102 & AEAb1derx(1,lll,kkk,iii,2,2))
6103 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6104 & AEAb2derx(1,lll,kkk,iii,2,2))
6111 C Antiparallel orientation of the two CA-CA-CA frames.
6113 iti=itortyp(itype(i))
6117 itk1=itortyp(itype(k+1))
6118 itl=itortyp(itype(l))
6119 itj=itortyp(itype(j))
6120 if (j.lt.nres-1) then
6121 itj1=itortyp(itype(j+1))
6125 C A2 kernel(j-1)T A1T
6126 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6127 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6128 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6129 C Following matrices are needed only for 6-th order cumulants
6130 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6131 & j.eq.i+4 .and. l.eq.i+3)) THEN
6132 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6133 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6134 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6135 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6136 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6137 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6138 & ADtEAderx(1,1,1,1,1,1))
6139 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6140 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6141 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6142 & ADtEA1derx(1,1,1,1,1,1))
6144 C End 6-th order cumulants
6145 call transpose2(EUgder(1,1,k),auxmat(1,1))
6146 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6147 call transpose2(EUg(1,1,k),auxmat(1,1))
6148 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6149 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6153 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6154 & EAEAderx(1,1,lll,kkk,iii,1))
6158 C A2T kernel(i+1)T A1
6159 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6160 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6161 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6162 C Following matrices are needed only for 6-th order cumulants
6163 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6164 & j.eq.i+4 .and. l.eq.i+3)) THEN
6165 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6166 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6167 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6168 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6169 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6170 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6171 & ADtEAderx(1,1,1,1,1,2))
6172 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6173 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6174 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6175 & ADtEA1derx(1,1,1,1,1,2))
6177 C End 6-th order cumulants
6178 call transpose2(EUgder(1,1,j),auxmat(1,1))
6179 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6180 call transpose2(EUg(1,1,j),auxmat(1,1))
6181 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6182 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6186 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6187 & EAEAderx(1,1,lll,kkk,iii,2))
6192 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6193 C They are needed only when the fifth- or the sixth-order cumulants are
6195 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6196 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6197 call transpose2(AEA(1,1,1),auxmat(1,1))
6198 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6199 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6200 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6201 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6202 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6203 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6204 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6205 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6206 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6207 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6208 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6209 call transpose2(AEA(1,1,2),auxmat(1,1))
6210 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6211 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6212 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6213 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6214 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6215 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6216 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6217 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6218 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6219 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6220 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6221 C Calculate the Cartesian derivatives of the vectors.
6225 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6226 call matvec2(auxmat(1,1),b1(1,iti),
6227 & AEAb1derx(1,lll,kkk,iii,1,1))
6228 call matvec2(auxmat(1,1),Ub2(1,i),
6229 & AEAb2derx(1,lll,kkk,iii,1,1))
6230 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6231 & AEAb1derx(1,lll,kkk,iii,2,1))
6232 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6233 & AEAb2derx(1,lll,kkk,iii,2,1))
6234 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6235 call matvec2(auxmat(1,1),b1(1,itl),
6236 & AEAb1derx(1,lll,kkk,iii,1,2))
6237 call matvec2(auxmat(1,1),Ub2(1,l),
6238 & AEAb2derx(1,lll,kkk,iii,1,2))
6239 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6240 & AEAb1derx(1,lll,kkk,iii,2,2))
6241 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6242 & AEAb2derx(1,lll,kkk,iii,2,2))
6251 C---------------------------------------------------------------------------
6252 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6253 & KK,KKderg,AKA,AKAderg,AKAderx)
6257 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6258 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6259 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6264 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6266 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6269 cd if (lprn) write (2,*) 'In kernel'
6271 cd if (lprn) write (2,*) 'kkk=',kkk
6273 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6274 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6276 cd write (2,*) 'lll=',lll
6277 cd write (2,*) 'iii=1'
6279 cd write (2,'(3(2f10.5),5x)')
6280 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6283 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6284 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6286 cd write (2,*) 'lll=',lll
6287 cd write (2,*) 'iii=2'
6289 cd write (2,'(3(2f10.5),5x)')
6290 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6297 C---------------------------------------------------------------------------
6298 double precision function eello4(i,j,k,l,jj,kk)
6299 implicit real*8 (a-h,o-z)
6300 include 'DIMENSIONS'
6301 include 'sizesclu.dat'
6302 include 'COMMON.IOUNITS'
6303 include 'COMMON.CHAIN'
6304 include 'COMMON.DERIV'
6305 include 'COMMON.INTERACT'
6306 include 'COMMON.CONTACTS'
6307 include 'COMMON.TORSION'
6308 include 'COMMON.VAR'
6309 include 'COMMON.GEO'
6310 double precision pizda(2,2),ggg1(3),ggg2(3)
6311 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6315 cd print *,'eello4:',i,j,k,l,jj,kk
6316 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6317 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6318 cold eij=facont_hb(jj,i)
6319 cold ekl=facont_hb(kk,k)
6321 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6323 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6324 gcorr_loc(k-1)=gcorr_loc(k-1)
6325 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6327 gcorr_loc(l-1)=gcorr_loc(l-1)
6328 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6330 gcorr_loc(j-1)=gcorr_loc(j-1)
6331 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6336 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6337 & -EAEAderx(2,2,lll,kkk,iii,1)
6338 cd derx(lll,kkk,iii)=0.0d0
6342 cd gcorr_loc(l-1)=0.0d0
6343 cd gcorr_loc(j-1)=0.0d0
6344 cd gcorr_loc(k-1)=0.0d0
6346 cd write (iout,*)'Contacts have occurred for peptide groups',
6347 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6348 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6349 if (j.lt.nres-1) then
6356 if (l.lt.nres-1) then
6364 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6365 ggg1(ll)=eel4*g_contij(ll,1)
6366 ggg2(ll)=eel4*g_contij(ll,2)
6367 ghalf=0.5d0*ggg1(ll)
6369 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6370 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6371 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6372 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6373 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6374 ghalf=0.5d0*ggg2(ll)
6376 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6377 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6378 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6379 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6384 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6385 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6390 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6391 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6397 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6402 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6406 cd write (2,*) iii,gcorr_loc(iii)
6410 cd write (2,*) 'ekont',ekont
6411 cd write (iout,*) 'eello4',ekont*eel4
6414 C---------------------------------------------------------------------------
6415 double precision function eello5(i,j,k,l,jj,kk)
6416 implicit real*8 (a-h,o-z)
6417 include 'DIMENSIONS'
6418 include 'sizesclu.dat'
6419 include 'COMMON.IOUNITS'
6420 include 'COMMON.CHAIN'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.INTERACT'
6423 include 'COMMON.CONTACTS'
6424 include 'COMMON.TORSION'
6425 include 'COMMON.VAR'
6426 include 'COMMON.GEO'
6427 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6428 double precision ggg1(3),ggg2(3)
6429 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6434 C /l\ / \ \ / \ / \ / C
6435 C / \ / \ \ / \ / \ / C
6436 C j| o |l1 | o | o| o | | o |o C
6437 C \ |/k\| |/ \| / |/ \| |/ \| C
6438 C \i/ \ / \ / / \ / \ C
6440 C (I) (II) (III) (IV) C
6442 C eello5_1 eello5_2 eello5_3 eello5_4 C
6444 C Antiparallel chains C
6447 C /j\ / \ \ / \ / \ / C
6448 C / \ / \ \ / \ / \ / C
6449 C j1| o |l | o | o| o | | o |o C
6450 C \ |/k\| |/ \| / |/ \| |/ \| C
6451 C \i/ \ / \ / / \ / \ C
6453 C (I) (II) (III) (IV) C
6455 C eello5_1 eello5_2 eello5_3 eello5_4 C
6457 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6460 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6465 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6467 itk=itortyp(itype(k))
6468 itl=itortyp(itype(l))
6469 itj=itortyp(itype(j))
6474 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6475 cd & eel5_3_num,eel5_4_num)
6479 derx(lll,kkk,iii)=0.0d0
6483 cd eij=facont_hb(jj,i)
6484 cd ekl=facont_hb(kk,k)
6486 cd write (iout,*)'Contacts have occurred for peptide groups',
6487 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6489 C Contribution from the graph I.
6490 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6491 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6492 call transpose2(EUg(1,1,k),auxmat(1,1))
6493 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6494 vv(1)=pizda(1,1)-pizda(2,2)
6495 vv(2)=pizda(1,2)+pizda(2,1)
6496 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6497 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6499 C Explicit gradient in virtual-dihedral angles.
6500 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6501 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6502 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6503 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6504 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6505 vv(1)=pizda(1,1)-pizda(2,2)
6506 vv(2)=pizda(1,2)+pizda(2,1)
6507 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6508 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6509 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6510 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6511 vv(1)=pizda(1,1)-pizda(2,2)
6512 vv(2)=pizda(1,2)+pizda(2,1)
6514 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6515 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6516 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6518 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6519 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6520 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6522 C Cartesian gradient
6526 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6528 vv(1)=pizda(1,1)-pizda(2,2)
6529 vv(2)=pizda(1,2)+pizda(2,1)
6530 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6531 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6539 C Contribution from graph II
6540 call transpose2(EE(1,1,itk),auxmat(1,1))
6541 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6542 vv(1)=pizda(1,1)+pizda(2,2)
6543 vv(2)=pizda(2,1)-pizda(1,2)
6544 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6545 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6547 C Explicit gradient in virtual-dihedral angles.
6548 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6549 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6550 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6551 vv(1)=pizda(1,1)+pizda(2,2)
6552 vv(2)=pizda(2,1)-pizda(1,2)
6554 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6555 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6556 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6558 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6559 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6560 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6562 C Cartesian gradient
6566 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6568 vv(1)=pizda(1,1)+pizda(2,2)
6569 vv(2)=pizda(2,1)-pizda(1,2)
6570 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6571 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6572 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6581 C Parallel orientation
6582 C Contribution from graph III
6583 call transpose2(EUg(1,1,l),auxmat(1,1))
6584 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6585 vv(1)=pizda(1,1)-pizda(2,2)
6586 vv(2)=pizda(1,2)+pizda(2,1)
6587 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6588 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6590 C Explicit gradient in virtual-dihedral angles.
6591 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6592 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6593 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6594 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6595 vv(1)=pizda(1,1)-pizda(2,2)
6596 vv(2)=pizda(1,2)+pizda(2,1)
6597 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6598 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6599 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6600 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6601 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6602 vv(1)=pizda(1,1)-pizda(2,2)
6603 vv(2)=pizda(1,2)+pizda(2,1)
6604 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6605 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6606 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6607 C Cartesian gradient
6611 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6613 vv(1)=pizda(1,1)-pizda(2,2)
6614 vv(2)=pizda(1,2)+pizda(2,1)
6615 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6616 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6617 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6623 C Contribution from graph IV
6625 call transpose2(EE(1,1,itl),auxmat(1,1))
6626 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6627 vv(1)=pizda(1,1)+pizda(2,2)
6628 vv(2)=pizda(2,1)-pizda(1,2)
6629 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6630 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6632 C Explicit gradient in virtual-dihedral angles.
6633 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6634 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6635 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6636 vv(1)=pizda(1,1)+pizda(2,2)
6637 vv(2)=pizda(2,1)-pizda(1,2)
6638 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6639 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6640 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6641 C Cartesian gradient
6645 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6647 vv(1)=pizda(1,1)+pizda(2,2)
6648 vv(2)=pizda(2,1)-pizda(1,2)
6649 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6650 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6651 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6657 C Antiparallel orientation
6658 C Contribution from graph III
6660 call transpose2(EUg(1,1,j),auxmat(1,1))
6661 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6662 vv(1)=pizda(1,1)-pizda(2,2)
6663 vv(2)=pizda(1,2)+pizda(2,1)
6664 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6665 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6667 C Explicit gradient in virtual-dihedral angles.
6668 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6669 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6670 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6671 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6672 vv(1)=pizda(1,1)-pizda(2,2)
6673 vv(2)=pizda(1,2)+pizda(2,1)
6674 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6675 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6676 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6677 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6678 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6679 vv(1)=pizda(1,1)-pizda(2,2)
6680 vv(2)=pizda(1,2)+pizda(2,1)
6681 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6682 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6683 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6684 C Cartesian gradient
6688 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6690 vv(1)=pizda(1,1)-pizda(2,2)
6691 vv(2)=pizda(1,2)+pizda(2,1)
6692 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6693 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6694 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6700 C Contribution from graph IV
6702 call transpose2(EE(1,1,itj),auxmat(1,1))
6703 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6704 vv(1)=pizda(1,1)+pizda(2,2)
6705 vv(2)=pizda(2,1)-pizda(1,2)
6706 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6707 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6709 C Explicit gradient in virtual-dihedral angles.
6710 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6711 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6712 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6713 vv(1)=pizda(1,1)+pizda(2,2)
6714 vv(2)=pizda(2,1)-pizda(1,2)
6715 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6716 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6717 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6718 C Cartesian gradient
6722 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6724 vv(1)=pizda(1,1)+pizda(2,2)
6725 vv(2)=pizda(2,1)-pizda(1,2)
6726 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6727 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6728 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6735 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6736 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6737 cd write (2,*) 'ijkl',i,j,k,l
6738 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6739 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6741 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6742 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6743 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6744 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6746 if (j.lt.nres-1) then
6753 if (l.lt.nres-1) then
6763 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6765 ggg1(ll)=eel5*g_contij(ll,1)
6766 ggg2(ll)=eel5*g_contij(ll,2)
6767 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6768 ghalf=0.5d0*ggg1(ll)
6770 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6771 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6772 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6773 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6774 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6775 ghalf=0.5d0*ggg2(ll)
6777 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6778 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6779 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6780 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6785 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6786 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6791 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6792 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6798 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6803 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6807 cd write (2,*) iii,g_corr5_loc(iii)
6811 cd write (2,*) 'ekont',ekont
6812 cd write (iout,*) 'eello5',ekont*eel5
6815 c--------------------------------------------------------------------------
6816 double precision function eello6(i,j,k,l,jj,kk)
6817 implicit real*8 (a-h,o-z)
6818 include 'DIMENSIONS'
6819 include 'sizesclu.dat'
6820 include 'COMMON.IOUNITS'
6821 include 'COMMON.CHAIN'
6822 include 'COMMON.DERIV'
6823 include 'COMMON.INTERACT'
6824 include 'COMMON.CONTACTS'
6825 include 'COMMON.TORSION'
6826 include 'COMMON.VAR'
6827 include 'COMMON.GEO'
6828 include 'COMMON.FFIELD'
6829 double precision ggg1(3),ggg2(3)
6830 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6835 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6843 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6844 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6848 derx(lll,kkk,iii)=0.0d0
6852 cd eij=facont_hb(jj,i)
6853 cd ekl=facont_hb(kk,k)
6859 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6860 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6861 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6862 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6863 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6864 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6866 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6867 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6868 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6869 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6870 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6871 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6875 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6877 C If turn contributions are considered, they will be handled separately.
6878 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6879 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6880 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6881 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6882 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6883 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6884 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6887 if (j.lt.nres-1) then
6894 if (l.lt.nres-1) then
6902 ggg1(ll)=eel6*g_contij(ll,1)
6903 ggg2(ll)=eel6*g_contij(ll,2)
6904 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6905 ghalf=0.5d0*ggg1(ll)
6907 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6908 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6909 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6910 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6911 ghalf=0.5d0*ggg2(ll)
6912 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6914 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6915 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6916 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6917 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6922 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6923 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6928 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6929 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6935 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6940 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6944 cd write (2,*) iii,g_corr6_loc(iii)
6948 cd write (2,*) 'ekont',ekont
6949 cd write (iout,*) 'eello6',ekont*eel6
6952 c--------------------------------------------------------------------------
6953 double precision function eello6_graph1(i,j,k,l,imat,swap)
6954 implicit real*8 (a-h,o-z)
6955 include 'DIMENSIONS'
6956 include 'sizesclu.dat'
6957 include 'COMMON.IOUNITS'
6958 include 'COMMON.CHAIN'
6959 include 'COMMON.DERIV'
6960 include 'COMMON.INTERACT'
6961 include 'COMMON.CONTACTS'
6962 include 'COMMON.TORSION'
6963 include 'COMMON.VAR'
6964 include 'COMMON.GEO'
6965 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6969 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6971 C Parallel Antiparallel C
6977 C \ j|/k\| / \ |/k\|l / C
6982 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6983 itk=itortyp(itype(k))
6984 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6985 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6986 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6987 call transpose2(EUgC(1,1,k),auxmat(1,1))
6988 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6989 vv1(1)=pizda1(1,1)-pizda1(2,2)
6990 vv1(2)=pizda1(1,2)+pizda1(2,1)
6991 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6992 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6993 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6994 s5=scalar2(vv(1),Dtobr2(1,i))
6995 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6996 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6997 if (.not. calc_grad) return
6998 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6999 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7000 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7001 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7002 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7003 & +scalar2(vv(1),Dtobr2der(1,i)))
7004 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7005 vv1(1)=pizda1(1,1)-pizda1(2,2)
7006 vv1(2)=pizda1(1,2)+pizda1(2,1)
7007 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7008 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7010 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7011 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7012 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7013 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7014 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7016 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7017 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7018 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7019 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7020 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7022 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7023 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7024 vv1(1)=pizda1(1,1)-pizda1(2,2)
7025 vv1(2)=pizda1(1,2)+pizda1(2,1)
7026 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7027 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7028 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7029 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7038 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7039 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7040 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7041 call transpose2(EUgC(1,1,k),auxmat(1,1))
7042 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7044 vv1(1)=pizda1(1,1)-pizda1(2,2)
7045 vv1(2)=pizda1(1,2)+pizda1(2,1)
7046 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7047 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7048 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7049 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7050 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7051 s5=scalar2(vv(1),Dtobr2(1,i))
7052 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7058 c----------------------------------------------------------------------------
7059 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7060 implicit real*8 (a-h,o-z)
7061 include 'DIMENSIONS'
7062 include 'sizesclu.dat'
7063 include 'COMMON.IOUNITS'
7064 include 'COMMON.CHAIN'
7065 include 'COMMON.DERIV'
7066 include 'COMMON.INTERACT'
7067 include 'COMMON.CONTACTS'
7068 include 'COMMON.TORSION'
7069 include 'COMMON.VAR'
7070 include 'COMMON.GEO'
7072 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7073 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7076 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7078 C Parallel Antiparallel C
7084 C \ j|/k\| \ |/k\|l C
7089 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7090 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7091 C AL 7/4/01 s1 would occur in the sixth-order moment,
7092 C but not in a cluster cumulant
7094 s1=dip(1,jj,i)*dip(1,kk,k)
7096 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7097 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7098 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7099 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7100 call transpose2(EUg(1,1,k),auxmat(1,1))
7101 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7102 vv(1)=pizda(1,1)-pizda(2,2)
7103 vv(2)=pizda(1,2)+pizda(2,1)
7104 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7105 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7107 eello6_graph2=-(s1+s2+s3+s4)
7109 eello6_graph2=-(s2+s3+s4)
7112 if (.not. calc_grad) return
7113 C Derivatives in gamma(i-1)
7116 s1=dipderg(1,jj,i)*dip(1,kk,k)
7118 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7119 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7120 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7121 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7123 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7125 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7127 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7129 C Derivatives in gamma(k-1)
7131 s1=dip(1,jj,i)*dipderg(1,kk,k)
7133 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7134 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7135 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7136 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7137 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7138 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7139 vv(1)=pizda(1,1)-pizda(2,2)
7140 vv(2)=pizda(1,2)+pizda(2,1)
7141 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7143 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7145 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7147 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7148 C Derivatives in gamma(j-1) or gamma(l-1)
7151 s1=dipderg(3,jj,i)*dip(1,kk,k)
7153 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7154 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7155 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7156 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7157 vv(1)=pizda(1,1)-pizda(2,2)
7158 vv(2)=pizda(1,2)+pizda(2,1)
7159 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7162 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7164 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7167 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7168 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7170 C Derivatives in gamma(l-1) or gamma(j-1)
7173 s1=dip(1,jj,i)*dipderg(3,kk,k)
7175 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7176 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7177 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7178 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7179 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7180 vv(1)=pizda(1,1)-pizda(2,2)
7181 vv(2)=pizda(1,2)+pizda(2,1)
7182 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7185 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7187 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7190 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7191 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7193 C Cartesian derivatives.
7195 write (2,*) 'In eello6_graph2'
7197 write (2,*) 'iii=',iii
7199 write (2,*) 'kkk=',kkk
7201 write (2,'(3(2f10.5),5x)')
7202 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7212 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7214 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7217 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7219 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7220 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7222 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7223 call transpose2(EUg(1,1,k),auxmat(1,1))
7224 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7226 vv(1)=pizda(1,1)-pizda(2,2)
7227 vv(2)=pizda(1,2)+pizda(2,1)
7228 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7229 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7231 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7233 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7236 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7238 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7245 c----------------------------------------------------------------------------
7246 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7247 implicit real*8 (a-h,o-z)
7248 include 'DIMENSIONS'
7249 include 'sizesclu.dat'
7250 include 'COMMON.IOUNITS'
7251 include 'COMMON.CHAIN'
7252 include 'COMMON.DERIV'
7253 include 'COMMON.INTERACT'
7254 include 'COMMON.CONTACTS'
7255 include 'COMMON.TORSION'
7256 include 'COMMON.VAR'
7257 include 'COMMON.GEO'
7258 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7260 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7262 C Parallel Antiparallel C
7268 C j|/k\| / |/k\|l / C
7273 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7275 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7276 C energy moment and not to the cluster cumulant.
7277 iti=itortyp(itype(i))
7278 if (j.lt.nres-1) then
7279 itj1=itortyp(itype(j+1))
7283 itk=itortyp(itype(k))
7284 itk1=itortyp(itype(k+1))
7285 if (l.lt.nres-1) then
7286 itl1=itortyp(itype(l+1))
7291 s1=dip(4,jj,i)*dip(4,kk,k)
7293 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7294 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7295 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7296 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7297 call transpose2(EE(1,1,itk),auxmat(1,1))
7298 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7299 vv(1)=pizda(1,1)+pizda(2,2)
7300 vv(2)=pizda(2,1)-pizda(1,2)
7301 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7302 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7304 eello6_graph3=-(s1+s2+s3+s4)
7306 eello6_graph3=-(s2+s3+s4)
7309 if (.not. calc_grad) return
7310 C Derivatives in gamma(k-1)
7311 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7312 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7313 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7314 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7315 C Derivatives in gamma(l-1)
7316 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7317 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7318 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7319 vv(1)=pizda(1,1)+pizda(2,2)
7320 vv(2)=pizda(2,1)-pizda(1,2)
7321 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7322 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7323 C Cartesian derivatives.
7329 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7331 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7334 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7336 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7337 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7339 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7340 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7342 vv(1)=pizda(1,1)+pizda(2,2)
7343 vv(2)=pizda(2,1)-pizda(1,2)
7344 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7346 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7348 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7351 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7353 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7355 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7361 c----------------------------------------------------------------------------
7362 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7363 implicit real*8 (a-h,o-z)
7364 include 'DIMENSIONS'
7365 include 'sizesclu.dat'
7366 include 'COMMON.IOUNITS'
7367 include 'COMMON.CHAIN'
7368 include 'COMMON.DERIV'
7369 include 'COMMON.INTERACT'
7370 include 'COMMON.CONTACTS'
7371 include 'COMMON.TORSION'
7372 include 'COMMON.VAR'
7373 include 'COMMON.GEO'
7374 include 'COMMON.FFIELD'
7375 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7376 & auxvec1(2),auxmat1(2,2)
7378 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7380 C Parallel Antiparallel C
7386 C \ j|/k\| \ |/k\|l C
7391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7393 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7394 C energy moment and not to the cluster cumulant.
7395 cd write (2,*) 'eello_graph4: wturn6',wturn6
7396 iti=itortyp(itype(i))
7397 itj=itortyp(itype(j))
7398 if (j.lt.nres-1) then
7399 itj1=itortyp(itype(j+1))
7403 itk=itortyp(itype(k))
7404 if (k.lt.nres-1) then
7405 itk1=itortyp(itype(k+1))
7409 itl=itortyp(itype(l))
7410 if (l.lt.nres-1) then
7411 itl1=itortyp(itype(l+1))
7415 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7416 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7417 cd & ' itl',itl,' itl1',itl1
7420 s1=dip(3,jj,i)*dip(3,kk,k)
7422 s1=dip(2,jj,j)*dip(2,kk,l)
7425 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7426 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7428 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7429 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7431 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7432 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7434 call transpose2(EUg(1,1,k),auxmat(1,1))
7435 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7436 vv(1)=pizda(1,1)-pizda(2,2)
7437 vv(2)=pizda(2,1)+pizda(1,2)
7438 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7439 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7441 eello6_graph4=-(s1+s2+s3+s4)
7443 eello6_graph4=-(s2+s3+s4)
7445 if (.not. calc_grad) return
7446 C Derivatives in gamma(i-1)
7450 s1=dipderg(2,jj,i)*dip(3,kk,k)
7452 s1=dipderg(4,jj,j)*dip(2,kk,l)
7455 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7457 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7458 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7460 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7461 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7463 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7464 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7465 cd write (2,*) 'turn6 derivatives'
7467 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7469 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7473 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7475 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7479 C Derivatives in gamma(k-1)
7482 s1=dip(3,jj,i)*dipderg(2,kk,k)
7484 s1=dip(2,jj,j)*dipderg(4,kk,l)
7487 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7488 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7490 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7491 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7493 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7494 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7496 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7497 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7498 vv(1)=pizda(1,1)-pizda(2,2)
7499 vv(2)=pizda(2,1)+pizda(1,2)
7500 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7501 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7503 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7505 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7509 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7511 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7514 C Derivatives in gamma(j-1) or gamma(l-1)
7515 if (l.eq.j+1 .and. l.gt.1) then
7516 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7517 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7518 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7519 vv(1)=pizda(1,1)-pizda(2,2)
7520 vv(2)=pizda(2,1)+pizda(1,2)
7521 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7522 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7523 else if (j.gt.1) then
7524 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7525 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7526 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7527 vv(1)=pizda(1,1)-pizda(2,2)
7528 vv(2)=pizda(2,1)+pizda(1,2)
7529 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7530 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7531 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7533 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7536 C Cartesian derivatives.
7543 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7545 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7549 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7551 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7555 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7557 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7559 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7560 & b1(1,itj1),auxvec(1))
7561 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7563 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7564 & b1(1,itl1),auxvec(1))
7565 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7567 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(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))
7573 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7575 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7578 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7581 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7584 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7586 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7588 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7592 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7594 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7597 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7599 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7607 c----------------------------------------------------------------------------
7608 double precision function eello_turn6(i,jj,kk)
7609 implicit real*8 (a-h,o-z)
7610 include 'DIMENSIONS'
7611 include 'sizesclu.dat'
7612 include 'COMMON.IOUNITS'
7613 include 'COMMON.CHAIN'
7614 include 'COMMON.DERIV'
7615 include 'COMMON.INTERACT'
7616 include 'COMMON.CONTACTS'
7617 include 'COMMON.TORSION'
7618 include 'COMMON.VAR'
7619 include 'COMMON.GEO'
7620 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7621 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7623 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7624 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7625 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7626 C the respective energy moment and not to the cluster cumulant.
7631 iti=itortyp(itype(i))
7632 itk=itortyp(itype(k))
7633 itk1=itortyp(itype(k+1))
7634 itl=itortyp(itype(l))
7635 itj=itortyp(itype(j))
7636 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7637 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7638 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7643 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7645 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7649 derx_turn(lll,kkk,iii)=0.0d0
7656 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7658 cd write (2,*) 'eello6_5',eello6_5
7660 call transpose2(AEA(1,1,1),auxmat(1,1))
7661 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7662 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7663 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7667 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7668 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7669 s2 = scalar2(b1(1,itk),vtemp1(1))
7671 call transpose2(AEA(1,1,2),atemp(1,1))
7672 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7673 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7674 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7678 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7679 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7680 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7682 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7683 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7684 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7685 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7686 ss13 = scalar2(b1(1,itk),vtemp4(1))
7687 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7691 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7697 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7699 C Derivatives in gamma(i+2)
7701 call transpose2(AEA(1,1,1),auxmatd(1,1))
7702 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7703 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7704 call transpose2(AEAderg(1,1,2),atempd(1,1))
7705 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7706 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7710 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7711 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7712 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7718 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7719 C Derivatives in gamma(i+3)
7721 call transpose2(AEA(1,1,1),auxmatd(1,1))
7722 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7723 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7724 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7728 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7729 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7730 s2d = scalar2(b1(1,itk),vtemp1d(1))
7732 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7733 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7735 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7737 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7738 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7739 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7749 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7750 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7752 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7753 & -0.5d0*ekont*(s2d+s12d)
7755 C Derivatives in gamma(i+4)
7756 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7757 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7758 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7760 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7761 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7762 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7772 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7774 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7776 C Derivatives in gamma(i+5)
7778 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7779 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7780 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7784 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7785 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7786 s2d = scalar2(b1(1,itk),vtemp1d(1))
7788 call transpose2(AEA(1,1,2),atempd(1,1))
7789 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7790 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7794 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7795 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7797 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7798 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7799 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7809 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7810 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7812 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7813 & -0.5d0*ekont*(s2d+s12d)
7815 C Cartesian derivatives
7820 call transpose2(AEAderx(1,1,lll,kkk,iii,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),vtemp1(1))
7827 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7829 s2d = scalar2(b1(1,itk),vtemp1d(1))
7831 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7832 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7833 s8d = -(atempd(1,1)+atempd(2,2))*
7834 & scalar2(cc(1,1,itl),vtemp2(1))
7838 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7840 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7841 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7848 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7851 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7855 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7856 & - 0.5d0*(s8d+s12d)
7858 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7867 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7869 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7870 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7871 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7872 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7873 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7875 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7876 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7877 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7881 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7882 cd & 16*eel_turn6_num
7884 if (j.lt.nres-1) then
7891 if (l.lt.nres-1) then
7899 ggg1(ll)=eel_turn6*g_contij(ll,1)
7900 ggg2(ll)=eel_turn6*g_contij(ll,2)
7901 ghalf=0.5d0*ggg1(ll)
7903 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7904 & +ekont*derx_turn(ll,2,1)
7905 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7906 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7907 & +ekont*derx_turn(ll,4,1)
7908 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7909 ghalf=0.5d0*ggg2(ll)
7911 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7912 & +ekont*derx_turn(ll,2,2)
7913 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7914 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7915 & +ekont*derx_turn(ll,4,2)
7916 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7921 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7926 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7932 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7937 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7941 cd write (2,*) iii,g_corr6_loc(iii)
7944 eello_turn6=ekont*eel_turn6
7945 cd write (2,*) 'ekont',ekont
7946 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7949 crc-------------------------------------------------
7950 SUBROUTINE MATVEC2(A1,V1,V2)
7951 implicit real*8 (a-h,o-z)
7952 include 'DIMENSIONS'
7953 DIMENSION A1(2,2),V1(2),V2(2)
7957 c 3 VI=VI+A1(I,K)*V1(K)
7961 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7962 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7967 C---------------------------------------
7968 SUBROUTINE MATMAT2(A1,A2,A3)
7969 implicit real*8 (a-h,o-z)
7970 include 'DIMENSIONS'
7971 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7972 c DIMENSION AI3(2,2)
7976 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7982 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7983 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7984 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7985 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7993 c-------------------------------------------------------------------------
7994 double precision function scalar2(u,v)
7996 double precision u(2),v(2)
7999 scalar2=u(1)*v(1)+u(2)*v(2)
8003 C-----------------------------------------------------------------------------
8005 subroutine transpose2(a,at)
8007 double precision a(2,2),at(2,2)
8014 c--------------------------------------------------------------------------
8015 subroutine transpose(n,a,at)
8018 double precision a(n,n),at(n,n)
8026 C---------------------------------------------------------------------------
8027 subroutine prodmat3(a1,a2,kk,transp,prod)
8030 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8032 crc double precision auxmat(2,2),prod_(2,2)
8035 crc call transpose2(kk(1,1),auxmat(1,1))
8036 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8037 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8039 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8040 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8041 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8042 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8043 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8044 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8045 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8046 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8049 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8050 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8052 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8053 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8054 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8055 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8056 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8057 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8058 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8059 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8062 c call transpose2(a2(1,1),a2t(1,1))
8065 crc print *,((prod_(i,j),i=1,2),j=1,2)
8066 crc print *,((prod(i,j),i=1,2),j=1,2)
8070 C-----------------------------------------------------------------------------
8071 double precision function scalar(u,v)
8073 double precision u(3),v(3)