1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
8 cMS$ATTRIBUTES C :: proc_proc
11 include 'COMMON.IOUNITS'
12 double precision energia(0:max_ene),energia1(0:max_ene+1)
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
23 include 'COMMON.CONTROL'
25 double precision fact(5)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 C Gay-Berne potential (shifted LJ, angular dependence).
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor,fact(1))
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
106 c write(iout,*) "TEST_ENE",constr_homology
107 if (constr_homology.ge.1) then
108 call e_modeller(ehomology_constr)
110 ehomology_constr=0.0d0
112 c write(iout,*) "TEST_ENE",ehomology_constr
114 C BARTEK for dfa test!
115 if (wdfa_dist.gt.0) call edfad(edfadis)
116 c print*, 'edfad is finished!', edfadis
117 if (wdfa_tor.gt.0) call edfat(edfator)
118 c print*, 'edfat is finished!', edfator
119 if (wdfa_nei.gt.0) call edfan(edfanei)
120 c print*, 'edfan is finished!', edfanei
121 if (wdfa_beta.gt.0) call edfab(edfabet)
122 c print*, 'edfab is finished!', edfabet
125 C call multibody(ecorr)
130 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
131 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
132 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
133 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
134 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
135 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
136 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
137 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
140 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
141 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
142 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
143 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
144 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
145 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
146 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
147 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
153 energia(2)=evdw2-evdw2_14
170 energia(8)=eello_turn3
171 energia(9)=eello_turn4
180 energia(20)=edihcnstr
181 energia(21)=ehomology_constr
186 cc if (dyn_ss) call dyn_set_nss
190 idumm=proc_proc(etot,i)
192 c call proc_proc(etot,i)
194 if(i.eq.1)energia(0)=1.0d+99
200 C Sum up the components of the Cartesian gradient.
205 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
206 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
208 & wstrain*ghpbc(j,i)+
209 & wcorr*fact(3)*gradcorr(j,i)+
210 & wel_loc*fact(2)*gel_loc(j,i)+
211 & wturn3*fact(2)*gcorr3_turn(j,i)+
212 & wturn4*fact(3)*gcorr4_turn(j,i)+
213 & wcorr5*fact(4)*gradcorr5(j,i)+
214 & wcorr6*fact(5)*gradcorr6(j,i)+
215 & wturn6*fact(5)*gcorr6_turn(j,i)+
216 & wsccor*fact(2)*gsccorc(j,i)+
217 & wdfa_dist*gdfad(j,i)+
218 & wdfa_tor*gdfat(j,i)+
219 & wdfa_nei*gdfan(j,i)+
220 & wdfa_beta*gdfab(j,i)
221 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
223 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
228 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
229 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
231 & wcorr*fact(3)*gradcorr(j,i)+
232 & wel_loc*fact(2)*gel_loc(j,i)+
233 & wturn3*fact(2)*gcorr3_turn(j,i)+
234 & wturn4*fact(3)*gcorr4_turn(j,i)+
235 & wcorr5*fact(4)*gradcorr5(j,i)+
236 & wcorr6*fact(5)*gradcorr6(j,i)+
237 & wturn6*fact(5)*gcorr6_turn(j,i)+
238 & wsccor*fact(2)*gsccorc(j,i)+
239 & wdfa_dist*gdfad(j,i)+
240 & wdfa_tor*gdfat(j,i)+
241 & wdfa_nei*gdfan(j,i)+
242 & wdfa_beta*gdfab(j,i)
243 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
245 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
248 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
249 cd & (gradc(k,i),k=1,3)
254 cd write (iout,*) i,g_corr5_loc(i)
255 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
256 & +wcorr5*fact(4)*g_corr5_loc(i)
257 & +wcorr6*fact(5)*g_corr6_loc(i)
258 & +wturn4*fact(3)*gel_loc_turn4(i)
259 & +wturn3*fact(2)*gel_loc_turn3(i)
260 & +wturn6*fact(5)*gel_loc_turn6(i)
261 & +wel_loc*fact(2)*gel_loc_loc(i)
262 & +wsccor*fact(1)*gsccor_loc(i)
265 c call enerprint(energia(0),fact)
270 C------------------------------------------------------------------------
271 subroutine enerprint(energia,fact)
272 implicit real*8 (a-h,o-z)
274 include 'sizesclu.dat'
275 include 'COMMON.IOUNITS'
276 include 'COMMON.FFIELD'
277 include 'COMMON.SBRIDGE'
278 double precision energia(0:max_ene),fact(5)
282 evdw2=energia(2)+energia(17)
294 eello_turn3=energia(8)
295 eello_turn4=energia(9)
296 eello_turn6=energia(10)
303 edihcnstr=energia(20)
305 ehomology_constr=energia(21)
311 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
313 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
314 & etors_d,wtor_d*fact(2),ehpb,wstrain,
315 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
316 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
317 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
318 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
319 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
321 10 format (/'Virtual-chain energies:'//
322 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
323 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
324 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
325 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
326 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
327 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
328 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
329 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
330 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
331 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
332 & ' (SS bridges & dist. cnstr.)'/
333 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
334 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
335 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
336 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
337 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
338 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
339 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
340 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
341 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
342 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
343 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
344 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
345 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
346 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
347 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
348 & 'ETOT= ',1pE16.6,' (total)')
350 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
351 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
352 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
353 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
354 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
355 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
356 & edihcnstr,ehomology_constr,ebr*nss,
357 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
359 10 format (/'Virtual-chain energies:'//
360 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
361 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
362 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
363 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
364 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
365 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
366 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
367 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
368 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
369 & ' (SS bridges & dist. cnstr.)'/
370 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
371 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
372 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
373 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
374 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
375 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
376 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
377 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
378 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
379 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
380 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
381 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
382 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
383 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
384 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
385 & 'ETOT= ',1pE16.6,' (total)')
389 C-----------------------------------------------------------------------
392 C This subroutine calculates the interaction energy of nonbonded side chains
393 C assuming the LJ potential of interaction.
395 implicit real*8 (a-h,o-z)
397 include 'sizesclu.dat'
398 c include "DIMENSIONS.COMPAR"
399 parameter (accur=1.0d-10)
402 include 'COMMON.LOCAL'
403 include 'COMMON.CHAIN'
404 include 'COMMON.DERIV'
405 include 'COMMON.INTERACT'
406 include 'COMMON.TORSION'
407 include 'COMMON.SBRIDGE'
408 include 'COMMON.NAMES'
409 include 'COMMON.IOUNITS'
410 include 'COMMON.CONTACTS'
414 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
425 C Calculate SC interaction energy.
428 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
429 cd & 'iend=',iend(i,iint)
430 do j=istart(i,iint),iend(i,iint)
435 C Change 12/1/95 to calculate four-body interactions
436 rij=xj*xj+yj*yj+zj*zj
438 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
439 eps0ij=eps(itypi,itypj)
441 e1=fac*fac*aa(itypi,itypj)
442 e2=fac*bb(itypi,itypj)
444 ij=icant(itypi,itypj)
445 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
446 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
447 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
448 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
449 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
450 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
454 C Calculate the components of the gradient in DC and X
456 fac=-rrij*(e1+evdwij)
461 gvdwx(k,i)=gvdwx(k,i)-gg(k)
462 gvdwx(k,j)=gvdwx(k,j)+gg(k)
466 gvdwc(l,k)=gvdwc(l,k)+gg(l)
471 C 12/1/95, revised on 5/20/97
473 C Calculate the contact function. The ith column of the array JCONT will
474 C contain the numbers of atoms that make contacts with the atom I (of numbers
475 C greater than I). The arrays FACONT and GACONT will contain the values of
476 C the contact function and its derivative.
478 C Uncomment next line, if the correlation interactions include EVDW explicitly.
479 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
480 C Uncomment next line, if the correlation interactions are contact function only
481 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
483 sigij=sigma(itypi,itypj)
484 r0ij=rs0(itypi,itypj)
486 C Check whether the SC's are not too far to make a contact.
489 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
490 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
492 if (fcont.gt.0.0D0) then
493 C If the SC-SC distance if close to sigma, apply spline.
494 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
495 cAdam & fcont1,fprimcont1)
496 cAdam fcont1=1.0d0-fcont1
497 cAdam if (fcont1.gt.0.0d0) then
498 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
499 cAdam fcont=fcont*fcont1
501 C Uncomment following 4 lines to have the geometric average of the epsilon0's
502 cga eps0ij=1.0d0/dsqrt(eps0ij)
504 cga gg(k)=gg(k)*eps0ij
506 cga eps0ij=-evdwij*eps0ij
507 C Uncomment for AL's type of SC correlation interactions.
509 num_conti=num_conti+1
511 facont(num_conti,i)=fcont*eps0ij
512 fprimcont=eps0ij*fprimcont/rij
514 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
515 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
516 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
517 C Uncomment following 3 lines for Skolnick's type of SC correlation.
518 gacont(1,num_conti,i)=-fprimcont*xj
519 gacont(2,num_conti,i)=-fprimcont*yj
520 gacont(3,num_conti,i)=-fprimcont*zj
521 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
522 cd write (iout,'(2i3,3f10.5)')
523 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
529 num_cont(i)=num_conti
534 gvdwc(j,i)=expon*gvdwc(j,i)
535 gvdwx(j,i)=expon*gvdwx(j,i)
539 C******************************************************************************
543 C To save time, the factor of EXPON has been extracted from ALL components
544 C of GVDWC and GRADX. Remember to multiply them by this factor before further
547 C******************************************************************************
550 C-----------------------------------------------------------------------------
551 subroutine eljk(evdw)
553 C This subroutine calculates the interaction energy of nonbonded side chains
554 C assuming the LJK potential of interaction.
556 implicit real*8 (a-h,o-z)
558 include 'sizesclu.dat'
559 c include "DIMENSIONS.COMPAR"
562 include 'COMMON.LOCAL'
563 include 'COMMON.CHAIN'
564 include 'COMMON.DERIV'
565 include 'COMMON.INTERACT'
566 include 'COMMON.IOUNITS'
567 include 'COMMON.NAMES'
572 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
581 C Calculate SC interaction energy.
584 do j=istart(i,iint),iend(i,iint)
589 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
591 e_augm=augm(itypi,itypj)*fac_augm
594 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
595 fac=r_shift_inv**expon
596 e1=fac*fac*aa(itypi,itypj)
597 e2=fac*bb(itypi,itypj)
599 ij=icant(itypi,itypj)
600 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
601 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
602 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
603 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
604 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
605 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
606 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
610 C Calculate the components of the gradient in DC and X
612 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
617 gvdwx(k,i)=gvdwx(k,i)-gg(k)
618 gvdwx(k,j)=gvdwx(k,j)+gg(k)
622 gvdwc(l,k)=gvdwc(l,k)+gg(l)
632 gvdwc(j,i)=expon*gvdwc(j,i)
633 gvdwx(j,i)=expon*gvdwx(j,i)
639 C-----------------------------------------------------------------------------
642 C This subroutine calculates the interaction energy of nonbonded side chains
643 C assuming the Berne-Pechukas potential of interaction.
645 implicit real*8 (a-h,o-z)
647 include 'sizesclu.dat'
648 c include "DIMENSIONS.COMPAR"
651 include 'COMMON.LOCAL'
652 include 'COMMON.CHAIN'
653 include 'COMMON.DERIV'
654 include 'COMMON.NAMES'
655 include 'COMMON.INTERACT'
656 include 'COMMON.IOUNITS'
657 include 'COMMON.CALC'
659 c double precision rrsave(maxdim)
664 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
666 c if (icall.eq.0) then
678 dxi=dc_norm(1,nres+i)
679 dyi=dc_norm(2,nres+i)
680 dzi=dc_norm(3,nres+i)
681 dsci_inv=vbld_inv(i+nres)
683 C Calculate SC interaction energy.
686 do j=istart(i,iint),iend(i,iint)
689 dscj_inv=vbld_inv(j+nres)
690 chi1=chi(itypi,itypj)
691 chi2=chi(itypj,itypi)
698 alf12=0.5D0*(alf1+alf2)
699 C For diagnostics only!!!
712 dxj=dc_norm(1,nres+j)
713 dyj=dc_norm(2,nres+j)
714 dzj=dc_norm(3,nres+j)
715 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
716 cd if (icall.eq.0) then
722 C Calculate the angle-dependent terms of energy & contributions to derivatives.
724 C Calculate whole angle-dependent part of epsilon and contributions
726 fac=(rrij*sigsq)**expon2
727 e1=fac*fac*aa(itypi,itypj)
728 e2=fac*bb(itypi,itypj)
729 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
730 eps2der=evdwij*eps3rt
731 eps3der=evdwij*eps2rt
732 evdwij=evdwij*eps2rt*eps3rt
733 ij=icant(itypi,itypj)
734 aux=eps1*eps2rt**2*eps3rt**2
738 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
739 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
740 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
741 cd & restyp(itypi),i,restyp(itypj),j,
742 cd & epsi,sigm,chi1,chi2,chip1,chip2,
743 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
744 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
747 C Calculate gradient components.
748 e1=e1*eps1*eps2rt**2*eps3rt**2
749 fac=-expon*(e1+evdwij)
752 C Calculate radial part of the gradient
756 C Calculate the angular part of the gradient and sum add the contributions
757 C to the appropriate components of the Cartesian gradient.
766 C-----------------------------------------------------------------------------
769 C This subroutine calculates the interaction energy of nonbonded side chains
770 C assuming the Gay-Berne potential of interaction.
772 implicit real*8 (a-h,o-z)
774 include 'sizesclu.dat'
775 c include "DIMENSIONS.COMPAR"
778 include 'COMMON.LOCAL'
779 include 'COMMON.CHAIN'
780 include 'COMMON.DERIV'
781 include 'COMMON.NAMES'
782 include 'COMMON.INTERACT'
783 include 'COMMON.IOUNITS'
784 include 'COMMON.CALC'
785 include 'COMMON.SBRIDGE'
791 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
794 c if (icall.gt.0) lprn=.true.
802 dxi=dc_norm(1,nres+i)
803 dyi=dc_norm(2,nres+i)
804 dzi=dc_norm(3,nres+i)
805 dsci_inv=vbld_inv(i+nres)
807 C Calculate SC interaction energy.
810 do j=istart(i,iint),iend(i,iint)
811 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
812 call dyn_ssbond_ene(i,j,evdwij)
814 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
815 c & 'evdw',i,j,evdwij,' ss'
819 dscj_inv=vbld_inv(j+nres)
820 sig0ij=sigma(itypi,itypj)
821 chi1=chi(itypi,itypj)
822 chi2=chi(itypj,itypi)
829 alf12=0.5D0*(alf1+alf2)
830 C For diagnostics only!!!
843 dxj=dc_norm(1,nres+j)
844 dyj=dc_norm(2,nres+j)
845 dzj=dc_norm(3,nres+j)
846 c write (iout,*) i,j,xj,yj,zj
847 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
849 C Calculate angle-dependent terms of energy and contributions to their
853 sig=sig0ij*dsqrt(sigsq)
854 rij_shift=1.0D0/rij-sig+sig0ij
855 C I hate to put IF's in the loops, but here don't have another choice!!!!
856 if (rij_shift.le.0.0D0) then
861 c---------------------------------------------------------------
862 rij_shift=1.0D0/rij_shift
864 e1=fac*fac*aa(itypi,itypj)
865 e2=fac*bb(itypi,itypj)
866 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
867 eps2der=evdwij*eps3rt
868 eps3der=evdwij*eps2rt
869 evdwij=evdwij*eps2rt*eps3rt
871 ij=icant(itypi,itypj)
872 aux=eps1*eps2rt**2*eps3rt**2
873 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
874 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
875 c & aux*e2/eps(itypi,itypj)
877 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
878 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
879 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
880 & restyp(itypi),i,restyp(itypj),j,
881 & epsi,sigm,chi1,chi2,chip1,chip2,
882 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
883 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
887 C Calculate gradient components.
888 e1=e1*eps1*eps2rt**2*eps3rt**2
889 fac=-expon*(e1+evdwij)*rij_shift
892 C Calculate the radial part of the gradient
896 C Calculate angular part of the gradient.
905 C-----------------------------------------------------------------------------
906 subroutine egbv(evdw)
908 C This subroutine calculates the interaction energy of nonbonded side chains
909 C assuming the Gay-Berne-Vorobjev potential of interaction.
911 implicit real*8 (a-h,o-z)
913 include 'sizesclu.dat'
914 c include "DIMENSIONS.COMPAR"
917 include 'COMMON.LOCAL'
918 include 'COMMON.CHAIN'
919 include 'COMMON.DERIV'
920 include 'COMMON.NAMES'
921 include 'COMMON.INTERACT'
922 include 'COMMON.IOUNITS'
923 include 'COMMON.CALC'
924 include 'COMMON.SBRIDGE'
930 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
933 c if (icall.gt.0) lprn=.true.
941 dxi=dc_norm(1,nres+i)
942 dyi=dc_norm(2,nres+i)
943 dzi=dc_norm(3,nres+i)
944 dsci_inv=vbld_inv(i+nres)
946 C Calculate SC interaction energy.
949 do j=istart(i,iint),iend(i,iint)
950 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
951 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
952 call dyn_ssbond_ene(i,j,evdwij)
954 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
955 c & 'evdw',i,j,evdwij,' ss'
959 dscj_inv=vbld_inv(j+nres)
960 sig0ij=sigma(itypi,itypj)
962 chi1=chi(itypi,itypj)
963 chi2=chi(itypj,itypi)
970 alf12=0.5D0*(alf1+alf2)
971 C For diagnostics only!!!
984 dxj=dc_norm(1,nres+j)
985 dyj=dc_norm(2,nres+j)
986 dzj=dc_norm(3,nres+j)
987 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
989 C Calculate angle-dependent terms of energy and contributions to their
993 sig=sig0ij*dsqrt(sigsq)
994 rij_shift=1.0D0/rij-sig+r0ij
995 C I hate to put IF's in the loops, but here don't have another choice!!!!
996 if (rij_shift.le.0.0D0) then
1001 c---------------------------------------------------------------
1002 rij_shift=1.0D0/rij_shift
1003 fac=rij_shift**expon
1004 e1=fac*fac*aa(itypi,itypj)
1005 e2=fac*bb(itypi,itypj)
1006 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1007 eps2der=evdwij*eps3rt
1008 eps3der=evdwij*eps2rt
1009 fac_augm=rrij**expon
1010 e_augm=augm(itypi,itypj)*fac_augm
1011 evdwij=evdwij*eps2rt*eps3rt
1012 evdw=evdw+evdwij+e_augm
1013 ij=icant(itypi,itypj)
1014 aux=eps1*eps2rt**2*eps3rt**2
1016 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1017 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1018 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1019 c & restyp(itypi),i,restyp(itypj),j,
1020 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1021 c & chi1,chi2,chip1,chip2,
1022 c & eps1,eps2rt**2,eps3rt**2,
1023 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1027 C Calculate gradient components.
1028 e1=e1*eps1*eps2rt**2*eps3rt**2
1029 fac=-expon*(e1+evdwij)*rij_shift
1031 fac=rij*fac-2*expon*rrij*e_augm
1032 C Calculate the radial part of the gradient
1036 C Calculate angular part of the gradient.
1045 C-----------------------------------------------------------------------------
1046 subroutine sc_angular
1047 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1048 C om12. Called by ebp, egb, and egbv.
1050 include 'COMMON.CALC'
1054 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1055 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1056 om12=dxi*dxj+dyi*dyj+dzi*dzj
1058 C Calculate eps1(om12) and its derivative in om12
1059 faceps1=1.0D0-om12*chiom12
1060 faceps1_inv=1.0D0/faceps1
1061 eps1=dsqrt(faceps1_inv)
1062 C Following variable is eps1*deps1/dom12
1063 eps1_om12=faceps1_inv*chiom12
1064 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1069 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1070 sigsq=1.0D0-facsig*faceps1_inv
1071 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1072 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1073 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1074 C Calculate eps2 and its derivatives in om1, om2, and om12.
1077 chipom12=chip12*om12
1078 facp=1.0D0-om12*chipom12
1080 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1081 C Following variable is the square root of eps2
1082 eps2rt=1.0D0-facp1*facp_inv
1083 C Following three variables are the derivatives of the square root of eps
1084 C in om1, om2, and om12.
1085 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1086 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1087 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1088 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1089 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1090 C Calculate whole angle-dependent part of epsilon and contributions
1091 C to its derivatives
1094 C----------------------------------------------------------------------------
1096 implicit real*8 (a-h,o-z)
1097 include 'DIMENSIONS'
1098 include 'sizesclu.dat'
1099 include 'COMMON.CHAIN'
1100 include 'COMMON.DERIV'
1101 include 'COMMON.CALC'
1102 double precision dcosom1(3),dcosom2(3)
1103 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1104 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1105 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1106 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1108 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1109 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1112 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1115 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1116 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1117 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1118 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1119 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1120 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1123 C Calculate the components of the gradient in DC and X
1127 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1132 c------------------------------------------------------------------------------
1133 subroutine vec_and_deriv
1134 implicit real*8 (a-h,o-z)
1135 include 'DIMENSIONS'
1136 include 'sizesclu.dat'
1137 include 'COMMON.IOUNITS'
1138 include 'COMMON.GEO'
1139 include 'COMMON.VAR'
1140 include 'COMMON.LOCAL'
1141 include 'COMMON.CHAIN'
1142 include 'COMMON.VECTORS'
1143 include 'COMMON.DERIV'
1144 include 'COMMON.INTERACT'
1145 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1146 C Compute the local reference systems. For reference system (i), the
1147 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1148 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1150 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1151 if (i.eq.nres-1) then
1152 C Case of the last full residue
1153 C Compute the Z-axis
1154 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1155 costh=dcos(pi-theta(nres))
1156 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1161 C Compute the derivatives of uz
1163 uzder(2,1,1)=-dc_norm(3,i-1)
1164 uzder(3,1,1)= dc_norm(2,i-1)
1165 uzder(1,2,1)= dc_norm(3,i-1)
1167 uzder(3,2,1)=-dc_norm(1,i-1)
1168 uzder(1,3,1)=-dc_norm(2,i-1)
1169 uzder(2,3,1)= dc_norm(1,i-1)
1172 uzder(2,1,2)= dc_norm(3,i)
1173 uzder(3,1,2)=-dc_norm(2,i)
1174 uzder(1,2,2)=-dc_norm(3,i)
1176 uzder(3,2,2)= dc_norm(1,i)
1177 uzder(1,3,2)= dc_norm(2,i)
1178 uzder(2,3,2)=-dc_norm(1,i)
1181 C Compute the Y-axis
1184 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1187 C Compute the derivatives of uy
1190 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1191 & -dc_norm(k,i)*dc_norm(j,i-1)
1192 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1194 uyder(j,j,1)=uyder(j,j,1)-costh
1195 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1200 uygrad(l,k,j,i)=uyder(l,k,j)
1201 uzgrad(l,k,j,i)=uzder(l,k,j)
1205 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1206 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1207 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1208 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1212 C Compute the Z-axis
1213 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1214 costh=dcos(pi-theta(i+2))
1215 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1220 C Compute the derivatives of uz
1222 uzder(2,1,1)=-dc_norm(3,i+1)
1223 uzder(3,1,1)= dc_norm(2,i+1)
1224 uzder(1,2,1)= dc_norm(3,i+1)
1226 uzder(3,2,1)=-dc_norm(1,i+1)
1227 uzder(1,3,1)=-dc_norm(2,i+1)
1228 uzder(2,3,1)= dc_norm(1,i+1)
1231 uzder(2,1,2)= dc_norm(3,i)
1232 uzder(3,1,2)=-dc_norm(2,i)
1233 uzder(1,2,2)=-dc_norm(3,i)
1235 uzder(3,2,2)= dc_norm(1,i)
1236 uzder(1,3,2)= dc_norm(2,i)
1237 uzder(2,3,2)=-dc_norm(1,i)
1240 C Compute the Y-axis
1243 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1246 C Compute the derivatives of uy
1249 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1250 & -dc_norm(k,i)*dc_norm(j,i+1)
1251 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1253 uyder(j,j,1)=uyder(j,j,1)-costh
1254 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1259 uygrad(l,k,j,i)=uyder(l,k,j)
1260 uzgrad(l,k,j,i)=uzder(l,k,j)
1264 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1265 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1266 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1267 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1273 vbld_inv_temp(1)=vbld_inv(i+1)
1274 if (i.lt.nres-1) then
1275 vbld_inv_temp(2)=vbld_inv(i+2)
1277 vbld_inv_temp(2)=vbld_inv(i)
1282 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1283 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1291 C-----------------------------------------------------------------------------
1292 subroutine vec_and_deriv_test
1293 implicit real*8 (a-h,o-z)
1294 include 'DIMENSIONS'
1295 include 'sizesclu.dat'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.GEO'
1298 include 'COMMON.VAR'
1299 include 'COMMON.LOCAL'
1300 include 'COMMON.CHAIN'
1301 include 'COMMON.VECTORS'
1302 dimension uyder(3,3,2),uzder(3,3,2)
1303 C Compute the local reference systems. For reference system (i), the
1304 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1305 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1307 if (i.eq.nres-1) then
1308 C Case of the last full residue
1309 C Compute the Z-axis
1310 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1311 costh=dcos(pi-theta(nres))
1312 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1313 c write (iout,*) 'fac',fac,
1314 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1315 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1319 C Compute the derivatives of uz
1321 uzder(2,1,1)=-dc_norm(3,i-1)
1322 uzder(3,1,1)= dc_norm(2,i-1)
1323 uzder(1,2,1)= dc_norm(3,i-1)
1325 uzder(3,2,1)=-dc_norm(1,i-1)
1326 uzder(1,3,1)=-dc_norm(2,i-1)
1327 uzder(2,3,1)= dc_norm(1,i-1)
1330 uzder(2,1,2)= dc_norm(3,i)
1331 uzder(3,1,2)=-dc_norm(2,i)
1332 uzder(1,2,2)=-dc_norm(3,i)
1334 uzder(3,2,2)= dc_norm(1,i)
1335 uzder(1,3,2)= dc_norm(2,i)
1336 uzder(2,3,2)=-dc_norm(1,i)
1338 C Compute the Y-axis
1340 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1343 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1344 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1345 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1347 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1350 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1351 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1354 c write (iout,*) 'facy',facy,
1355 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1358 uy(k,i)=facy*uy(k,i)
1360 C Compute the derivatives of uy
1363 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1364 & -dc_norm(k,i)*dc_norm(j,i-1)
1365 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1367 c uyder(j,j,1)=uyder(j,j,1)-costh
1368 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1369 uyder(j,j,1)=uyder(j,j,1)
1370 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1371 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1377 uygrad(l,k,j,i)=uyder(l,k,j)
1378 uzgrad(l,k,j,i)=uzder(l,k,j)
1382 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1383 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1384 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1385 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1388 C Compute the Z-axis
1389 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1390 costh=dcos(pi-theta(i+2))
1391 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1392 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1396 C Compute the derivatives of uz
1398 uzder(2,1,1)=-dc_norm(3,i+1)
1399 uzder(3,1,1)= dc_norm(2,i+1)
1400 uzder(1,2,1)= dc_norm(3,i+1)
1402 uzder(3,2,1)=-dc_norm(1,i+1)
1403 uzder(1,3,1)=-dc_norm(2,i+1)
1404 uzder(2,3,1)= dc_norm(1,i+1)
1407 uzder(2,1,2)= dc_norm(3,i)
1408 uzder(3,1,2)=-dc_norm(2,i)
1409 uzder(1,2,2)=-dc_norm(3,i)
1411 uzder(3,2,2)= dc_norm(1,i)
1412 uzder(1,3,2)= dc_norm(2,i)
1413 uzder(2,3,2)=-dc_norm(1,i)
1415 C Compute the Y-axis
1417 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1418 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1419 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1421 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1424 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1425 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1428 c write (iout,*) 'facy',facy,
1429 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1430 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1432 uy(k,i)=facy*uy(k,i)
1434 C Compute the derivatives of uy
1437 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1438 & -dc_norm(k,i)*dc_norm(j,i+1)
1439 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1441 c uyder(j,j,1)=uyder(j,j,1)-costh
1442 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1443 uyder(j,j,1)=uyder(j,j,1)
1444 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1445 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1451 uygrad(l,k,j,i)=uyder(l,k,j)
1452 uzgrad(l,k,j,i)=uzder(l,k,j)
1456 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1457 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1458 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1459 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1466 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1467 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1474 C-----------------------------------------------------------------------------
1475 subroutine check_vecgrad
1476 implicit real*8 (a-h,o-z)
1477 include 'DIMENSIONS'
1478 include 'sizesclu.dat'
1479 include 'COMMON.IOUNITS'
1480 include 'COMMON.GEO'
1481 include 'COMMON.VAR'
1482 include 'COMMON.LOCAL'
1483 include 'COMMON.CHAIN'
1484 include 'COMMON.VECTORS'
1485 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1486 dimension uyt(3,maxres),uzt(3,maxres)
1487 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1488 double precision delta /1.0d-7/
1491 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1492 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1493 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1494 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1495 cd & (dc_norm(if90,i),if90=1,3)
1496 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1497 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1498 cd write(iout,'(a)')
1504 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1505 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1518 cd write (iout,*) 'i=',i
1520 erij(k)=dc_norm(k,i)
1524 dc_norm(k,i)=erij(k)
1526 dc_norm(j,i)=dc_norm(j,i)+delta
1527 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1529 c dc_norm(k,i)=dc_norm(k,i)/fac
1531 c write (iout,*) (dc_norm(k,i),k=1,3)
1532 c write (iout,*) (erij(k),k=1,3)
1535 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1536 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1537 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1538 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1540 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1541 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1542 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1545 dc_norm(k,i)=erij(k)
1548 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1549 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1550 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1551 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1552 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1553 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1554 cd write (iout,'(a)')
1559 C--------------------------------------------------------------------------
1560 subroutine set_matrices
1561 implicit real*8 (a-h,o-z)
1562 include 'DIMENSIONS'
1563 include 'sizesclu.dat'
1564 include 'COMMON.IOUNITS'
1565 include 'COMMON.GEO'
1566 include 'COMMON.VAR'
1567 include 'COMMON.LOCAL'
1568 include 'COMMON.CHAIN'
1569 include 'COMMON.DERIV'
1570 include 'COMMON.INTERACT'
1571 include 'COMMON.CONTACTS'
1572 include 'COMMON.TORSION'
1573 include 'COMMON.VECTORS'
1574 include 'COMMON.FFIELD'
1575 double precision auxvec(2),auxmat(2,2)
1577 C Compute the virtual-bond-torsional-angle dependent quantities needed
1578 C to calculate the el-loc multibody terms of various order.
1581 if (i .lt. nres+1) then
1618 if (i .gt. 3 .and. i .lt. nres+1) then
1619 obrot_der(1,i-2)=-sin1
1620 obrot_der(2,i-2)= cos1
1621 Ugder(1,1,i-2)= sin1
1622 Ugder(1,2,i-2)=-cos1
1623 Ugder(2,1,i-2)=-cos1
1624 Ugder(2,2,i-2)=-sin1
1627 obrot2_der(1,i-2)=-dwasin2
1628 obrot2_der(2,i-2)= dwacos2
1629 Ug2der(1,1,i-2)= dwasin2
1630 Ug2der(1,2,i-2)=-dwacos2
1631 Ug2der(2,1,i-2)=-dwacos2
1632 Ug2der(2,2,i-2)=-dwasin2
1634 obrot_der(1,i-2)=0.0d0
1635 obrot_der(2,i-2)=0.0d0
1636 Ugder(1,1,i-2)=0.0d0
1637 Ugder(1,2,i-2)=0.0d0
1638 Ugder(2,1,i-2)=0.0d0
1639 Ugder(2,2,i-2)=0.0d0
1640 obrot2_der(1,i-2)=0.0d0
1641 obrot2_der(2,i-2)=0.0d0
1642 Ug2der(1,1,i-2)=0.0d0
1643 Ug2der(1,2,i-2)=0.0d0
1644 Ug2der(2,1,i-2)=0.0d0
1645 Ug2der(2,2,i-2)=0.0d0
1647 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1648 iti = itortyp(itype(i-2))
1652 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1653 iti1 = itortyp(itype(i-1))
1657 cd write (iout,*) '*******i',i,' iti1',iti
1658 cd write (iout,*) 'b1',b1(:,iti)
1659 cd write (iout,*) 'b2',b2(:,iti)
1660 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1661 if (i .gt. iatel_s+2) then
1662 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1663 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1664 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1665 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1666 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1667 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1668 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1678 DtUg2(l,k,i-2)=0.0d0
1682 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1683 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1684 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1685 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1686 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1687 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1688 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1690 muder(k,i-2)=Ub2der(k,i-2)
1692 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1693 iti1 = itortyp(itype(i-1))
1698 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1700 C Vectors and matrices dependent on a single virtual-bond dihedral.
1701 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1702 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1703 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1704 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1705 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1706 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1707 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1708 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1709 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1710 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1711 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1713 C Matrices dependent on two consecutive virtual-bond dihedrals.
1714 C The order of matrices is from left to right.
1716 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1717 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1718 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1719 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1720 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1721 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1722 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1723 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1726 cd iti = itortyp(itype(i))
1729 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1730 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1735 C--------------------------------------------------------------------------
1736 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1738 C This subroutine calculates the average interaction energy and its gradient
1739 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1740 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1741 C The potential depends both on the distance of peptide-group centers and on
1742 C the orientation of the CA-CA virtual bonds.
1744 implicit real*8 (a-h,o-z)
1745 include 'DIMENSIONS'
1746 include 'sizesclu.dat'
1747 include 'COMMON.CONTROL'
1748 include 'COMMON.IOUNITS'
1749 include 'COMMON.GEO'
1750 include 'COMMON.VAR'
1751 include 'COMMON.LOCAL'
1752 include 'COMMON.CHAIN'
1753 include 'COMMON.DERIV'
1754 include 'COMMON.INTERACT'
1755 include 'COMMON.CONTACTS'
1756 include 'COMMON.TORSION'
1757 include 'COMMON.VECTORS'
1758 include 'COMMON.FFIELD'
1759 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1760 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1761 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1762 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1763 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1764 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1765 double precision scal_el /0.5d0/
1767 C 13-go grudnia roku pamietnego...
1768 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1769 & 0.0d0,1.0d0,0.0d0,
1770 & 0.0d0,0.0d0,1.0d0/
1771 cd write(iout,*) 'In EELEC'
1773 cd write(iout,*) 'Type',i
1774 cd write(iout,*) 'B1',B1(:,i)
1775 cd write(iout,*) 'B2',B2(:,i)
1776 cd write(iout,*) 'CC',CC(:,:,i)
1777 cd write(iout,*) 'DD',DD(:,:,i)
1778 cd write(iout,*) 'EE',EE(:,:,i)
1780 cd call check_vecgrad
1782 if (icheckgrad.eq.1) then
1784 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1786 dc_norm(k,i)=dc(k,i)*fac
1788 c write (iout,*) 'i',i,' fac',fac
1791 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1792 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1793 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1794 cd if (wel_loc.gt.0.0d0) then
1795 if (icheckgrad.eq.1) then
1796 call vec_and_deriv_test
1803 cd write (iout,*) 'i=',i
1805 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1808 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1809 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1822 cd print '(a)','Enter EELEC'
1823 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1825 gel_loc_loc(i)=0.0d0
1828 do i=iatel_s,iatel_e
1829 if (itel(i).eq.0) goto 1215
1833 dx_normi=dc_norm(1,i)
1834 dy_normi=dc_norm(2,i)
1835 dz_normi=dc_norm(3,i)
1836 xmedi=c(1,i)+0.5d0*dxi
1837 ymedi=c(2,i)+0.5d0*dyi
1838 zmedi=c(3,i)+0.5d0*dzi
1840 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1841 do j=ielstart(i),ielend(i)
1842 if (itel(j).eq.0) goto 1216
1846 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1847 aaa=app(iteli,itelj)
1848 bbb=bpp(iteli,itelj)
1849 C Diagnostics only!!!
1855 ael6i=ael6(iteli,itelj)
1856 ael3i=ael3(iteli,itelj)
1860 dx_normj=dc_norm(1,j)
1861 dy_normj=dc_norm(2,j)
1862 dz_normj=dc_norm(3,j)
1863 xj=c(1,j)+0.5D0*dxj-xmedi
1864 yj=c(2,j)+0.5D0*dyj-ymedi
1865 zj=c(3,j)+0.5D0*dzj-zmedi
1866 rij=xj*xj+yj*yj+zj*zj
1872 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1873 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1874 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1875 fac=cosa-3.0D0*cosb*cosg
1877 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1878 if (j.eq.i+2) ev1=scal_el*ev1
1883 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1886 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1887 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1888 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1891 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1892 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1893 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1894 cd & xmedi,ymedi,zmedi,xj,yj,zj
1896 C Calculate contributions to the Cartesian gradient.
1899 facvdw=-6*rrmij*(ev1+evdwij)
1900 facel=-3*rrmij*(el1+eesij)
1907 * Radial derivatives. First process both termini of the fragment (i,j)
1914 gelc(k,i)=gelc(k,i)+ghalf
1915 gelc(k,j)=gelc(k,j)+ghalf
1918 * Loop over residues i+1 thru j-1.
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1930 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1931 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1934 * Loop over residues i+1 thru j-1.
1938 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1945 fac=-3*rrmij*(facvdw+facvdw+facel)
1951 * Radial derivatives. First process both termini of the fragment (i,j)
1958 gelc(k,i)=gelc(k,i)+ghalf
1959 gelc(k,j)=gelc(k,j)+ghalf
1962 * Loop over residues i+1 thru j-1.
1966 gelc(l,k)=gelc(l,k)+ggg(l)
1973 ecosa=2.0D0*fac3*fac1+fac4
1976 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1977 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1979 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1980 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1982 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1983 cd & (dcosg(k),k=1,3)
1985 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1989 gelc(k,i)=gelc(k,i)+ghalf
1990 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1991 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1992 gelc(k,j)=gelc(k,j)+ghalf
1993 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1994 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1998 gelc(l,k)=gelc(l,k)+ggg(l)
2003 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2004 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2005 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2007 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2008 C energy of a peptide unit is assumed in the form of a second-order
2009 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2010 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2011 C are computed for EVERY pair of non-contiguous peptide groups.
2013 if (j.lt.nres-1) then
2024 muij(kkk)=mu(k,i)*mu(l,j)
2027 cd write (iout,*) 'EELEC: i',i,' j',j
2028 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2029 cd write(iout,*) 'muij',muij
2030 ury=scalar(uy(1,i),erij)
2031 urz=scalar(uz(1,i),erij)
2032 vry=scalar(uy(1,j),erij)
2033 vrz=scalar(uz(1,j),erij)
2034 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2035 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2036 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2037 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2038 C For diagnostics only
2043 fac=dsqrt(-ael6i)*r3ij
2044 cd write (2,*) 'fac=',fac
2045 C For diagnostics only
2051 cd write (iout,'(4i5,4f10.5)')
2052 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2053 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2054 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2055 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2056 cd write (iout,'(4f10.5)')
2057 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2058 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2059 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2060 cd write (iout,'(2i3,9f10.5/)') i,j,
2061 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2063 C Derivatives of the elements of A in virtual-bond vectors
2064 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2071 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2072 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2073 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2074 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2075 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2076 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2077 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2078 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2079 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2080 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2081 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2082 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2092 C Compute radial contributions to the gradient
2114 C Add the contributions coming from er
2117 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2118 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2119 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2120 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2123 C Derivatives in DC(i)
2124 ghalf1=0.5d0*agg(k,1)
2125 ghalf2=0.5d0*agg(k,2)
2126 ghalf3=0.5d0*agg(k,3)
2127 ghalf4=0.5d0*agg(k,4)
2128 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2129 & -3.0d0*uryg(k,2)*vry)+ghalf1
2130 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2131 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2132 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2133 & -3.0d0*urzg(k,2)*vry)+ghalf3
2134 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2135 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2136 C Derivatives in DC(i+1)
2137 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2138 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2139 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2140 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2141 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2142 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2143 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2144 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2145 C Derivatives in DC(j)
2146 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2147 & -3.0d0*vryg(k,2)*ury)+ghalf1
2148 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2149 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2150 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2151 & -3.0d0*vryg(k,2)*urz)+ghalf3
2152 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2153 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2154 C Derivatives in DC(j+1) or DC(nres-1)
2155 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2156 & -3.0d0*vryg(k,3)*ury)
2157 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2158 & -3.0d0*vrzg(k,3)*ury)
2159 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2160 & -3.0d0*vryg(k,3)*urz)
2161 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2162 & -3.0d0*vrzg(k,3)*urz)
2167 C Derivatives in DC(i+1)
2168 cd aggi1(k,1)=agg(k,1)
2169 cd aggi1(k,2)=agg(k,2)
2170 cd aggi1(k,3)=agg(k,3)
2171 cd aggi1(k,4)=agg(k,4)
2172 C Derivatives in DC(j)
2177 C Derivatives in DC(j+1)
2182 if (j.eq.nres-1 .and. i.lt.j-2) then
2184 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2185 cd aggj1(k,l)=agg(k,l)
2191 C Check the loc-el terms by numerical integration
2201 aggi(k,l)=-aggi(k,l)
2202 aggi1(k,l)=-aggi1(k,l)
2203 aggj(k,l)=-aggj(k,l)
2204 aggj1(k,l)=-aggj1(k,l)
2207 if (j.lt.nres-1) then
2213 aggi(k,l)=-aggi(k,l)
2214 aggi1(k,l)=-aggi1(k,l)
2215 aggj(k,l)=-aggj(k,l)
2216 aggj1(k,l)=-aggj1(k,l)
2227 aggi(k,l)=-aggi(k,l)
2228 aggi1(k,l)=-aggi1(k,l)
2229 aggj(k,l)=-aggj(k,l)
2230 aggj1(k,l)=-aggj1(k,l)
2236 IF (wel_loc.gt.0.0d0) THEN
2237 C Contribution to the local-electrostatic energy coming from the i-j pair
2238 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2240 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2241 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2242 eel_loc=eel_loc+eel_loc_ij
2243 C Partial derivatives in virtual-bond dihedral angles gamma
2246 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2247 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2248 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2249 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2250 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2251 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2252 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2253 cd write(iout,*) 'agg ',agg
2254 cd write(iout,*) 'aggi ',aggi
2255 cd write(iout,*) 'aggi1',aggi1
2256 cd write(iout,*) 'aggj ',aggj
2257 cd write(iout,*) 'aggj1',aggj1
2259 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2261 ggg(l)=agg(l,1)*muij(1)+
2262 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2266 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2269 C Remaining derivatives of eello
2271 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2272 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2273 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2274 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2275 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2276 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2277 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2278 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2282 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2283 C Contributions from turns
2288 call eturn34(i,j,eello_turn3,eello_turn4)
2290 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2291 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2293 C Calculate the contact function. The ith column of the array JCONT will
2294 C contain the numbers of atoms that make contacts with the atom I (of numbers
2295 C greater than I). The arrays FACONT and GACONT will contain the values of
2296 C the contact function and its derivative.
2297 c r0ij=1.02D0*rpp(iteli,itelj)
2298 c r0ij=1.11D0*rpp(iteli,itelj)
2299 r0ij=2.20D0*rpp(iteli,itelj)
2300 c r0ij=1.55D0*rpp(iteli,itelj)
2301 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2302 if (fcont.gt.0.0D0) then
2303 num_conti=num_conti+1
2304 if (num_conti.gt.maxconts) then
2305 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2306 & ' will skip next contacts for this conf.'
2308 jcont_hb(num_conti,i)=j
2309 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2310 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2311 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2313 d_cont(num_conti,i)=rij
2314 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2315 C --- Electrostatic-interaction matrix ---
2316 a_chuj(1,1,num_conti,i)=a22
2317 a_chuj(1,2,num_conti,i)=a23
2318 a_chuj(2,1,num_conti,i)=a32
2319 a_chuj(2,2,num_conti,i)=a33
2320 C --- Gradient of rij
2322 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2325 c a_chuj(1,1,num_conti,i)=-0.61d0
2326 c a_chuj(1,2,num_conti,i)= 0.4d0
2327 c a_chuj(2,1,num_conti,i)= 0.65d0
2328 c a_chuj(2,2,num_conti,i)= 0.50d0
2329 c else if (i.eq.2) then
2330 c a_chuj(1,1,num_conti,i)= 0.0d0
2331 c a_chuj(1,2,num_conti,i)= 0.0d0
2332 c a_chuj(2,1,num_conti,i)= 0.0d0
2333 c a_chuj(2,2,num_conti,i)= 0.0d0
2335 C --- and its gradients
2336 cd write (iout,*) 'i',i,' j',j
2338 cd write (iout,*) 'iii 1 kkk',kkk
2339 cd write (iout,*) agg(kkk,:)
2342 cd write (iout,*) 'iii 2 kkk',kkk
2343 cd write (iout,*) aggi(kkk,:)
2346 cd write (iout,*) 'iii 3 kkk',kkk
2347 cd write (iout,*) aggi1(kkk,:)
2350 cd write (iout,*) 'iii 4 kkk',kkk
2351 cd write (iout,*) aggj(kkk,:)
2354 cd write (iout,*) 'iii 5 kkk',kkk
2355 cd write (iout,*) aggj1(kkk,:)
2362 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2363 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2364 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2365 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2366 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2368 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2374 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2375 C Calculate contact energies
2377 wij=cosa-3.0D0*cosb*cosg
2380 c fac3=dsqrt(-ael6i)/r0ij**3
2381 fac3=dsqrt(-ael6i)*r3ij
2382 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2383 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2385 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2386 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2387 C Diagnostics. Comment out or remove after debugging!
2388 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2389 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2390 c ees0m(num_conti,i)=0.0D0
2392 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2393 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2394 facont_hb(num_conti,i)=fcont
2396 C Angular derivatives of the contact function
2397 ees0pij1=fac3/ees0pij
2398 ees0mij1=fac3/ees0mij
2399 fac3p=-3.0D0*fac3*rrmij
2400 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2401 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2403 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2404 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2405 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2406 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2407 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2408 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2409 ecosap=ecosa1+ecosa2
2410 ecosbp=ecosb1+ecosb2
2411 ecosgp=ecosg1+ecosg2
2412 ecosam=ecosa1-ecosa2
2413 ecosbm=ecosb1-ecosb2
2414 ecosgm=ecosg1-ecosg2
2423 fprimcont=fprimcont/rij
2424 cd facont_hb(num_conti,i)=1.0D0
2425 C Following line is for diagnostics.
2428 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2429 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2432 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2433 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2435 gggp(1)=gggp(1)+ees0pijp*xj
2436 gggp(2)=gggp(2)+ees0pijp*yj
2437 gggp(3)=gggp(3)+ees0pijp*zj
2438 gggm(1)=gggm(1)+ees0mijp*xj
2439 gggm(2)=gggm(2)+ees0mijp*yj
2440 gggm(3)=gggm(3)+ees0mijp*zj
2441 C Derivatives due to the contact function
2442 gacont_hbr(1,num_conti,i)=fprimcont*xj
2443 gacont_hbr(2,num_conti,i)=fprimcont*yj
2444 gacont_hbr(3,num_conti,i)=fprimcont*zj
2446 ghalfp=0.5D0*gggp(k)
2447 ghalfm=0.5D0*gggm(k)
2448 gacontp_hb1(k,num_conti,i)=ghalfp
2449 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2450 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2451 gacontp_hb2(k,num_conti,i)=ghalfp
2452 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2453 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2454 gacontp_hb3(k,num_conti,i)=gggp(k)
2455 gacontm_hb1(k,num_conti,i)=ghalfm
2456 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2457 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2458 gacontm_hb2(k,num_conti,i)=ghalfm
2459 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2460 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2461 gacontm_hb3(k,num_conti,i)=gggm(k)
2464 C Diagnostics. Comment out or remove after debugging!
2466 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2467 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2468 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2469 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2470 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2471 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2474 endif ! num_conti.le.maxconts
2479 num_cont_hb(i)=num_conti
2483 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2484 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2486 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2487 ccc eel_loc=eel_loc+eello_turn3
2490 C-----------------------------------------------------------------------------
2491 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2492 C Third- and fourth-order contributions from turns
2493 implicit real*8 (a-h,o-z)
2494 include 'DIMENSIONS'
2495 include 'sizesclu.dat'
2496 include 'COMMON.IOUNITS'
2497 include 'COMMON.GEO'
2498 include 'COMMON.VAR'
2499 include 'COMMON.LOCAL'
2500 include 'COMMON.CHAIN'
2501 include 'COMMON.DERIV'
2502 include 'COMMON.INTERACT'
2503 include 'COMMON.CONTACTS'
2504 include 'COMMON.TORSION'
2505 include 'COMMON.VECTORS'
2506 include 'COMMON.FFIELD'
2508 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2509 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2510 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2511 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2512 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2513 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2515 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2517 C Third-order contributions
2524 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2525 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2526 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2527 call transpose2(auxmat(1,1),auxmat1(1,1))
2528 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2529 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2531 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2532 cd & ' eello_turn3_num',4*eello_turn3_num
2534 C Derivatives in gamma(i)
2535 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2536 call transpose2(auxmat2(1,1),pizda(1,1))
2537 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2538 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2539 C Derivatives in gamma(i+1)
2540 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2541 call transpose2(auxmat2(1,1),pizda(1,1))
2542 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2543 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2544 & +0.5d0*(pizda(1,1)+pizda(2,2))
2545 C Cartesian derivatives
2547 a_temp(1,1)=aggi(l,1)
2548 a_temp(1,2)=aggi(l,2)
2549 a_temp(2,1)=aggi(l,3)
2550 a_temp(2,2)=aggi(l,4)
2551 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2552 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2553 & +0.5d0*(pizda(1,1)+pizda(2,2))
2554 a_temp(1,1)=aggi1(l,1)
2555 a_temp(1,2)=aggi1(l,2)
2556 a_temp(2,1)=aggi1(l,3)
2557 a_temp(2,2)=aggi1(l,4)
2558 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2559 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2560 & +0.5d0*(pizda(1,1)+pizda(2,2))
2561 a_temp(1,1)=aggj(l,1)
2562 a_temp(1,2)=aggj(l,2)
2563 a_temp(2,1)=aggj(l,3)
2564 a_temp(2,2)=aggj(l,4)
2565 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2566 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2567 & +0.5d0*(pizda(1,1)+pizda(2,2))
2568 a_temp(1,1)=aggj1(l,1)
2569 a_temp(1,2)=aggj1(l,2)
2570 a_temp(2,1)=aggj1(l,3)
2571 a_temp(2,2)=aggj1(l,4)
2572 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2573 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2574 & +0.5d0*(pizda(1,1)+pizda(2,2))
2577 else if (j.eq.i+3) then
2578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2580 C Fourth-order contributions
2588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2589 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2590 iti1=itortyp(itype(i+1))
2591 iti2=itortyp(itype(i+2))
2592 iti3=itortyp(itype(i+3))
2593 call transpose2(EUg(1,1,i+1),e1t(1,1))
2594 call transpose2(Eug(1,1,i+2),e2t(1,1))
2595 call transpose2(Eug(1,1,i+3),e3t(1,1))
2596 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2597 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2598 s1=scalar2(b1(1,iti2),auxvec(1))
2599 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2600 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2601 s2=scalar2(b1(1,iti1),auxvec(1))
2602 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2603 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2604 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2605 eello_turn4=eello_turn4-(s1+s2+s3)
2606 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2607 cd & ' eello_turn4_num',8*eello_turn4_num
2608 C Derivatives in gamma(i)
2610 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2611 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2612 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2613 s1=scalar2(b1(1,iti2),auxvec(1))
2614 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2615 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2616 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2617 C Derivatives in gamma(i+1)
2618 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2619 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2622 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2625 C Derivatives in gamma(i+2)
2626 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2627 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2628 s1=scalar2(b1(1,iti2),auxvec(1))
2629 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2630 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2631 s2=scalar2(b1(1,iti1),auxvec(1))
2632 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2633 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2635 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2636 C Cartesian derivatives
2637 C Derivatives of this turn contributions in DC(i+2)
2638 if (j.lt.nres-1) then
2640 a_temp(1,1)=agg(l,1)
2641 a_temp(1,2)=agg(l,2)
2642 a_temp(2,1)=agg(l,3)
2643 a_temp(2,2)=agg(l,4)
2644 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2645 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2646 s1=scalar2(b1(1,iti2),auxvec(1))
2647 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2648 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2649 s2=scalar2(b1(1,iti1),auxvec(1))
2650 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2651 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2652 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2654 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2657 C Remaining derivatives of this turn contribution
2659 a_temp(1,1)=aggi(l,1)
2660 a_temp(1,2)=aggi(l,2)
2661 a_temp(2,1)=aggi(l,3)
2662 a_temp(2,2)=aggi(l,4)
2663 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2664 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2665 s1=scalar2(b1(1,iti2),auxvec(1))
2666 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2667 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2668 s2=scalar2(b1(1,iti1),auxvec(1))
2669 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2670 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2672 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2673 a_temp(1,1)=aggi1(l,1)
2674 a_temp(1,2)=aggi1(l,2)
2675 a_temp(2,1)=aggi1(l,3)
2676 a_temp(2,2)=aggi1(l,4)
2677 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2678 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2679 s1=scalar2(b1(1,iti2),auxvec(1))
2680 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2681 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2682 s2=scalar2(b1(1,iti1),auxvec(1))
2683 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2684 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2685 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2686 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2687 a_temp(1,1)=aggj(l,1)
2688 a_temp(1,2)=aggj(l,2)
2689 a_temp(2,1)=aggj(l,3)
2690 a_temp(2,2)=aggj(l,4)
2691 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2692 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2693 s1=scalar2(b1(1,iti2),auxvec(1))
2694 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2695 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2698 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2701 a_temp(1,1)=aggj1(l,1)
2702 a_temp(1,2)=aggj1(l,2)
2703 a_temp(2,1)=aggj1(l,3)
2704 a_temp(2,2)=aggj1(l,4)
2705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2707 s1=scalar2(b1(1,iti2),auxvec(1))
2708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2710 s2=scalar2(b1(1,iti1),auxvec(1))
2711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2714 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2720 C-----------------------------------------------------------------------------
2721 subroutine vecpr(u,v,w)
2722 implicit real*8(a-h,o-z)
2723 dimension u(3),v(3),w(3)
2724 w(1)=u(2)*v(3)-u(3)*v(2)
2725 w(2)=-u(1)*v(3)+u(3)*v(1)
2726 w(3)=u(1)*v(2)-u(2)*v(1)
2729 C-----------------------------------------------------------------------------
2730 subroutine unormderiv(u,ugrad,unorm,ungrad)
2731 C This subroutine computes the derivatives of a normalized vector u, given
2732 C the derivatives computed without normalization conditions, ugrad. Returns
2735 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2736 double precision vec(3)
2737 double precision scalar
2739 c write (2,*) 'ugrad',ugrad
2742 vec(i)=scalar(ugrad(1,i),u(1))
2744 c write (2,*) 'vec',vec
2747 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2750 c write (2,*) 'ungrad',ungrad
2753 C-----------------------------------------------------------------------------
2754 subroutine escp(evdw2,evdw2_14)
2756 C This subroutine calculates the excluded-volume interaction energy between
2757 C peptide-group centers and side chains and its gradient in virtual-bond and
2758 C side-chain vectors.
2760 implicit real*8 (a-h,o-z)
2761 include 'DIMENSIONS'
2762 include 'sizesclu.dat'
2763 include 'COMMON.GEO'
2764 include 'COMMON.VAR'
2765 include 'COMMON.LOCAL'
2766 include 'COMMON.CHAIN'
2767 include 'COMMON.DERIV'
2768 include 'COMMON.INTERACT'
2769 include 'COMMON.FFIELD'
2770 include 'COMMON.IOUNITS'
2774 cd print '(a)','Enter ESCP'
2775 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2776 c & ' scal14',scal14
2777 do i=iatscp_s,iatscp_e
2779 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2780 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2781 if (iteli.eq.0) goto 1225
2782 xi=0.5D0*(c(1,i)+c(1,i+1))
2783 yi=0.5D0*(c(2,i)+c(2,i+1))
2784 zi=0.5D0*(c(3,i)+c(3,i+1))
2786 do iint=1,nscp_gr(i)
2788 do j=iscpstart(i,iint),iscpend(i,iint)
2790 C Uncomment following three lines for SC-p interactions
2794 C Uncomment following three lines for Ca-p interactions
2798 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2800 e1=fac*fac*aad(itypj,iteli)
2801 e2=fac*bad(itypj,iteli)
2802 if (iabs(j-i) .le. 2) then
2805 evdw2_14=evdw2_14+e1+e2
2808 c write (iout,*) i,j,evdwij
2812 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2814 fac=-(evdwij+e1)*rrij
2819 cd write (iout,*) 'j<i'
2820 C Uncomment following three lines for SC-p interactions
2822 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2825 cd write (iout,*) 'j>i'
2828 C Uncomment following line for SC-p interactions
2829 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2833 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2837 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2838 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2841 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2851 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2852 gradx_scp(j,i)=expon*gradx_scp(j,i)
2855 C******************************************************************************
2859 C To save time the factor EXPON has been extracted from ALL components
2860 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2863 C******************************************************************************
2866 C--------------------------------------------------------------------------
2867 subroutine edis(ehpb)
2869 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2871 implicit real*8 (a-h,o-z)
2872 include 'DIMENSIONS'
2873 include 'COMMON.SBRIDGE'
2874 include 'COMMON.CHAIN'
2875 include 'COMMON.DERIV'
2876 include 'COMMON.VAR'
2877 include 'COMMON.INTERACT'
2878 include 'COMMON.IOUNITS'
2879 include 'COMMON.CONTROL'
2882 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2883 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2884 if (link_end.eq.0) return
2885 do i=link_start,link_end
2886 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2887 C CA-CA distance used in regularization of structure.
2890 C iii and jjj point to the residues for which the distance is assigned.
2891 if (ii.gt.nres) then
2898 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2899 c & dhpb(i),dhpb1(i),forcon(i)
2900 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2901 C distance and angle dependent SS bond potential.
2902 if (.not.dyn_ss .and. i.le.nss) then
2903 C 15/02/13 CC dynamic SSbond - additional check
2904 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2905 call ssbond_ene(iii,jjj,eij)
2907 cd write (iout,*) "eij",eij
2909 else if (ii.gt.nres .and. jj.gt.nres) then
2910 c Restraints from contact prediction
2912 if (constr_dist.eq.11) then
2913 ehpb=ehpb+fordepth(i)**4.0d0
2914 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2915 fac=fordepth(i)**4.0d0
2916 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2918 if (dhpb1(i).gt.0.0d0) then
2919 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2920 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2921 c write (iout,*) "beta nmr",
2922 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2926 C Get the force constant corresponding to this distance.
2928 C Calculate the contribution to energy.
2929 ehpb=ehpb+waga*rdis*rdis
2930 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2932 C Evaluate gradient.
2935 endif !end dhpb1(i).gt.0
2936 endif !end const_dist=11
2938 ggg(j)=fac*(c(j,jj)-c(j,ii))
2941 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2942 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2945 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2946 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2949 C Calculate the distance between the two points and its difference from the
2952 C write(iout,*) "after",dd
2953 if (constr_dist.eq.11) then
2954 ehpb=ehpb+fordepth(i)**4.0d0
2955 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2956 fac=fordepth(i)**4.0d0
2957 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2958 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
2959 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
2960 C print *,ehpb,"tu?"
2961 C write(iout,*) ehpb,"btu?",
2962 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
2963 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
2964 C & ehpb,fordepth(i),dd
2966 if (dhpb1(i).gt.0.0d0) then
2967 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2968 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2969 c write (iout,*) "alph nmr",
2970 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2973 C Get the force constant corresponding to this distance.
2975 C Calculate the contribution to energy.
2976 ehpb=ehpb+waga*rdis*rdis
2977 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2979 C Evaluate gradient.
2984 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2985 cd & ' waga=',waga,' fac=',fac
2987 ggg(j)=fac*(c(j,jj)-c(j,ii))
2989 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2990 C If this is a SC-SC distance, we need to calculate the contributions to the
2991 C Cartesian gradient in the SC vectors (ghpbx).
2994 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2995 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2999 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3000 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3004 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3007 C--------------------------------------------------------------------------
3008 subroutine ssbond_ene(i,j,eij)
3010 C Calculate the distance and angle dependent SS-bond potential energy
3011 C using a free-energy function derived based on RHF/6-31G** ab initio
3012 C calculations of diethyl disulfide.
3014 C A. Liwo and U. Kozlowska, 11/24/03
3016 implicit real*8 (a-h,o-z)
3017 include 'DIMENSIONS'
3018 include 'sizesclu.dat'
3019 include 'COMMON.SBRIDGE'
3020 include 'COMMON.CHAIN'
3021 include 'COMMON.DERIV'
3022 include 'COMMON.LOCAL'
3023 include 'COMMON.INTERACT'
3024 include 'COMMON.VAR'
3025 include 'COMMON.IOUNITS'
3026 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3031 dxi=dc_norm(1,nres+i)
3032 dyi=dc_norm(2,nres+i)
3033 dzi=dc_norm(3,nres+i)
3034 dsci_inv=dsc_inv(itypi)
3036 dscj_inv=dsc_inv(itypj)
3040 dxj=dc_norm(1,nres+j)
3041 dyj=dc_norm(2,nres+j)
3042 dzj=dc_norm(3,nres+j)
3043 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3048 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3049 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3050 om12=dxi*dxj+dyi*dyj+dzi*dzj
3052 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3053 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3059 deltat12=om2-om1+2.0d0
3061 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3062 & +akct*deltad*deltat12+ebr
3063 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3064 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3065 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3066 c & " deltat12",deltat12," eij",eij
3067 ed=2*akcm*deltad+akct*deltat12
3069 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3070 eom1=-2*akth*deltat1-pom1-om2*pom2
3071 eom2= 2*akth*deltat2+pom1-om1*pom2
3074 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3077 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3078 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3079 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3080 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3083 C Calculate the components of the gradient in DC and X
3087 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3093 C--------------------------------------------------------------------------
3096 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3097 subroutine e_modeller(ehomology_constr)
3098 implicit real*8 (a-h,o-z)
3100 include 'DIMENSIONS'
3102 integer nnn, i, j, k, ki, irec, l
3103 integer katy, odleglosci, test7
3104 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3105 real*8 distance(max_template),distancek(max_template),
3106 & min_odl,godl(max_template),dih_diff(max_template)
3109 c FP - 30/10/2014 Temporary specifications for homology restraints
3111 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3113 double precision, dimension (maxres) :: guscdiff,usc_diff
3114 double precision, dimension (max_template) ::
3115 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3118 include 'COMMON.SBRIDGE'
3119 include 'COMMON.CHAIN'
3120 include 'COMMON.GEO'
3121 include 'COMMON.DERIV'
3122 include 'COMMON.LOCAL'
3123 include 'COMMON.INTERACT'
3124 include 'COMMON.VAR'
3125 include 'COMMON.IOUNITS'
3126 include 'COMMON.CONTROL'
3127 include 'COMMON.HOMRESTR'
3129 include 'COMMON.SETUP'
3130 include 'COMMON.NAMES'
3133 distancek(i)=9999999.9
3138 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3140 C AL 5/2/14 - Introduce list of restraints
3141 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3143 write(iout,*) "------- dist restrs start -------"
3144 write (iout,*) "link_start_homo",link_start_homo,
3145 & " link_end_homo",link_end_homo
3147 do ii = link_start_homo,link_end_homo
3151 c write (iout,*) "dij(",i,j,") =",dij
3153 do k=1,constr_homology
3154 if(.not.l_homo(k,ii)) then
3158 distance(k)=odl(k,ii)-dij
3159 c write (iout,*) "distance(",k,") =",distance(k)
3161 c For Gaussian-type Urestr
3163 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3164 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3165 c write (iout,*) "distancek(",k,") =",distancek(k)
3166 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3168 c For Lorentzian-type Urestr
3170 if (waga_dist.lt.0.0d0) then
3171 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3172 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3173 & (distance(k)**2+sigma_odlir(k,ii)**2))
3177 c min_odl=minval(distancek)
3178 do kk=1,constr_homology
3179 if(l_homo(kk,ii)) then
3180 min_odl=distancek(kk)
3184 do kk=1,constr_homology
3185 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3186 & min_odl=distancek(kk)
3188 c write (iout,* )"min_odl",min_odl
3190 write (iout,*) "ij dij",i,j,dij
3191 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3192 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3193 write (iout,* )"min_odl",min_odl
3198 if (waga_dist.ge.0.0d0) then
3204 do k=1,constr_homology
3205 c Nie wiem po co to liczycie jeszcze raz!
3206 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3207 c & (2*(sigma_odl(i,j,k))**2))
3208 if(.not.l_homo(k,ii)) cycle
3209 if (waga_dist.ge.0.0d0) then
3211 c For Gaussian-type Urestr
3213 godl(k)=dexp(-distancek(k)+min_odl)
3214 odleg2=odleg2+godl(k)
3216 c For Lorentzian-type Urestr
3219 odleg2=odleg2+distancek(k)
3222 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3223 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3224 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3225 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3228 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3229 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3231 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3232 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3234 if (waga_dist.ge.0.0d0) then
3236 c For Gaussian-type Urestr
3238 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3240 c For Lorentzian-type Urestr
3243 odleg=odleg+odleg2/constr_homology
3247 c write (iout,*) "odleg",odleg ! sum of -ln-s
3250 c For Gaussian-type Urestr
3252 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3254 do k=1,constr_homology
3255 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3256 c & *waga_dist)+min_odl
3257 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3259 if(.not.l_homo(k,ii)) cycle
3260 if (waga_dist.ge.0.0d0) then
3261 c For Gaussian-type Urestr
3263 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3265 c For Lorentzian-type Urestr
3268 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3269 & sigma_odlir(k,ii)**2)**2)
3271 sum_sgodl=sum_sgodl+sgodl
3273 c sgodl2=sgodl2+sgodl
3274 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3275 c write(iout,*) "constr_homology=",constr_homology
3276 c write(iout,*) i, j, k, "TEST K"
3278 if (waga_dist.ge.0.0d0) then
3280 c For Gaussian-type Urestr
3282 grad_odl3=waga_homology(iset)*waga_dist
3283 & *sum_sgodl/(sum_godl*dij)
3285 c For Lorentzian-type Urestr
3288 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3289 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3290 grad_odl3=-waga_homology(iset)*waga_dist*
3291 & sum_sgodl/(constr_homology*dij)
3294 c grad_odl3=sum_sgodl/(sum_godl*dij)
3297 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3298 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3299 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3301 ccc write(iout,*) godl, sgodl, grad_odl3
3303 c grad_odl=grad_odl+grad_odl3
3306 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3307 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3308 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3309 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3310 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3311 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3312 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3313 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3314 c if (i.eq.25.and.j.eq.27) then
3315 c write(iout,*) "jik",jik,"i",i,"j",j
3316 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3317 c write(iout,*) "grad_odl3",grad_odl3
3318 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3319 c write(iout,*) "ggodl",ggodl
3320 c write(iout,*) "ghpbc(",jik,i,")",
3321 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3326 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3327 ccc & dLOG(odleg2),"-odleg=", -odleg
3329 enddo ! ii-loop for dist
3331 write(iout,*) "------- dist restrs end -------"
3332 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3333 c & waga_d.eq.1.0d0) call sum_gradient
3335 c Pseudo-energy and gradient from dihedral-angle restraints from
3336 c homology templates
3337 c write (iout,*) "End of distance loop"
3340 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3342 write(iout,*) "------- dih restrs start -------"
3343 do i=idihconstr_start_homo,idihconstr_end_homo
3344 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3347 do i=idihconstr_start_homo,idihconstr_end_homo
3353 c betai=beta(i,i+1,i+2,i+3)
3355 c write (iout,*) "betai =",betai
3356 do k=1,constr_homology
3357 dih_diff(k)=pinorm(dih(k,i)-betai)
3358 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3359 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3360 c & -(6.28318-dih_diff(i,k))
3361 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3362 c & 6.28318+dih_diff(i,k)
3364 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3366 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3368 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3371 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3374 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3375 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3377 write (iout,*) "i",i," betai",betai," kat2",kat2
3378 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3380 if (kat2.le.1.0d-14) cycle
3381 kat=kat-dLOG(kat2/constr_homology)
3382 c write (iout,*) "kat",kat ! sum of -ln-s
3384 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3385 ccc & dLOG(kat2), "-kat=", -kat
3388 c ----------------------------------------------------------------------
3390 c ----------------------------------------------------------------------
3394 do k=1,constr_homology
3396 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3398 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3400 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3401 sum_sgdih=sum_sgdih+sgdih
3403 c grad_dih3=sum_sgdih/sum_gdih
3404 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3406 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3407 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3408 ccc & gloc(nphi+i-3,icg)
3409 gloc(i,icg)=gloc(i,icg)+grad_dih3
3411 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3413 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3414 ccc & gloc(nphi+i-3,icg)
3416 enddo ! i-loop for dih
3418 write(iout,*) "------- dih restrs end -------"
3421 c Pseudo-energy and gradient for theta angle restraints from
3422 c homology templates
3423 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3427 c For constr_homology reference structures (FP)
3429 c Uconst_back_tot=0.0d0
3432 c Econstr_back legacy
3435 c do i=ithet_start,ithet_end
3438 c do i=loc_start,loc_end
3441 duscdiffx(j,i)=0.0d0
3447 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3448 c write (iout,*) "waga_theta",waga_theta
3449 if (waga_theta.gt.0.0d0) then
3451 write (iout,*) "usampl",usampl
3452 write(iout,*) "------- theta restrs start -------"
3453 c do i=ithet_start,ithet_end
3454 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3457 c write (iout,*) "maxres",maxres,"nres",nres
3459 do i=ithet_start,ithet_end
3462 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3464 c Deviation of theta angles wrt constr_homology ref structures
3466 utheta_i=0.0d0 ! argument of Gaussian for single k
3468 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3472 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3473 c over residues in a fragment
3474 c write (iout,*) "theta(",i,")=",theta(i)
3475 do k=1,constr_homology
3477 c dtheta_i=theta(j)-thetaref(j,iref)
3478 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3479 theta_diff(k)=thetatpl(k,i)-theta(i)
3481 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3482 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3483 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3484 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3485 c Gradient for single Gaussian restraint in subr Econstr_back
3486 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3489 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3490 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3494 c Gradient for multiple Gaussian restraint
3495 sum_gtheta=gutheta_i
3497 do k=1,constr_homology
3498 c New generalized expr for multiple Gaussian from Econstr_back
3499 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3501 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3502 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3505 c Final value of gradient using same var as in Econstr_back
3506 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3507 & *waga_homology(iset)
3508 c dutheta(i)=sum_sgtheta/sum_gtheta
3510 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3512 Eval=Eval-dLOG(gutheta_i/constr_homology)
3513 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3514 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3515 c Uconst_back=Uconst_back+utheta(i)
3516 enddo ! (i-loop for theta)
3518 write(iout,*) "------- theta restrs end -------"
3522 c Deviation of local SC geometry
3524 c Separation of two i-loops (instructed by AL - 11/3/2014)
3526 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3527 c write (iout,*) "waga_d",waga_d
3530 write(iout,*) "------- SC restrs start -------"
3531 write (iout,*) "Initial duscdiff,duscdiffx"
3532 do i=loc_start,loc_end
3533 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3534 & (duscdiffx(jik,i),jik=1,3)
3537 do i=loc_start,loc_end
3538 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3540 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3544 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3545 c write(iout,*) "xxtab, yytab, zztab"
3546 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3547 do k=1,constr_homology
3549 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3550 c Original sign inverted for calc of gradients (s. Econstr_back)
3551 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3552 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3553 c write(iout,*) "dxx, dyy, dzz"
3554 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3556 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3557 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3558 c uscdiffk(k)=usc_diff(i)
3559 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3560 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3561 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3562 c & xxref(j),yyref(j),zzref(j)
3567 c Generalized expression for multiple Gaussian acc to that for a single
3568 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3570 c Original implementation
3571 c sum_guscdiff=guscdiff(i)
3573 c sum_sguscdiff=0.0d0
3574 c do k=1,constr_homology
3575 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3576 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3577 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3580 c Implementation of new expressions for gradient (Jan. 2015)
3582 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3584 do k=1,constr_homology
3586 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3587 c before. Now the drivatives should be correct
3589 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3590 c Original sign inverted for calc of gradients (s. Econstr_back)
3591 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3592 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3594 c New implementation
3596 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3597 & sigma_d(k,i) ! for the grad wrt r'
3598 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3601 c New implementation
3602 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3604 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3605 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3606 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3607 duscdiff(jik,i)=duscdiff(jik,i)+
3608 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3609 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3610 duscdiffx(jik,i)=duscdiffx(jik,i)+
3611 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3612 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3615 write(iout,*) "jik",jik,"i",i
3616 write(iout,*) "dxx, dyy, dzz"
3617 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3618 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3619 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3620 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3621 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3622 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3623 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3624 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3625 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3626 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3627 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3628 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3629 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3630 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3631 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3638 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3639 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3641 c write (iout,*) i," uscdiff",uscdiff(i)
3643 c Put together deviations from local geometry
3645 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3646 c & wfrag_back(3,i,iset)*uscdiff(i)
3647 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3648 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3649 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3650 c Uconst_back=Uconst_back+usc_diff(i)
3652 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3654 c New implment: multiplied by sum_sguscdiff
3657 enddo ! (i-loop for dscdiff)
3662 write(iout,*) "------- SC restrs end -------"
3663 write (iout,*) "------ After SC loop in e_modeller ------"
3664 do i=loc_start,loc_end
3665 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3666 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3668 if (waga_theta.eq.1.0d0) then
3669 write (iout,*) "in e_modeller after SC restr end: dutheta"
3670 do i=ithet_start,ithet_end
3671 write (iout,*) i,dutheta(i)
3674 if (waga_d.eq.1.0d0) then
3675 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3677 write (iout,*) i,(duscdiff(j,i),j=1,3)
3678 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3683 c Total energy from homology restraints
3685 write (iout,*) "odleg",odleg," kat",kat
3686 write (iout,*) "odleg",odleg," kat",kat
3687 write (iout,*) "Eval",Eval," Erot",Erot
3688 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3689 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3690 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3691 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3694 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3696 c ehomology_constr=odleg+kat
3698 c For Lorentzian-type Urestr
3701 if (waga_dist.ge.0.0d0) then
3703 c For Gaussian-type Urestr
3705 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3706 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3707 c write (iout,*) "ehomology_constr=",ehomology_constr
3710 c For Lorentzian-type Urestr
3712 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3713 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3714 c write (iout,*) "ehomology_constr=",ehomology_constr
3717 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
3718 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3719 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
3720 write (iout,*) "ehomology_constr",ehomology_constr
3724 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3725 747 format(a12,i4,i4,i4,f8.3,f8.3)
3726 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3727 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3728 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3729 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3731 C--------------------------------------------------------------------------
3732 subroutine ebond(estr)
3734 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3736 implicit real*8 (a-h,o-z)
3737 include 'DIMENSIONS'
3738 include 'COMMON.LOCAL'
3739 include 'COMMON.GEO'
3740 include 'COMMON.INTERACT'
3741 include 'COMMON.DERIV'
3742 include 'COMMON.VAR'
3743 include 'COMMON.CHAIN'
3744 include 'COMMON.IOUNITS'
3745 include 'COMMON.NAMES'
3746 include 'COMMON.FFIELD'
3747 include 'COMMON.CONTROL'
3748 double precision u(3),ud(3)
3751 diff = vbld(i)-vbldp0
3752 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3755 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3760 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3767 diff=vbld(i+nres)-vbldsc0(1,iti)
3768 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3769 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3770 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3772 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3776 diff=vbld(i+nres)-vbldsc0(j,iti)
3777 ud(j)=aksc(j,iti)*diff
3778 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3792 uprod2=uprod2*u(k)*u(k)
3796 usumsqder=usumsqder+ud(j)*uprod2
3798 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3799 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3800 estr=estr+uprod/usum
3802 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3810 C--------------------------------------------------------------------------
3811 subroutine ebend(etheta)
3813 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3814 C angles gamma and its derivatives in consecutive thetas and gammas.
3816 implicit real*8 (a-h,o-z)
3817 include 'DIMENSIONS'
3818 include 'sizesclu.dat'
3819 include 'COMMON.LOCAL'
3820 include 'COMMON.GEO'
3821 include 'COMMON.INTERACT'
3822 include 'COMMON.DERIV'
3823 include 'COMMON.VAR'
3824 include 'COMMON.CHAIN'
3825 include 'COMMON.IOUNITS'
3826 include 'COMMON.NAMES'
3827 include 'COMMON.FFIELD'
3828 common /calcthet/ term1,term2,termm,diffak,ratak,
3829 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3830 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3831 double precision y(2),z(2)
3833 time11=dexp(-2*time)
3836 c write (iout,*) "nres",nres
3837 c write (*,'(a,i2)') 'EBEND ICG=',icg
3838 c write (iout,*) ithet_start,ithet_end
3839 do i=ithet_start,ithet_end
3840 C Zero the energy function and its derivative at 0 or pi.
3841 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3843 c if (i.gt.ithet_start .and.
3844 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3845 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3853 c if (i.lt.nres .and. itel(i).ne.0) then
3865 call proc_proc(phii,icrc)
3866 if (icrc.eq.1) phii=150.0
3880 call proc_proc(phii1,icrc)
3881 if (icrc.eq.1) phii1=150.0
3893 C Calculate the "mean" value of theta from the part of the distribution
3894 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3895 C In following comments this theta will be referred to as t_c.
3896 thet_pred_mean=0.0d0
3900 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3902 c write (iout,*) "thet_pred_mean",thet_pred_mean
3903 dthett=thet_pred_mean*ssd
3904 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3905 c write (iout,*) "thet_pred_mean",thet_pred_mean
3906 C Derivatives of the "mean" values in gamma1 and gamma2.
3907 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3908 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3909 if (theta(i).gt.pi-delta) then
3910 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3912 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3913 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3914 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3916 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3918 else if (theta(i).lt.delta) then
3919 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3920 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3921 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3923 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3924 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3927 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3930 etheta=etheta+ethetai
3931 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3932 c & rad2deg*phii,rad2deg*phii1,ethetai
3933 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3934 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3935 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3938 C Ufff.... We've done all this!!!
3941 C---------------------------------------------------------------------------
3942 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3944 implicit real*8 (a-h,o-z)
3945 include 'DIMENSIONS'
3946 include 'COMMON.LOCAL'
3947 include 'COMMON.IOUNITS'
3948 common /calcthet/ term1,term2,termm,diffak,ratak,
3949 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3950 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3951 C Calculate the contributions to both Gaussian lobes.
3952 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3953 C The "polynomial part" of the "standard deviation" of this part of
3957 sig=sig*thet_pred_mean+polthet(j,it)
3959 C Derivative of the "interior part" of the "standard deviation of the"
3960 C gamma-dependent Gaussian lobe in t_c.
3961 sigtc=3*polthet(3,it)
3963 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3966 C Set the parameters of both Gaussian lobes of the distribution.
3967 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3968 fac=sig*sig+sigc0(it)
3971 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3972 sigsqtc=-4.0D0*sigcsq*sigtc
3973 c print *,i,sig,sigtc,sigsqtc
3974 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3975 sigtc=-sigtc/(fac*fac)
3976 C Following variable is sigma(t_c)**(-2)
3977 sigcsq=sigcsq*sigcsq
3979 sig0inv=1.0D0/sig0i**2
3980 delthec=thetai-thet_pred_mean
3981 delthe0=thetai-theta0i
3982 term1=-0.5D0*sigcsq*delthec*delthec
3983 term2=-0.5D0*sig0inv*delthe0*delthe0
3984 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3985 C NaNs in taking the logarithm. We extract the largest exponent which is added
3986 C to the energy (this being the log of the distribution) at the end of energy
3987 C term evaluation for this virtual-bond angle.
3988 if (term1.gt.term2) then
3990 term2=dexp(term2-termm)
3994 term1=dexp(term1-termm)
3997 C The ratio between the gamma-independent and gamma-dependent lobes of
3998 C the distribution is a Gaussian function of thet_pred_mean too.
3999 diffak=gthet(2,it)-thet_pred_mean
4000 ratak=diffak/gthet(3,it)**2
4001 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4002 C Let's differentiate it in thet_pred_mean NOW.
4004 C Now put together the distribution terms to make complete distribution.
4005 termexp=term1+ak*term2
4006 termpre=sigc+ak*sig0i
4007 C Contribution of the bending energy from this theta is just the -log of
4008 C the sum of the contributions from the two lobes and the pre-exponential
4009 C factor. Simple enough, isn't it?
4010 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4011 C NOW the derivatives!!!
4012 C 6/6/97 Take into account the deformation.
4013 E_theta=(delthec*sigcsq*term1
4014 & +ak*delthe0*sig0inv*term2)/termexp
4015 E_tc=((sigtc+aktc*sig0i)/termpre
4016 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4017 & aktc*term2)/termexp)
4020 c-----------------------------------------------------------------------------
4021 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4022 implicit real*8 (a-h,o-z)
4023 include 'DIMENSIONS'
4024 include 'COMMON.LOCAL'
4025 include 'COMMON.IOUNITS'
4026 common /calcthet/ term1,term2,termm,diffak,ratak,
4027 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4028 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4029 delthec=thetai-thet_pred_mean
4030 delthe0=thetai-theta0i
4031 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4032 t3 = thetai-thet_pred_mean
4036 t14 = t12+t6*sigsqtc
4038 t21 = thetai-theta0i
4044 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4045 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4046 & *(-t12*t9-ak*sig0inv*t27)
4050 C--------------------------------------------------------------------------
4051 subroutine ebend(etheta)
4053 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4054 C angles gamma and its derivatives in consecutive thetas and gammas.
4055 C ab initio-derived potentials from
4056 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4058 implicit real*8 (a-h,o-z)
4059 include 'DIMENSIONS'
4060 include 'COMMON.LOCAL'
4061 include 'COMMON.GEO'
4062 include 'COMMON.INTERACT'
4063 include 'COMMON.DERIV'
4064 include 'COMMON.VAR'
4065 include 'COMMON.CHAIN'
4066 include 'COMMON.IOUNITS'
4067 include 'COMMON.NAMES'
4068 include 'COMMON.FFIELD'
4069 include 'COMMON.CONTROL'
4070 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4071 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4072 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4073 & sinph1ph2(maxdouble,maxdouble)
4074 logical lprn /.false./, lprn1 /.false./
4076 do i=ithet_start,ithet_end
4077 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4078 & (itype(i).eq.ntyp1)) cycle
4082 theti2=0.5d0*theta(i)
4083 ityp2=ithetyp(itype(i-1))
4085 coskt(k)=dcos(k*theti2)
4086 sinkt(k)=dsin(k*theti2)
4088 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4091 if (phii.ne.phii) phii=150.0
4095 ityp1=ithetyp(itype(i-2))
4097 cosph1(k)=dcos(k*phii)
4098 sinph1(k)=dsin(k*phii)
4102 ityp1=ithetyp(itype(i-2))
4108 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4111 if (phii1.ne.phii1) phii1=150.0
4116 ityp3=ithetyp(itype(i))
4118 cosph2(k)=dcos(k*phii1)
4119 sinph2(k)=dsin(k*phii1)
4123 ityp3=ithetyp(itype(i))
4129 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4130 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4132 ethetai=aa0thet(ityp1,ityp2,ityp3)
4135 ccl=cosph1(l)*cosph2(k-l)
4136 ssl=sinph1(l)*sinph2(k-l)
4137 scl=sinph1(l)*cosph2(k-l)
4138 csl=cosph1(l)*sinph2(k-l)
4139 cosph1ph2(l,k)=ccl-ssl
4140 cosph1ph2(k,l)=ccl+ssl
4141 sinph1ph2(l,k)=scl+csl
4142 sinph1ph2(k,l)=scl-csl
4146 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4147 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4148 write (iout,*) "coskt and sinkt"
4150 write (iout,*) k,coskt(k),sinkt(k)
4154 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4155 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4158 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4159 & " ethetai",ethetai
4162 write (iout,*) "cosph and sinph"
4164 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4166 write (iout,*) "cosph1ph2 and sinph2ph2"
4169 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4170 & sinph1ph2(l,k),sinph1ph2(k,l)
4173 write(iout,*) "ethetai",ethetai
4177 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4178 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4179 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4180 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4181 ethetai=ethetai+sinkt(m)*aux
4182 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4183 dephii=dephii+k*sinkt(m)*(
4184 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4185 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4186 dephii1=dephii1+k*sinkt(m)*(
4187 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4188 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4190 & write (iout,*) "m",m," k",k," bbthet",
4191 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4192 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4193 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4194 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4198 & write(iout,*) "ethetai",ethetai
4202 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4203 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4204 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4205 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4206 ethetai=ethetai+sinkt(m)*aux
4207 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4208 dephii=dephii+l*sinkt(m)*(
4209 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4210 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4211 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4212 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4213 dephii1=dephii1+(k-l)*sinkt(m)*(
4214 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4215 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4216 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4217 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4219 write (iout,*) "m",m," k",k," l",l," ffthet",
4220 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4221 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4222 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4223 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4224 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4225 & cosph1ph2(k,l)*sinkt(m),
4226 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4233 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4234 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4235 & phii1*rad2deg,ethetai
4237 etheta=etheta+ethetai
4239 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4240 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4241 gloc(nphi+i-2,icg)=wang*dethetai
4247 c-----------------------------------------------------------------------------
4248 subroutine esc(escloc)
4249 C Calculate the local energy of a side chain and its derivatives in the
4250 C corresponding virtual-bond valence angles THETA and the spherical angles
4252 implicit real*8 (a-h,o-z)
4253 include 'DIMENSIONS'
4254 include 'sizesclu.dat'
4255 include 'COMMON.GEO'
4256 include 'COMMON.LOCAL'
4257 include 'COMMON.VAR'
4258 include 'COMMON.INTERACT'
4259 include 'COMMON.DERIV'
4260 include 'COMMON.CHAIN'
4261 include 'COMMON.IOUNITS'
4262 include 'COMMON.NAMES'
4263 include 'COMMON.FFIELD'
4264 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4265 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4266 common /sccalc/ time11,time12,time112,theti,it,nlobit
4269 c write (iout,'(a)') 'ESC'
4270 do i=loc_start,loc_end
4272 if (it.eq.10) goto 1
4274 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4275 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4276 theti=theta(i+1)-pipol
4280 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4282 if (x(2).gt.pi-delta) then
4286 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4288 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4289 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4291 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4292 & ddersc0(1),dersc(1))
4293 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4294 & ddersc0(3),dersc(3))
4296 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4298 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4299 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4300 & dersc0(2),esclocbi,dersc02)
4301 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4303 call splinthet(x(2),0.5d0*delta,ss,ssd)
4308 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4310 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4311 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4313 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4315 c write (iout,*) escloci
4316 else if (x(2).lt.delta) then
4320 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4322 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4323 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4325 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4326 & ddersc0(1),dersc(1))
4327 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4328 & ddersc0(3),dersc(3))
4330 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4332 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4333 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4334 & dersc0(2),esclocbi,dersc02)
4335 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4340 call splinthet(x(2),0.5d0*delta,ss,ssd)
4342 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4344 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4345 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4347 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4348 c write (iout,*) escloci
4350 call enesc(x,escloci,dersc,ddummy,.false.)
4353 escloc=escloc+escloci
4354 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4356 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4358 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4359 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4364 C---------------------------------------------------------------------------
4365 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4366 implicit real*8 (a-h,o-z)
4367 include 'DIMENSIONS'
4368 include 'COMMON.GEO'
4369 include 'COMMON.LOCAL'
4370 include 'COMMON.IOUNITS'
4371 common /sccalc/ time11,time12,time112,theti,it,nlobit
4372 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4373 double precision contr(maxlob,-1:1)
4375 c write (iout,*) 'it=',it,' nlobit=',nlobit
4379 if (mixed) ddersc(j)=0.0d0
4383 C Because of periodicity of the dependence of the SC energy in omega we have
4384 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4385 C To avoid underflows, first compute & store the exponents.
4393 z(k)=x(k)-censc(k,j,it)
4398 Axk=Axk+gaussc(l,k,j,it)*z(l)
4404 expfac=expfac+Ax(k,j,iii)*z(k)
4412 C As in the case of ebend, we want to avoid underflows in exponentiation and
4413 C subsequent NaNs and INFs in energy calculation.
4414 C Find the largest exponent
4418 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4422 cd print *,'it=',it,' emin=',emin
4424 C Compute the contribution to SC energy and derivatives
4428 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4429 cd print *,'j=',j,' expfac=',expfac
4430 escloc_i=escloc_i+expfac
4432 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4436 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4437 & +gaussc(k,2,j,it))*expfac
4444 dersc(1)=dersc(1)/cos(theti)**2
4445 ddersc(1)=ddersc(1)/cos(theti)**2
4448 escloci=-(dlog(escloc_i)-emin)
4450 dersc(j)=dersc(j)/escloc_i
4454 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4459 C------------------------------------------------------------------------------
4460 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4461 implicit real*8 (a-h,o-z)
4462 include 'DIMENSIONS'
4463 include 'COMMON.GEO'
4464 include 'COMMON.LOCAL'
4465 include 'COMMON.IOUNITS'
4466 common /sccalc/ time11,time12,time112,theti,it,nlobit
4467 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4468 double precision contr(maxlob)
4479 z(k)=x(k)-censc(k,j,it)
4485 Axk=Axk+gaussc(l,k,j,it)*z(l)
4491 expfac=expfac+Ax(k,j)*z(k)
4496 C As in the case of ebend, we want to avoid underflows in exponentiation and
4497 C subsequent NaNs and INFs in energy calculation.
4498 C Find the largest exponent
4501 if (emin.gt.contr(j)) emin=contr(j)
4505 C Compute the contribution to SC energy and derivatives
4509 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4510 escloc_i=escloc_i+expfac
4512 dersc(k)=dersc(k)+Ax(k,j)*expfac
4514 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4515 & +gaussc(1,2,j,it))*expfac
4519 dersc(1)=dersc(1)/cos(theti)**2
4520 dersc12=dersc12/cos(theti)**2
4521 escloci=-(dlog(escloc_i)-emin)
4523 dersc(j)=dersc(j)/escloc_i
4525 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4529 c----------------------------------------------------------------------------------
4530 subroutine esc(escloc)
4531 C Calculate the local energy of a side chain and its derivatives in the
4532 C corresponding virtual-bond valence angles THETA and the spherical angles
4533 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4534 C added by Urszula Kozlowska. 07/11/2007
4536 implicit real*8 (a-h,o-z)
4537 include 'DIMENSIONS'
4538 include 'COMMON.GEO'
4539 include 'COMMON.LOCAL'
4540 include 'COMMON.VAR'
4541 include 'COMMON.SCROT'
4542 include 'COMMON.INTERACT'
4543 include 'COMMON.DERIV'
4544 include 'COMMON.CHAIN'
4545 include 'COMMON.IOUNITS'
4546 include 'COMMON.NAMES'
4547 include 'COMMON.FFIELD'
4548 include 'COMMON.CONTROL'
4549 include 'COMMON.VECTORS'
4550 double precision x_prime(3),y_prime(3),z_prime(3)
4551 & , sumene,dsc_i,dp2_i,x(65),
4552 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4553 & de_dxx,de_dyy,de_dzz,de_dt
4554 double precision s1_t,s1_6_t,s2_t,s2_6_t
4556 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4557 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4558 & dt_dCi(3),dt_dCi1(3)
4559 common /sccalc/ time11,time12,time112,theti,it,nlobit
4562 do i=loc_start,loc_end
4563 costtab(i+1) =dcos(theta(i+1))
4564 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4565 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4566 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4567 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4568 cosfac=dsqrt(cosfac2)
4569 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4570 sinfac=dsqrt(sinfac2)
4572 if (it.eq.10) goto 1
4574 C Compute the axes of tghe local cartesian coordinates system; store in
4575 c x_prime, y_prime and z_prime
4582 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4583 C & dc_norm(3,i+nres)
4585 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4586 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4589 z_prime(j) = -uz(j,i-1)
4592 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4593 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4594 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4595 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4596 c & " xy",scalar(x_prime(1),y_prime(1)),
4597 c & " xz",scalar(x_prime(1),z_prime(1)),
4598 c & " yy",scalar(y_prime(1),y_prime(1)),
4599 c & " yz",scalar(y_prime(1),z_prime(1)),
4600 c & " zz",scalar(z_prime(1),z_prime(1))
4602 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4603 C to local coordinate system. Store in xx, yy, zz.
4609 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4610 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4611 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4618 C Compute the energy of the ith side cbain
4620 c write (2,*) "xx",xx," yy",yy," zz",zz
4623 x(j) = sc_parmin(j,it)
4626 Cc diagnostics - remove later
4628 yy1 = dsin(alph(2))*dcos(omeg(2))
4629 zz1 = -dsin(alph(2))*dsin(omeg(2))
4630 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4631 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4633 C," --- ", xx_w,yy_w,zz_w
4636 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4637 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4639 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4640 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4642 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4643 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4644 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4645 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4646 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4648 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4649 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4650 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4651 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4652 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4654 dsc_i = 0.743d0+x(61)
4656 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4657 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4658 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4659 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4660 s1=(1+x(63))/(0.1d0 + dscp1)
4661 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4662 s2=(1+x(65))/(0.1d0 + dscp2)
4663 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4664 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4665 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4666 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4668 c & dscp1,dscp2,sumene
4669 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4670 escloc = escloc + sumene
4671 c write (2,*) "escloc",escloc
4672 if (.not. calc_grad) goto 1
4675 C This section to check the numerical derivatives of the energy of ith side
4676 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4677 C #define DEBUG in the code to turn it on.
4679 write (2,*) "sumene =",sumene
4683 write (2,*) xx,yy,zz
4684 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4685 de_dxx_num=(sumenep-sumene)/aincr
4687 write (2,*) "xx+ sumene from enesc=",sumenep
4690 write (2,*) xx,yy,zz
4691 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4692 de_dyy_num=(sumenep-sumene)/aincr
4694 write (2,*) "yy+ sumene from enesc=",sumenep
4697 write (2,*) xx,yy,zz
4698 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4699 de_dzz_num=(sumenep-sumene)/aincr
4701 write (2,*) "zz+ sumene from enesc=",sumenep
4702 costsave=cost2tab(i+1)
4703 sintsave=sint2tab(i+1)
4704 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4705 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4706 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4707 de_dt_num=(sumenep-sumene)/aincr
4708 write (2,*) " t+ sumene from enesc=",sumenep
4709 cost2tab(i+1)=costsave
4710 sint2tab(i+1)=sintsave
4711 C End of diagnostics section.
4714 C Compute the gradient of esc
4716 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4717 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4718 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4719 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4720 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4721 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4722 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4723 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4724 pom1=(sumene3*sint2tab(i+1)+sumene1)
4725 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4726 pom2=(sumene4*cost2tab(i+1)+sumene2)
4727 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4728 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4729 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4730 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4732 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4733 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4734 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4736 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4737 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4738 & +(pom1+pom2)*pom_dx
4740 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4743 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4744 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4745 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4747 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4748 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4749 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4750 & +x(59)*zz**2 +x(60)*xx*zz
4751 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4752 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4753 & +(pom1-pom2)*pom_dy
4755 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4758 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4759 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4760 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4761 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4762 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4763 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4764 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4765 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4767 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4770 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4771 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4772 & +pom1*pom_dt1+pom2*pom_dt2
4774 write(2,*), "de_dt = ", de_dt,de_dt_num
4778 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4779 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4780 cosfac2xx=cosfac2*xx
4781 sinfac2yy=sinfac2*yy
4783 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4785 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4787 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4788 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4789 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4790 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4791 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4792 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4793 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4794 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4795 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4796 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4800 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4801 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4804 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4805 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4806 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4808 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4809 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4813 dXX_Ctab(k,i)=dXX_Ci(k)
4814 dXX_C1tab(k,i)=dXX_Ci1(k)
4815 dYY_Ctab(k,i)=dYY_Ci(k)
4816 dYY_C1tab(k,i)=dYY_Ci1(k)
4817 dZZ_Ctab(k,i)=dZZ_Ci(k)
4818 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4819 dXX_XYZtab(k,i)=dXX_XYZ(k)
4820 dYY_XYZtab(k,i)=dYY_XYZ(k)
4821 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4825 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4826 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4827 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4828 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4829 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4831 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4832 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4833 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4834 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4835 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4836 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4837 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4838 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4840 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4841 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4843 C to check gradient call subroutine check_grad
4850 c------------------------------------------------------------------------------
4851 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4853 C This procedure calculates two-body contact function g(rij) and its derivative:
4856 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4859 C where x=(rij-r0ij)/delta
4861 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4864 double precision rij,r0ij,eps0ij,fcont,fprimcont
4865 double precision x,x2,x4,delta
4869 if (x.lt.-1.0D0) then
4872 else if (x.le.1.0D0) then
4875 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4876 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4883 c------------------------------------------------------------------------------
4884 subroutine splinthet(theti,delta,ss,ssder)
4885 implicit real*8 (a-h,o-z)
4886 include 'DIMENSIONS'
4887 include 'sizesclu.dat'
4888 include 'COMMON.VAR'
4889 include 'COMMON.GEO'
4892 if (theti.gt.pipol) then
4893 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4895 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4900 c------------------------------------------------------------------------------
4901 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4903 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4904 double precision ksi,ksi2,ksi3,a1,a2,a3
4905 a1=fprim0*delta/(f1-f0)
4911 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4912 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4915 c------------------------------------------------------------------------------
4916 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4918 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4919 double precision ksi,ksi2,ksi3,a1,a2,a3
4924 a2=3*(f1x-f0x)-2*fprim0x*delta
4925 a3=fprim0x*delta-2*(f1x-f0x)
4926 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4929 C-----------------------------------------------------------------------------
4931 C-----------------------------------------------------------------------------
4932 subroutine etor(etors,edihcnstr,fact)
4933 implicit real*8 (a-h,o-z)
4934 include 'DIMENSIONS'
4935 include 'sizesclu.dat'
4936 include 'COMMON.VAR'
4937 include 'COMMON.GEO'
4938 include 'COMMON.LOCAL'
4939 include 'COMMON.TORSION'
4940 include 'COMMON.INTERACT'
4941 include 'COMMON.DERIV'
4942 include 'COMMON.CHAIN'
4943 include 'COMMON.NAMES'
4944 include 'COMMON.IOUNITS'
4945 include 'COMMON.FFIELD'
4946 include 'COMMON.TORCNSTR'
4948 C Set lprn=.true. for debugging
4952 do i=iphi_start,iphi_end
4953 itori=itortyp(itype(i-2))
4954 itori1=itortyp(itype(i-1))
4957 C Proline-Proline pair is a special case...
4958 if (itori.eq.3 .and. itori1.eq.3) then
4959 if (phii.gt.-dwapi3) then
4961 fac=1.0D0/(1.0D0-cosphi)
4962 etorsi=v1(1,3,3)*fac
4963 etorsi=etorsi+etorsi
4964 etors=etors+etorsi-v1(1,3,3)
4965 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4968 v1ij=v1(j+1,itori,itori1)
4969 v2ij=v2(j+1,itori,itori1)
4972 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4973 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4977 v1ij=v1(j,itori,itori1)
4978 v2ij=v2(j,itori,itori1)
4981 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4982 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4986 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4987 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4988 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4989 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4990 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4992 ! 6/20/98 - dihedral angle constraints
4995 itori=idih_constr(i)
4997 difi=pinorm(phii-phi0(i))
4998 if (difi.gt.drange(i)) then
5000 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5001 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5002 else if (difi.lt.-drange(i)) then
5004 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5005 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5007 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5008 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5010 write (iout,*) 'edihcnstr',edihcnstr
5013 c------------------------------------------------------------------------------
5015 subroutine etor(etors,edihcnstr,fact)
5016 implicit real*8 (a-h,o-z)
5017 include 'DIMENSIONS'
5018 include 'sizesclu.dat'
5019 include 'COMMON.VAR'
5020 include 'COMMON.GEO'
5021 include 'COMMON.LOCAL'
5022 include 'COMMON.TORSION'
5023 include 'COMMON.INTERACT'
5024 include 'COMMON.DERIV'
5025 include 'COMMON.CHAIN'
5026 include 'COMMON.NAMES'
5027 include 'COMMON.IOUNITS'
5028 include 'COMMON.FFIELD'
5029 include 'COMMON.TORCNSTR'
5031 C Set lprn=.true. for debugging
5035 do i=iphi_start,iphi_end
5036 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5037 itori=itortyp(itype(i-2))
5038 itori1=itortyp(itype(i-1))
5041 C Regular cosine and sine terms
5042 do j=1,nterm(itori,itori1)
5043 v1ij=v1(j,itori,itori1)
5044 v2ij=v2(j,itori,itori1)
5047 etors=etors+v1ij*cosphi+v2ij*sinphi
5048 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5052 C E = SUM ----------------------------------- - v1
5053 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5055 cosphi=dcos(0.5d0*phii)
5056 sinphi=dsin(0.5d0*phii)
5057 do j=1,nlor(itori,itori1)
5058 vl1ij=vlor1(j,itori,itori1)
5059 vl2ij=vlor2(j,itori,itori1)
5060 vl3ij=vlor3(j,itori,itori1)
5061 pom=vl2ij*cosphi+vl3ij*sinphi
5062 pom1=1.0d0/(pom*pom+1.0d0)
5063 etors=etors+vl1ij*pom1
5065 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5067 C Subtract the constant term
5068 etors=etors-v0(itori,itori1)
5070 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5071 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5072 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5073 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5074 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5077 ! 6/20/98 - dihedral angle constraints
5079 c write (iout,*) "Dihedral angle restraint energy"
5081 itori=idih_constr(i)
5083 difi=pinorm(phii-phi0(i))
5084 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5085 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
5086 if (difi.gt.drange(i)) then
5088 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5089 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5090 c write (iout,*) 0.25d0*ftors*difi**4
5091 else if (difi.lt.-drange(i)) then
5093 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5094 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5095 c write (iout,*) 0.25d0*ftors*difi**4
5098 c write (iout,*) 'edihcnstr',edihcnstr
5101 c----------------------------------------------------------------------------
5102 subroutine etor_d(etors_d,fact2)
5103 C 6/23/01 Compute double torsional energy
5104 implicit real*8 (a-h,o-z)
5105 include 'DIMENSIONS'
5106 include 'sizesclu.dat'
5107 include 'COMMON.VAR'
5108 include 'COMMON.GEO'
5109 include 'COMMON.LOCAL'
5110 include 'COMMON.TORSION'
5111 include 'COMMON.INTERACT'
5112 include 'COMMON.DERIV'
5113 include 'COMMON.CHAIN'
5114 include 'COMMON.NAMES'
5115 include 'COMMON.IOUNITS'
5116 include 'COMMON.FFIELD'
5117 include 'COMMON.TORCNSTR'
5119 C Set lprn=.true. for debugging
5123 do i=iphi_start,iphi_end-1
5124 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5126 itori=itortyp(itype(i-2))
5127 itori1=itortyp(itype(i-1))
5128 itori2=itortyp(itype(i))
5133 C Regular cosine and sine terms
5134 do j=1,ntermd_1(itori,itori1,itori2)
5135 v1cij=v1c(1,j,itori,itori1,itori2)
5136 v1sij=v1s(1,j,itori,itori1,itori2)
5137 v2cij=v1c(2,j,itori,itori1,itori2)
5138 v2sij=v1s(2,j,itori,itori1,itori2)
5139 cosphi1=dcos(j*phii)
5140 sinphi1=dsin(j*phii)
5141 cosphi2=dcos(j*phii1)
5142 sinphi2=dsin(j*phii1)
5143 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5144 & v2cij*cosphi2+v2sij*sinphi2
5145 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5146 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5148 do k=2,ntermd_2(itori,itori1,itori2)
5150 v1cdij = v2c(k,l,itori,itori1,itori2)
5151 v2cdij = v2c(l,k,itori,itori1,itori2)
5152 v1sdij = v2s(k,l,itori,itori1,itori2)
5153 v2sdij = v2s(l,k,itori,itori1,itori2)
5154 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5155 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5156 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5157 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5158 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5159 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5160 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5161 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5162 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5163 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5166 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5167 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5173 c------------------------------------------------------------------------------
5174 subroutine eback_sc_corr(esccor,fact)
5175 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5176 c conformational states; temporarily implemented as differences
5177 c between UNRES torsional potentials (dependent on three types of
5178 c residues) and the torsional potentials dependent on all 20 types
5179 c of residues computed from AM1 energy surfaces of terminally-blocked
5180 c amino-acid residues.
5181 implicit real*8 (a-h,o-z)
5182 include 'DIMENSIONS'
5183 include 'COMMON.VAR'
5184 include 'COMMON.GEO'
5185 include 'COMMON.LOCAL'
5186 include 'COMMON.TORSION'
5187 include 'COMMON.SCCOR'
5188 include 'COMMON.INTERACT'
5189 include 'COMMON.DERIV'
5190 include 'COMMON.CHAIN'
5191 include 'COMMON.NAMES'
5192 include 'COMMON.IOUNITS'
5193 include 'COMMON.FFIELD'
5194 include 'COMMON.CONTROL'
5196 C Set lprn=.true. for debugging
5199 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5201 do i=itau_start,itau_end
5203 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5204 isccori=isccortyp(itype(i-2))
5205 isccori1=isccortyp(itype(i-1))
5207 cccc Added 9 May 2012
5208 cc Tauangle is torsional engle depending on the value of first digit
5209 c(see comment below)
5210 cc Omicron is flat angle depending on the value of first digit
5211 c(see comment below)
5214 do intertyp=1,3 !intertyp
5215 cc Added 09 May 2012 (Adasko)
5216 cc Intertyp means interaction type of backbone mainchain correlation:
5217 c 1 = SC...Ca...Ca...Ca
5218 c 2 = Ca...Ca...Ca...SC
5219 c 3 = SC...Ca...Ca...SCi
5221 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5222 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5223 & (itype(i-1).eq.21)))
5224 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5225 & .or.(itype(i-2).eq.21)))
5226 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5227 & (itype(i-1).eq.21)))) cycle
5228 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5229 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5231 do j=1,nterm_sccor(isccori,isccori1)
5232 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5233 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5234 cosphi=dcos(j*tauangle(intertyp,i))
5235 sinphi=dsin(j*tauangle(intertyp,i))
5236 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5238 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5240 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5242 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5243 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5244 c &gloc_sc(intertyp,i-3,icg)
5246 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5247 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5248 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5249 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5250 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5253 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5259 c------------------------------------------------------------------------------
5260 subroutine multibody(ecorr)
5261 C This subroutine calculates multi-body contributions to energy following
5262 C the idea of Skolnick et al. If side chains I and J make a contact and
5263 C at the same time side chains I+1 and J+1 make a contact, an extra
5264 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
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)
5274 C Set lprn=.true. for debugging
5278 write (iout,'(a)') 'Contact function values:'
5280 write (iout,'(i2,20(1x,i2,f10.5))')
5281 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5296 num_conti=num_cont(i)
5297 num_conti1=num_cont(i1)
5302 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5303 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5304 cd & ' ishift=',ishift
5305 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5306 C The system gains extra energy.
5307 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5308 endif ! j1==j+-ishift
5317 c------------------------------------------------------------------------------
5318 double precision function esccorr(i,j,k,l,jj,kk)
5319 implicit real*8 (a-h,o-z)
5320 include 'DIMENSIONS'
5321 include 'COMMON.IOUNITS'
5322 include 'COMMON.DERIV'
5323 include 'COMMON.INTERACT'
5324 include 'COMMON.CONTACTS'
5325 double precision gx(3),gx1(3)
5330 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5331 C Calculate the multi-body contribution to energy.
5332 C Calculate multi-body contributions to the gradient.
5333 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5334 cd & k,l,(gacont(m,kk,k),m=1,3)
5336 gx(m) =ekl*gacont(m,jj,i)
5337 gx1(m)=eij*gacont(m,kk,k)
5338 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5339 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5340 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5341 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5345 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5350 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5356 c------------------------------------------------------------------------------
5358 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 integer dimen1,dimen2,atom,indx
5362 double precision buffer(dimen1,dimen2)
5363 double precision zapas
5364 common /contacts_hb/ zapas(3,20,maxres,7),
5365 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5366 & num_cont_hb(maxres),jcont_hb(20,maxres)
5367 num_kont=num_cont_hb(atom)
5371 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5374 buffer(i,indx+22)=facont_hb(i,atom)
5375 buffer(i,indx+23)=ees0p(i,atom)
5376 buffer(i,indx+24)=ees0m(i,atom)
5377 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5379 buffer(1,indx+26)=dfloat(num_kont)
5382 c------------------------------------------------------------------------------
5383 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5384 implicit real*8 (a-h,o-z)
5385 include 'DIMENSIONS'
5386 integer dimen1,dimen2,atom,indx
5387 double precision buffer(dimen1,dimen2)
5388 double precision zapas
5389 common /contacts_hb/ zapas(3,20,maxres,7),
5390 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5391 & num_cont_hb(maxres),jcont_hb(20,maxres)
5392 num_kont=buffer(1,indx+26)
5393 num_kont_old=num_cont_hb(atom)
5394 num_cont_hb(atom)=num_kont+num_kont_old
5399 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5402 facont_hb(ii,atom)=buffer(i,indx+22)
5403 ees0p(ii,atom)=buffer(i,indx+23)
5404 ees0m(ii,atom)=buffer(i,indx+24)
5405 jcont_hb(ii,atom)=buffer(i,indx+25)
5409 c------------------------------------------------------------------------------
5411 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5412 C This subroutine calculates multi-body contributions to hydrogen-bonding
5413 implicit real*8 (a-h,o-z)
5414 include 'DIMENSIONS'
5415 include 'sizesclu.dat'
5416 include 'COMMON.IOUNITS'
5418 include 'COMMON.INFO'
5420 include 'COMMON.FFIELD'
5421 include 'COMMON.DERIV'
5422 include 'COMMON.INTERACT'
5423 include 'COMMON.CONTACTS'
5425 parameter (max_cont=maxconts)
5426 parameter (max_dim=2*(8*3+2))
5427 parameter (msglen1=max_cont*max_dim*4)
5428 parameter (msglen2=2*msglen1)
5429 integer source,CorrelType,CorrelID,Error
5430 double precision buffer(max_cont,max_dim)
5432 double precision gx(3),gx1(3)
5435 C Set lprn=.true. for debugging
5440 if (fgProcs.le.1) goto 30
5442 write (iout,'(a)') 'Contact function values:'
5444 write (iout,'(2i3,50(1x,i2,f5.2))')
5445 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5446 & j=1,num_cont_hb(i))
5449 C Caution! Following code assumes that electrostatic interactions concerning
5450 C a given atom are split among at most two processors!
5460 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5463 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5464 if (MyRank.gt.0) then
5465 C Send correlation contributions to the preceding processor
5467 nn=num_cont_hb(iatel_s)
5468 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5469 cd write (iout,*) 'The BUFFER array:'
5471 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5473 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5475 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5476 C Clear the contacts of the atom passed to the neighboring processor
5477 nn=num_cont_hb(iatel_s+1)
5479 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5481 num_cont_hb(iatel_s)=0
5483 cd write (iout,*) 'Processor ',MyID,MyRank,
5484 cd & ' is sending correlation contribution to processor',MyID-1,
5485 cd & ' msglen=',msglen
5486 cd write (*,*) 'Processor ',MyID,MyRank,
5487 cd & ' is sending correlation contribution to processor',MyID-1,
5488 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5489 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5490 cd write (iout,*) 'Processor ',MyID,
5491 cd & ' has sent correlation contribution to processor',MyID-1,
5492 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5493 cd write (*,*) 'Processor ',MyID,
5494 cd & ' has sent correlation contribution to processor',MyID-1,
5495 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5497 endif ! (MyRank.gt.0)
5501 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5502 if (MyRank.lt.fgProcs-1) then
5503 C Receive correlation contributions from the next processor
5505 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5506 cd write (iout,*) 'Processor',MyID,
5507 cd & ' is receiving correlation contribution from processor',MyID+1,
5508 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5509 cd write (*,*) 'Processor',MyID,
5510 cd & ' is receiving correlation contribution from processor',MyID+1,
5511 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5513 do while (nbytes.le.0)
5514 call mp_probe(MyID+1,CorrelType,nbytes)
5516 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5517 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5518 cd write (iout,*) 'Processor',MyID,
5519 cd & ' has received correlation contribution from processor',MyID+1,
5520 cd & ' msglen=',msglen,' nbytes=',nbytes
5521 cd write (iout,*) 'The received BUFFER array:'
5523 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5525 if (msglen.eq.msglen1) then
5526 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5527 else if (msglen.eq.msglen2) then
5528 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5529 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5532 & 'ERROR!!!! message length changed while processing correlations.'
5534 & 'ERROR!!!! message length changed while processing correlations.'
5535 call mp_stopall(Error)
5536 endif ! msglen.eq.msglen1
5537 endif ! MyRank.lt.fgProcs-1
5544 write (iout,'(a)') 'Contact function values:'
5546 write (iout,'(2i3,50(1x,i2,f5.2))')
5547 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5548 & j=1,num_cont_hb(i))
5552 C Remove the loop below after debugging !!!
5559 C Calculate the local-electrostatic correlation terms
5560 do i=iatel_s,iatel_e+1
5562 num_conti=num_cont_hb(i)
5563 num_conti1=num_cont_hb(i+1)
5568 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5569 c & ' jj=',jj,' kk=',kk
5570 if (j1.eq.j+1 .or. j1.eq.j-1) then
5571 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5572 C The system gains extra energy.
5573 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5575 else if (j1.eq.j) then
5576 C Contacts I-J and I-(J+1) occur simultaneously.
5577 C The system loses extra energy.
5578 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5583 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5584 c & ' jj=',jj,' kk=',kk
5586 C Contacts I-J and (I+1)-J occur simultaneously.
5587 C The system loses extra energy.
5588 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5595 c------------------------------------------------------------------------------
5596 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5598 C This subroutine calculates multi-body contributions to hydrogen-bonding
5599 implicit real*8 (a-h,o-z)
5600 include 'DIMENSIONS'
5601 include 'sizesclu.dat'
5602 include 'COMMON.IOUNITS'
5604 include 'COMMON.INFO'
5606 include 'COMMON.FFIELD'
5607 include 'COMMON.DERIV'
5608 include 'COMMON.INTERACT'
5609 include 'COMMON.CONTACTS'
5611 parameter (max_cont=maxconts)
5612 parameter (max_dim=2*(8*3+2))
5613 parameter (msglen1=max_cont*max_dim*4)
5614 parameter (msglen2=2*msglen1)
5615 integer source,CorrelType,CorrelID,Error
5616 double precision buffer(max_cont,max_dim)
5618 double precision gx(3),gx1(3)
5621 C Set lprn=.true. for debugging
5628 if (fgProcs.le.1) goto 30
5630 write (iout,'(a)') 'Contact function values:'
5632 write (iout,'(2i3,50(1x,i2,f5.2))')
5633 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5634 & j=1,num_cont_hb(i))
5637 C Caution! Following code assumes that electrostatic interactions concerning
5638 C a given atom are split among at most two processors!
5648 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5651 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5652 if (MyRank.gt.0) then
5653 C Send correlation contributions to the preceding processor
5655 nn=num_cont_hb(iatel_s)
5656 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5657 cd write (iout,*) 'The BUFFER array:'
5659 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5661 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5663 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5664 C Clear the contacts of the atom passed to the neighboring processor
5665 nn=num_cont_hb(iatel_s+1)
5667 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5669 num_cont_hb(iatel_s)=0
5671 cd write (iout,*) 'Processor ',MyID,MyRank,
5672 cd & ' is sending correlation contribution to processor',MyID-1,
5673 cd & ' msglen=',msglen
5674 cd write (*,*) 'Processor ',MyID,MyRank,
5675 cd & ' is sending correlation contribution to processor',MyID-1,
5676 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5677 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5678 cd write (iout,*) 'Processor ',MyID,
5679 cd & ' has sent correlation contribution to processor',MyID-1,
5680 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5681 cd write (*,*) 'Processor ',MyID,
5682 cd & ' has sent correlation contribution to processor',MyID-1,
5683 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5685 endif ! (MyRank.gt.0)
5689 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5690 if (MyRank.lt.fgProcs-1) then
5691 C Receive correlation contributions from the next processor
5693 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5694 cd write (iout,*) 'Processor',MyID,
5695 cd & ' is receiving correlation contribution from processor',MyID+1,
5696 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5697 cd write (*,*) 'Processor',MyID,
5698 cd & ' is receiving correlation contribution from processor',MyID+1,
5699 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5701 do while (nbytes.le.0)
5702 call mp_probe(MyID+1,CorrelType,nbytes)
5704 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5705 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5706 cd write (iout,*) 'Processor',MyID,
5707 cd & ' has received correlation contribution from processor',MyID+1,
5708 cd & ' msglen=',msglen,' nbytes=',nbytes
5709 cd write (iout,*) 'The received BUFFER array:'
5711 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5713 if (msglen.eq.msglen1) then
5714 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5715 else if (msglen.eq.msglen2) then
5716 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5717 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5720 & 'ERROR!!!! message length changed while processing correlations.'
5722 & 'ERROR!!!! message length changed while processing correlations.'
5723 call mp_stopall(Error)
5724 endif ! msglen.eq.msglen1
5725 endif ! MyRank.lt.fgProcs-1
5732 write (iout,'(a)') 'Contact function values:'
5734 write (iout,'(2i3,50(1x,i2,f5.2))')
5735 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5736 & j=1,num_cont_hb(i))
5742 C Remove the loop below after debugging !!!
5749 C Calculate the dipole-dipole interaction energies
5750 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5751 do i=iatel_s,iatel_e+1
5752 num_conti=num_cont_hb(i)
5759 C Calculate the local-electrostatic correlation terms
5760 do i=iatel_s,iatel_e+1
5762 num_conti=num_cont_hb(i)
5763 num_conti1=num_cont_hb(i+1)
5768 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5769 c & ' jj=',jj,' kk=',kk
5770 if (j1.eq.j+1 .or. j1.eq.j-1) then
5771 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5772 C The system gains extra energy.
5774 sqd1=dsqrt(d_cont(jj,i))
5775 sqd2=dsqrt(d_cont(kk,i1))
5776 sred_geom = sqd1*sqd2
5777 IF (sred_geom.lt.cutoff_corr) THEN
5778 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5780 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5781 c & ' jj=',jj,' kk=',kk
5782 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5783 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5785 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5786 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5789 cd write (iout,*) 'sred_geom=',sred_geom,
5790 cd & ' ekont=',ekont,' fprim=',fprimcont
5791 call calc_eello(i,j,i+1,j1,jj,kk)
5792 if (wcorr4.gt.0.0d0)
5793 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5794 if (wcorr5.gt.0.0d0)
5795 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5796 c print *,"wcorr5",ecorr5
5797 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5798 cd write(2,*)'ijkl',i,j,i+1,j1
5799 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5800 & .or. wturn6.eq.0.0d0))then
5801 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5802 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5803 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5804 c & 'ecorr6=',ecorr6, wcorr6
5805 cd write (iout,'(4e15.5)') sred_geom,
5806 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5807 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5808 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5809 else if (wturn6.gt.0.0d0
5810 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5811 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5812 eturn6=eturn6+eello_turn6(i,jj,kk)
5813 cd write (2,*) 'multibody_eello:eturn6',eturn6
5817 else if (j1.eq.j) then
5818 C Contacts I-J and I-(J+1) occur simultaneously.
5819 C The system loses extra energy.
5820 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5825 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5826 c & ' jj=',jj,' kk=',kk
5828 C Contacts I-J and (I+1)-J occur simultaneously.
5829 C The system loses extra energy.
5830 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5837 c------------------------------------------------------------------------------
5838 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'COMMON.IOUNITS'
5842 include 'COMMON.DERIV'
5843 include 'COMMON.INTERACT'
5844 include 'COMMON.CONTACTS'
5845 double precision gx(3),gx1(3)
5855 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5856 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5857 C Following 4 lines for diagnostics.
5862 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5864 c write (iout,*)'Contacts have occurred for peptide groups',
5865 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5866 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5867 C Calculate the multi-body contribution to energy.
5868 ecorr=ecorr+ekont*ees
5870 C Calculate multi-body contributions to the gradient.
5872 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5873 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5874 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5875 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5876 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5877 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5878 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5879 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5880 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5881 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5882 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5883 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5884 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5885 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5889 gradcorr(ll,m)=gradcorr(ll,m)+
5890 & ees*ekl*gacont_hbr(ll,jj,i)-
5891 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5892 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5897 gradcorr(ll,m)=gradcorr(ll,m)+
5898 & ees*eij*gacont_hbr(ll,kk,k)-
5899 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5900 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5907 C---------------------------------------------------------------------------
5908 subroutine dipole(i,j,jj)
5909 implicit real*8 (a-h,o-z)
5910 include 'DIMENSIONS'
5911 include 'sizesclu.dat'
5912 include 'COMMON.IOUNITS'
5913 include 'COMMON.CHAIN'
5914 include 'COMMON.FFIELD'
5915 include 'COMMON.DERIV'
5916 include 'COMMON.INTERACT'
5917 include 'COMMON.CONTACTS'
5918 include 'COMMON.TORSION'
5919 include 'COMMON.VAR'
5920 include 'COMMON.GEO'
5921 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5923 iti1 = itortyp(itype(i+1))
5924 if (j.lt.nres-1) then
5925 itj1 = itortyp(itype(j+1))
5930 dipi(iii,1)=Ub2(iii,i)
5931 dipderi(iii)=Ub2der(iii,i)
5932 dipi(iii,2)=b1(iii,iti1)
5933 dipj(iii,1)=Ub2(iii,j)
5934 dipderj(iii)=Ub2der(iii,j)
5935 dipj(iii,2)=b1(iii,itj1)
5939 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5942 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5945 if (.not.calc_grad) return
5950 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5954 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5959 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5960 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5962 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5964 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5966 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5970 C---------------------------------------------------------------------------
5971 subroutine calc_eello(i,j,k,l,jj,kk)
5973 C This subroutine computes matrices and vectors needed to calculate
5974 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5976 implicit real*8 (a-h,o-z)
5977 include 'DIMENSIONS'
5978 include 'sizesclu.dat'
5979 include 'COMMON.IOUNITS'
5980 include 'COMMON.CHAIN'
5981 include 'COMMON.DERIV'
5982 include 'COMMON.INTERACT'
5983 include 'COMMON.CONTACTS'
5984 include 'COMMON.TORSION'
5985 include 'COMMON.VAR'
5986 include 'COMMON.GEO'
5987 include 'COMMON.FFIELD'
5988 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5989 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5992 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5993 cd & ' jj=',jj,' kk=',kk
5994 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5997 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5998 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6001 call transpose2(aa1(1,1),aa1t(1,1))
6002 call transpose2(aa2(1,1),aa2t(1,1))
6005 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6006 & aa1tder(1,1,lll,kkk))
6007 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6008 & aa2tder(1,1,lll,kkk))
6012 C parallel orientation of the two CA-CA-CA frames.
6014 iti=itortyp(itype(i))
6018 itk1=itortyp(itype(k+1))
6019 itj=itortyp(itype(j))
6020 if (l.lt.nres-1) then
6021 itl1=itortyp(itype(l+1))
6025 C A1 kernel(j+1) A2T
6027 cd write (iout,'(3f10.5,5x,3f10.5)')
6028 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6030 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6031 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6032 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6033 C Following matrices are needed only for 6-th order cumulants
6034 IF (wcorr6.gt.0.0d0) THEN
6035 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6036 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6037 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6038 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6039 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6040 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6041 & ADtEAderx(1,1,1,1,1,1))
6043 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6044 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6045 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6046 & ADtEA1derx(1,1,1,1,1,1))
6048 C End 6-th order cumulants
6051 cd write (2,*) 'In calc_eello6'
6053 cd write (2,*) 'iii=',iii
6055 cd write (2,*) 'kkk=',kkk
6057 cd write (2,'(3(2f10.5),5x)')
6058 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6063 call transpose2(EUgder(1,1,k),auxmat(1,1))
6064 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6065 call transpose2(EUg(1,1,k),auxmat(1,1))
6066 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6067 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6071 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6072 & EAEAderx(1,1,lll,kkk,iii,1))
6076 C A1T kernel(i+1) A2
6077 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6078 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6079 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6080 C Following matrices are needed only for 6-th order cumulants
6081 IF (wcorr6.gt.0.0d0) THEN
6082 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6083 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6084 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6085 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6086 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6087 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6088 & ADtEAderx(1,1,1,1,1,2))
6089 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6090 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6091 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6092 & ADtEA1derx(1,1,1,1,1,2))
6094 C End 6-th order cumulants
6095 call transpose2(EUgder(1,1,l),auxmat(1,1))
6096 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6097 call transpose2(EUg(1,1,l),auxmat(1,1))
6098 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6099 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6103 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6104 & EAEAderx(1,1,lll,kkk,iii,2))
6109 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6110 C They are needed only when the fifth- or the sixth-order cumulants are
6112 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6113 call transpose2(AEA(1,1,1),auxmat(1,1))
6114 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6115 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6116 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6117 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6118 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6119 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6120 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6121 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6122 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6123 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6124 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6125 call transpose2(AEA(1,1,2),auxmat(1,1))
6126 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6127 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6128 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6129 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6130 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6131 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6132 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6133 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6134 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6135 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6136 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6137 C Calculate the Cartesian derivatives of the vectors.
6141 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6142 call matvec2(auxmat(1,1),b1(1,iti),
6143 & AEAb1derx(1,lll,kkk,iii,1,1))
6144 call matvec2(auxmat(1,1),Ub2(1,i),
6145 & AEAb2derx(1,lll,kkk,iii,1,1))
6146 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6147 & AEAb1derx(1,lll,kkk,iii,2,1))
6148 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6149 & AEAb2derx(1,lll,kkk,iii,2,1))
6150 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6151 call matvec2(auxmat(1,1),b1(1,itj),
6152 & AEAb1derx(1,lll,kkk,iii,1,2))
6153 call matvec2(auxmat(1,1),Ub2(1,j),
6154 & AEAb2derx(1,lll,kkk,iii,1,2))
6155 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6156 & AEAb1derx(1,lll,kkk,iii,2,2))
6157 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6158 & AEAb2derx(1,lll,kkk,iii,2,2))
6165 C Antiparallel orientation of the two CA-CA-CA frames.
6167 iti=itortyp(itype(i))
6171 itk1=itortyp(itype(k+1))
6172 itl=itortyp(itype(l))
6173 itj=itortyp(itype(j))
6174 if (j.lt.nres-1) then
6175 itj1=itortyp(itype(j+1))
6179 C A2 kernel(j-1)T A1T
6180 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6181 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6182 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6183 C Following matrices are needed only for 6-th order cumulants
6184 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6185 & j.eq.i+4 .and. l.eq.i+3)) THEN
6186 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6187 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6188 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6189 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6190 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6191 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6192 & ADtEAderx(1,1,1,1,1,1))
6193 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6194 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6195 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6196 & ADtEA1derx(1,1,1,1,1,1))
6198 C End 6-th order cumulants
6199 call transpose2(EUgder(1,1,k),auxmat(1,1))
6200 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6201 call transpose2(EUg(1,1,k),auxmat(1,1))
6202 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6203 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6207 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6208 & EAEAderx(1,1,lll,kkk,iii,1))
6212 C A2T kernel(i+1)T A1
6213 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6214 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6215 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6216 C Following matrices are needed only for 6-th order cumulants
6217 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6218 & j.eq.i+4 .and. l.eq.i+3)) THEN
6219 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6220 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6221 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6222 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6223 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6224 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6225 & ADtEAderx(1,1,1,1,1,2))
6226 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6227 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6228 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6229 & ADtEA1derx(1,1,1,1,1,2))
6231 C End 6-th order cumulants
6232 call transpose2(EUgder(1,1,j),auxmat(1,1))
6233 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6234 call transpose2(EUg(1,1,j),auxmat(1,1))
6235 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6236 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6240 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6241 & EAEAderx(1,1,lll,kkk,iii,2))
6246 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6247 C They are needed only when the fifth- or the sixth-order cumulants are
6249 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6250 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6251 call transpose2(AEA(1,1,1),auxmat(1,1))
6252 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6253 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6254 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6255 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6256 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6257 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6258 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6259 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6260 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6261 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6262 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6263 call transpose2(AEA(1,1,2),auxmat(1,1))
6264 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6265 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6266 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6267 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6268 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6269 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6270 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6271 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6272 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6273 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6274 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6275 C Calculate the Cartesian derivatives of the vectors.
6279 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6280 call matvec2(auxmat(1,1),b1(1,iti),
6281 & AEAb1derx(1,lll,kkk,iii,1,1))
6282 call matvec2(auxmat(1,1),Ub2(1,i),
6283 & AEAb2derx(1,lll,kkk,iii,1,1))
6284 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6285 & AEAb1derx(1,lll,kkk,iii,2,1))
6286 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6287 & AEAb2derx(1,lll,kkk,iii,2,1))
6288 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6289 call matvec2(auxmat(1,1),b1(1,itl),
6290 & AEAb1derx(1,lll,kkk,iii,1,2))
6291 call matvec2(auxmat(1,1),Ub2(1,l),
6292 & AEAb2derx(1,lll,kkk,iii,1,2))
6293 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6294 & AEAb1derx(1,lll,kkk,iii,2,2))
6295 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6296 & AEAb2derx(1,lll,kkk,iii,2,2))
6305 C---------------------------------------------------------------------------
6306 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6307 & KK,KKderg,AKA,AKAderg,AKAderx)
6311 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6312 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6313 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6318 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6320 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6323 cd if (lprn) write (2,*) 'In kernel'
6325 cd if (lprn) write (2,*) 'kkk=',kkk
6327 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6328 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6330 cd write (2,*) 'lll=',lll
6331 cd write (2,*) 'iii=1'
6333 cd write (2,'(3(2f10.5),5x)')
6334 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6337 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6338 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6340 cd write (2,*) 'lll=',lll
6341 cd write (2,*) 'iii=2'
6343 cd write (2,'(3(2f10.5),5x)')
6344 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6351 C---------------------------------------------------------------------------
6352 double precision function eello4(i,j,k,l,jj,kk)
6353 implicit real*8 (a-h,o-z)
6354 include 'DIMENSIONS'
6355 include 'sizesclu.dat'
6356 include 'COMMON.IOUNITS'
6357 include 'COMMON.CHAIN'
6358 include 'COMMON.DERIV'
6359 include 'COMMON.INTERACT'
6360 include 'COMMON.CONTACTS'
6361 include 'COMMON.TORSION'
6362 include 'COMMON.VAR'
6363 include 'COMMON.GEO'
6364 double precision pizda(2,2),ggg1(3),ggg2(3)
6365 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6369 cd print *,'eello4:',i,j,k,l,jj,kk
6370 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6371 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6372 cold eij=facont_hb(jj,i)
6373 cold ekl=facont_hb(kk,k)
6375 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6377 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6378 gcorr_loc(k-1)=gcorr_loc(k-1)
6379 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6381 gcorr_loc(l-1)=gcorr_loc(l-1)
6382 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6384 gcorr_loc(j-1)=gcorr_loc(j-1)
6385 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6390 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6391 & -EAEAderx(2,2,lll,kkk,iii,1)
6392 cd derx(lll,kkk,iii)=0.0d0
6396 cd gcorr_loc(l-1)=0.0d0
6397 cd gcorr_loc(j-1)=0.0d0
6398 cd gcorr_loc(k-1)=0.0d0
6400 cd write (iout,*)'Contacts have occurred for peptide groups',
6401 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6402 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6403 if (j.lt.nres-1) then
6410 if (l.lt.nres-1) then
6418 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6419 ggg1(ll)=eel4*g_contij(ll,1)
6420 ggg2(ll)=eel4*g_contij(ll,2)
6421 ghalf=0.5d0*ggg1(ll)
6423 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6424 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6425 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6426 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6427 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6428 ghalf=0.5d0*ggg2(ll)
6430 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6431 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6432 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6433 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6438 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6439 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6444 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6445 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6451 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6456 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6460 cd write (2,*) iii,gcorr_loc(iii)
6464 cd write (2,*) 'ekont',ekont
6465 cd write (iout,*) 'eello4',ekont*eel4
6468 C---------------------------------------------------------------------------
6469 double precision function eello5(i,j,k,l,jj,kk)
6470 implicit real*8 (a-h,o-z)
6471 include 'DIMENSIONS'
6472 include 'sizesclu.dat'
6473 include 'COMMON.IOUNITS'
6474 include 'COMMON.CHAIN'
6475 include 'COMMON.DERIV'
6476 include 'COMMON.INTERACT'
6477 include 'COMMON.CONTACTS'
6478 include 'COMMON.TORSION'
6479 include 'COMMON.VAR'
6480 include 'COMMON.GEO'
6481 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6482 double precision ggg1(3),ggg2(3)
6483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6488 C /l\ / \ \ / \ / \ / C
6489 C / \ / \ \ / \ / \ / C
6490 C j| o |l1 | o | o| o | | o |o C
6491 C \ |/k\| |/ \| / |/ \| |/ \| C
6492 C \i/ \ / \ / / \ / \ C
6494 C (I) (II) (III) (IV) C
6496 C eello5_1 eello5_2 eello5_3 eello5_4 C
6498 C Antiparallel chains C
6501 C /j\ / \ \ / \ / \ / C
6502 C / \ / \ \ / \ / \ / C
6503 C j1| o |l | o | o| o | | o |o C
6504 C \ |/k\| |/ \| / |/ \| |/ \| C
6505 C \i/ \ / \ / / \ / \ C
6507 C (I) (II) (III) (IV) C
6509 C eello5_1 eello5_2 eello5_3 eello5_4 C
6511 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6514 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6519 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6521 itk=itortyp(itype(k))
6522 itl=itortyp(itype(l))
6523 itj=itortyp(itype(j))
6528 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6529 cd & eel5_3_num,eel5_4_num)
6533 derx(lll,kkk,iii)=0.0d0
6537 cd eij=facont_hb(jj,i)
6538 cd ekl=facont_hb(kk,k)
6540 cd write (iout,*)'Contacts have occurred for peptide groups',
6541 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6543 C Contribution from the graph I.
6544 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6545 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6546 call transpose2(EUg(1,1,k),auxmat(1,1))
6547 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6548 vv(1)=pizda(1,1)-pizda(2,2)
6549 vv(2)=pizda(1,2)+pizda(2,1)
6550 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6551 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6553 C Explicit gradient in virtual-dihedral angles.
6554 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6555 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6556 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6557 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6558 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6559 vv(1)=pizda(1,1)-pizda(2,2)
6560 vv(2)=pizda(1,2)+pizda(2,1)
6561 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6562 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6563 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6564 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6565 vv(1)=pizda(1,1)-pizda(2,2)
6566 vv(2)=pizda(1,2)+pizda(2,1)
6568 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6569 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6570 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6572 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6573 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6574 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6576 C Cartesian gradient
6580 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6582 vv(1)=pizda(1,1)-pizda(2,2)
6583 vv(2)=pizda(1,2)+pizda(2,1)
6584 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6585 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6586 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6593 C Contribution from graph II
6594 call transpose2(EE(1,1,itk),auxmat(1,1))
6595 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6596 vv(1)=pizda(1,1)+pizda(2,2)
6597 vv(2)=pizda(2,1)-pizda(1,2)
6598 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6599 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6601 C Explicit gradient in virtual-dihedral angles.
6602 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6603 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6604 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6605 vv(1)=pizda(1,1)+pizda(2,2)
6606 vv(2)=pizda(2,1)-pizda(1,2)
6608 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6609 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6610 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6612 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6613 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6614 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6616 C Cartesian gradient
6620 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6622 vv(1)=pizda(1,1)+pizda(2,2)
6623 vv(2)=pizda(2,1)-pizda(1,2)
6624 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6625 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6626 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6635 C Parallel orientation
6636 C Contribution from graph III
6637 call transpose2(EUg(1,1,l),auxmat(1,1))
6638 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6639 vv(1)=pizda(1,1)-pizda(2,2)
6640 vv(2)=pizda(1,2)+pizda(2,1)
6641 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6642 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6644 C Explicit gradient in virtual-dihedral angles.
6645 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6646 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6647 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6648 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6649 vv(1)=pizda(1,1)-pizda(2,2)
6650 vv(2)=pizda(1,2)+pizda(2,1)
6651 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6652 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6653 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6654 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6655 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6656 vv(1)=pizda(1,1)-pizda(2,2)
6657 vv(2)=pizda(1,2)+pizda(2,1)
6658 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6659 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6660 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6661 C Cartesian gradient
6665 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6667 vv(1)=pizda(1,1)-pizda(2,2)
6668 vv(2)=pizda(1,2)+pizda(2,1)
6669 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6670 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6671 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6677 C Contribution from graph IV
6679 call transpose2(EE(1,1,itl),auxmat(1,1))
6680 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6681 vv(1)=pizda(1,1)+pizda(2,2)
6682 vv(2)=pizda(2,1)-pizda(1,2)
6683 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6684 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6686 C Explicit gradient in virtual-dihedral angles.
6687 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6688 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6689 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6690 vv(1)=pizda(1,1)+pizda(2,2)
6691 vv(2)=pizda(2,1)-pizda(1,2)
6692 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6693 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6694 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6695 C Cartesian gradient
6699 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6701 vv(1)=pizda(1,1)+pizda(2,2)
6702 vv(2)=pizda(2,1)-pizda(1,2)
6703 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6704 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6705 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6711 C Antiparallel orientation
6712 C Contribution from graph III
6714 call transpose2(EUg(1,1,j),auxmat(1,1))
6715 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6716 vv(1)=pizda(1,1)-pizda(2,2)
6717 vv(2)=pizda(1,2)+pizda(2,1)
6718 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6719 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6721 C Explicit gradient in virtual-dihedral angles.
6722 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6723 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6724 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6725 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6726 vv(1)=pizda(1,1)-pizda(2,2)
6727 vv(2)=pizda(1,2)+pizda(2,1)
6728 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6729 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6730 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6731 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6732 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6733 vv(1)=pizda(1,1)-pizda(2,2)
6734 vv(2)=pizda(1,2)+pizda(2,1)
6735 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6736 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6737 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6738 C Cartesian gradient
6742 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6744 vv(1)=pizda(1,1)-pizda(2,2)
6745 vv(2)=pizda(1,2)+pizda(2,1)
6746 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6747 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6748 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6754 C Contribution from graph IV
6756 call transpose2(EE(1,1,itj),auxmat(1,1))
6757 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6758 vv(1)=pizda(1,1)+pizda(2,2)
6759 vv(2)=pizda(2,1)-pizda(1,2)
6760 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6761 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6763 C Explicit gradient in virtual-dihedral angles.
6764 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6765 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6766 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6767 vv(1)=pizda(1,1)+pizda(2,2)
6768 vv(2)=pizda(2,1)-pizda(1,2)
6769 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6770 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6771 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6772 C Cartesian gradient
6776 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6778 vv(1)=pizda(1,1)+pizda(2,2)
6779 vv(2)=pizda(2,1)-pizda(1,2)
6780 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6781 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6782 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6789 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6790 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6791 cd write (2,*) 'ijkl',i,j,k,l
6792 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6793 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6795 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6796 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6797 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6798 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6800 if (j.lt.nres-1) then
6807 if (l.lt.nres-1) then
6817 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6819 ggg1(ll)=eel5*g_contij(ll,1)
6820 ggg2(ll)=eel5*g_contij(ll,2)
6821 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6822 ghalf=0.5d0*ggg1(ll)
6824 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6825 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6826 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6827 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6828 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6829 ghalf=0.5d0*ggg2(ll)
6831 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6832 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6833 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6834 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6839 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6840 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6845 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6846 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6852 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6857 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6861 cd write (2,*) iii,g_corr5_loc(iii)
6865 cd write (2,*) 'ekont',ekont
6866 cd write (iout,*) 'eello5',ekont*eel5
6869 c--------------------------------------------------------------------------
6870 double precision function eello6(i,j,k,l,jj,kk)
6871 implicit real*8 (a-h,o-z)
6872 include 'DIMENSIONS'
6873 include 'sizesclu.dat'
6874 include 'COMMON.IOUNITS'
6875 include 'COMMON.CHAIN'
6876 include 'COMMON.DERIV'
6877 include 'COMMON.INTERACT'
6878 include 'COMMON.CONTACTS'
6879 include 'COMMON.TORSION'
6880 include 'COMMON.VAR'
6881 include 'COMMON.GEO'
6882 include 'COMMON.FFIELD'
6883 double precision ggg1(3),ggg2(3)
6884 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6889 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6897 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6898 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6902 derx(lll,kkk,iii)=0.0d0
6906 cd eij=facont_hb(jj,i)
6907 cd ekl=facont_hb(kk,k)
6913 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6914 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6915 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6916 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6917 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6918 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6920 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6921 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6922 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6923 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6924 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6925 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6929 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6931 C If turn contributions are considered, they will be handled separately.
6932 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6933 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6934 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6935 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6936 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6937 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6938 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6941 if (j.lt.nres-1) then
6948 if (l.lt.nres-1) then
6956 ggg1(ll)=eel6*g_contij(ll,1)
6957 ggg2(ll)=eel6*g_contij(ll,2)
6958 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6959 ghalf=0.5d0*ggg1(ll)
6961 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6962 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6963 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6964 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6965 ghalf=0.5d0*ggg2(ll)
6966 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6968 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6969 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6970 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6971 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6976 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6977 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6982 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6983 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6989 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6994 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6998 cd write (2,*) iii,g_corr6_loc(iii)
7002 cd write (2,*) 'ekont',ekont
7003 cd write (iout,*) 'eello6',ekont*eel6
7006 c--------------------------------------------------------------------------
7007 double precision function eello6_graph1(i,j,k,l,imat,swap)
7008 implicit real*8 (a-h,o-z)
7009 include 'DIMENSIONS'
7010 include 'sizesclu.dat'
7011 include 'COMMON.IOUNITS'
7012 include 'COMMON.CHAIN'
7013 include 'COMMON.DERIV'
7014 include 'COMMON.INTERACT'
7015 include 'COMMON.CONTACTS'
7016 include 'COMMON.TORSION'
7017 include 'COMMON.VAR'
7018 include 'COMMON.GEO'
7019 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7023 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7025 C Parallel Antiparallel C
7031 C \ j|/k\| / \ |/k\|l / C
7036 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7037 itk=itortyp(itype(k))
7038 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7039 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7040 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7041 call transpose2(EUgC(1,1,k),auxmat(1,1))
7042 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7043 vv1(1)=pizda1(1,1)-pizda1(2,2)
7044 vv1(2)=pizda1(1,2)+pizda1(2,1)
7045 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7046 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7047 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7048 s5=scalar2(vv(1),Dtobr2(1,i))
7049 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7050 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7051 if (.not. calc_grad) return
7052 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7053 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7054 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7055 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7056 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7057 & +scalar2(vv(1),Dtobr2der(1,i)))
7058 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7059 vv1(1)=pizda1(1,1)-pizda1(2,2)
7060 vv1(2)=pizda1(1,2)+pizda1(2,1)
7061 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7062 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7064 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7065 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7066 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7067 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7068 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7070 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7071 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7072 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7073 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7074 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7076 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7077 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7078 vv1(1)=pizda1(1,1)-pizda1(2,2)
7079 vv1(2)=pizda1(1,2)+pizda1(2,1)
7080 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7081 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7082 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7083 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7092 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7093 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7094 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7095 call transpose2(EUgC(1,1,k),auxmat(1,1))
7096 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7098 vv1(1)=pizda1(1,1)-pizda1(2,2)
7099 vv1(2)=pizda1(1,2)+pizda1(2,1)
7100 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7101 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7102 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7103 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7104 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7105 s5=scalar2(vv(1),Dtobr2(1,i))
7106 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7112 c----------------------------------------------------------------------------
7113 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7114 implicit real*8 (a-h,o-z)
7115 include 'DIMENSIONS'
7116 include 'sizesclu.dat'
7117 include 'COMMON.IOUNITS'
7118 include 'COMMON.CHAIN'
7119 include 'COMMON.DERIV'
7120 include 'COMMON.INTERACT'
7121 include 'COMMON.CONTACTS'
7122 include 'COMMON.TORSION'
7123 include 'COMMON.VAR'
7124 include 'COMMON.GEO'
7126 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7127 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7130 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7132 C Parallel Antiparallel C
7138 C \ j|/k\| \ |/k\|l C
7143 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7144 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7145 C AL 7/4/01 s1 would occur in the sixth-order moment,
7146 C but not in a cluster cumulant
7148 s1=dip(1,jj,i)*dip(1,kk,k)
7150 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7151 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7152 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7153 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7154 call transpose2(EUg(1,1,k),auxmat(1,1))
7155 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7156 vv(1)=pizda(1,1)-pizda(2,2)
7157 vv(2)=pizda(1,2)+pizda(2,1)
7158 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7159 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7161 eello6_graph2=-(s1+s2+s3+s4)
7163 eello6_graph2=-(s2+s3+s4)
7166 if (.not. calc_grad) return
7167 C Derivatives in gamma(i-1)
7170 s1=dipderg(1,jj,i)*dip(1,kk,k)
7172 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7173 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7174 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7175 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7177 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7179 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7181 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7183 C Derivatives in gamma(k-1)
7185 s1=dip(1,jj,i)*dipderg(1,kk,k)
7187 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7188 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7189 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7190 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7191 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7192 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7193 vv(1)=pizda(1,1)-pizda(2,2)
7194 vv(2)=pizda(1,2)+pizda(2,1)
7195 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7197 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7199 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7201 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7202 C Derivatives in gamma(j-1) or gamma(l-1)
7205 s1=dipderg(3,jj,i)*dip(1,kk,k)
7207 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7208 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7209 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7210 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7211 vv(1)=pizda(1,1)-pizda(2,2)
7212 vv(2)=pizda(1,2)+pizda(2,1)
7213 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7216 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7218 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7221 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7222 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7224 C Derivatives in gamma(l-1) or gamma(j-1)
7227 s1=dip(1,jj,i)*dipderg(3,kk,k)
7229 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7230 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7231 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7232 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7233 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7234 vv(1)=pizda(1,1)-pizda(2,2)
7235 vv(2)=pizda(1,2)+pizda(2,1)
7236 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7239 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7241 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7245 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7247 C Cartesian derivatives.
7249 write (2,*) 'In eello6_graph2'
7251 write (2,*) 'iii=',iii
7253 write (2,*) 'kkk=',kkk
7255 write (2,'(3(2f10.5),5x)')
7256 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7266 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7268 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7271 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7273 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7274 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7276 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7277 call transpose2(EUg(1,1,k),auxmat(1,1))
7278 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7280 vv(1)=pizda(1,1)-pizda(2,2)
7281 vv(2)=pizda(1,2)+pizda(2,1)
7282 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7283 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7285 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7287 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7290 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7292 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7299 c----------------------------------------------------------------------------
7300 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7301 implicit real*8 (a-h,o-z)
7302 include 'DIMENSIONS'
7303 include 'sizesclu.dat'
7304 include 'COMMON.IOUNITS'
7305 include 'COMMON.CHAIN'
7306 include 'COMMON.DERIV'
7307 include 'COMMON.INTERACT'
7308 include 'COMMON.CONTACTS'
7309 include 'COMMON.TORSION'
7310 include 'COMMON.VAR'
7311 include 'COMMON.GEO'
7312 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7314 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7316 C Parallel Antiparallel C
7322 C j|/k\| / |/k\|l / C
7327 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7329 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7330 C energy moment and not to the cluster cumulant.
7331 iti=itortyp(itype(i))
7332 if (j.lt.nres-1) then
7333 itj1=itortyp(itype(j+1))
7337 itk=itortyp(itype(k))
7338 itk1=itortyp(itype(k+1))
7339 if (l.lt.nres-1) then
7340 itl1=itortyp(itype(l+1))
7345 s1=dip(4,jj,i)*dip(4,kk,k)
7347 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7348 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7349 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7350 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7351 call transpose2(EE(1,1,itk),auxmat(1,1))
7352 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7353 vv(1)=pizda(1,1)+pizda(2,2)
7354 vv(2)=pizda(2,1)-pizda(1,2)
7355 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7356 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7358 eello6_graph3=-(s1+s2+s3+s4)
7360 eello6_graph3=-(s2+s3+s4)
7363 if (.not. calc_grad) return
7364 C Derivatives in gamma(k-1)
7365 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7366 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7367 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7368 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7369 C Derivatives in gamma(l-1)
7370 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7371 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7372 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7373 vv(1)=pizda(1,1)+pizda(2,2)
7374 vv(2)=pizda(2,1)-pizda(1,2)
7375 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7376 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7377 C Cartesian derivatives.
7383 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7385 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7388 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7390 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7391 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7393 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7394 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7396 vv(1)=pizda(1,1)+pizda(2,2)
7397 vv(2)=pizda(2,1)-pizda(1,2)
7398 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7400 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7402 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7405 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7407 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7409 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7415 c----------------------------------------------------------------------------
7416 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7417 implicit real*8 (a-h,o-z)
7418 include 'DIMENSIONS'
7419 include 'sizesclu.dat'
7420 include 'COMMON.IOUNITS'
7421 include 'COMMON.CHAIN'
7422 include 'COMMON.DERIV'
7423 include 'COMMON.INTERACT'
7424 include 'COMMON.CONTACTS'
7425 include 'COMMON.TORSION'
7426 include 'COMMON.VAR'
7427 include 'COMMON.GEO'
7428 include 'COMMON.FFIELD'
7429 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7430 & auxvec1(2),auxmat1(2,2)
7432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7434 C Parallel Antiparallel C
7440 C \ j|/k\| \ |/k\|l C
7445 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7447 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7448 C energy moment and not to the cluster cumulant.
7449 cd write (2,*) 'eello_graph4: wturn6',wturn6
7450 iti=itortyp(itype(i))
7451 itj=itortyp(itype(j))
7452 if (j.lt.nres-1) then
7453 itj1=itortyp(itype(j+1))
7457 itk=itortyp(itype(k))
7458 if (k.lt.nres-1) then
7459 itk1=itortyp(itype(k+1))
7463 itl=itortyp(itype(l))
7464 if (l.lt.nres-1) then
7465 itl1=itortyp(itype(l+1))
7469 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7470 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7471 cd & ' itl',itl,' itl1',itl1
7474 s1=dip(3,jj,i)*dip(3,kk,k)
7476 s1=dip(2,jj,j)*dip(2,kk,l)
7479 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7480 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7482 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7483 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7485 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7486 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7488 call transpose2(EUg(1,1,k),auxmat(1,1))
7489 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7490 vv(1)=pizda(1,1)-pizda(2,2)
7491 vv(2)=pizda(2,1)+pizda(1,2)
7492 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7493 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7495 eello6_graph4=-(s1+s2+s3+s4)
7497 eello6_graph4=-(s2+s3+s4)
7499 if (.not. calc_grad) return
7500 C Derivatives in gamma(i-1)
7504 s1=dipderg(2,jj,i)*dip(3,kk,k)
7506 s1=dipderg(4,jj,j)*dip(2,kk,l)
7509 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7511 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7512 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7514 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7515 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7517 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7519 cd write (2,*) 'turn6 derivatives'
7521 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7523 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7527 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7533 C Derivatives in gamma(k-1)
7536 s1=dip(3,jj,i)*dipderg(2,kk,k)
7538 s1=dip(2,jj,j)*dipderg(4,kk,l)
7541 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7542 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7544 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7545 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7547 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7548 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7550 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7551 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7552 vv(1)=pizda(1,1)-pizda(2,2)
7553 vv(2)=pizda(2,1)+pizda(1,2)
7554 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7557 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7559 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7563 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7565 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7568 C Derivatives in gamma(j-1) or gamma(l-1)
7569 if (l.eq.j+1 .and. l.gt.1) then
7570 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7571 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7572 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7573 vv(1)=pizda(1,1)-pizda(2,2)
7574 vv(2)=pizda(2,1)+pizda(1,2)
7575 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7576 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7577 else if (j.gt.1) then
7578 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7580 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7581 vv(1)=pizda(1,1)-pizda(2,2)
7582 vv(2)=pizda(2,1)+pizda(1,2)
7583 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7584 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7585 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7590 C Cartesian derivatives.
7597 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7599 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7603 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7605 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7609 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7611 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7613 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7614 & b1(1,itj1),auxvec(1))
7615 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7617 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7618 & b1(1,itl1),auxvec(1))
7619 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7621 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7623 vv(1)=pizda(1,1)-pizda(2,2)
7624 vv(2)=pizda(2,1)+pizda(1,2)
7625 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7627 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7629 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7632 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7635 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7638 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7646 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7661 c----------------------------------------------------------------------------
7662 double precision function eello_turn6(i,jj,kk)
7663 implicit real*8 (a-h,o-z)
7664 include 'DIMENSIONS'
7665 include 'sizesclu.dat'
7666 include 'COMMON.IOUNITS'
7667 include 'COMMON.CHAIN'
7668 include 'COMMON.DERIV'
7669 include 'COMMON.INTERACT'
7670 include 'COMMON.CONTACTS'
7671 include 'COMMON.TORSION'
7672 include 'COMMON.VAR'
7673 include 'COMMON.GEO'
7674 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7675 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7677 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7678 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7679 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7680 C the respective energy moment and not to the cluster cumulant.
7685 iti=itortyp(itype(i))
7686 itk=itortyp(itype(k))
7687 itk1=itortyp(itype(k+1))
7688 itl=itortyp(itype(l))
7689 itj=itortyp(itype(j))
7690 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7691 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7692 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7697 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7699 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7703 derx_turn(lll,kkk,iii)=0.0d0
7710 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7712 cd write (2,*) 'eello6_5',eello6_5
7714 call transpose2(AEA(1,1,1),auxmat(1,1))
7715 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7716 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7717 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7721 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7722 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7723 s2 = scalar2(b1(1,itk),vtemp1(1))
7725 call transpose2(AEA(1,1,2),atemp(1,1))
7726 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7727 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7728 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7732 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7733 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7734 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7736 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7737 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7738 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7739 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7740 ss13 = scalar2(b1(1,itk),vtemp4(1))
7741 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7745 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7751 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7753 C Derivatives in gamma(i+2)
7755 call transpose2(AEA(1,1,1),auxmatd(1,1))
7756 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7757 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7758 call transpose2(AEAderg(1,1,2),atempd(1,1))
7759 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7760 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7764 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7765 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7766 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7772 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7773 C Derivatives in gamma(i+3)
7775 call transpose2(AEA(1,1,1),auxmatd(1,1))
7776 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7777 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7778 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7782 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7783 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7784 s2d = scalar2(b1(1,itk),vtemp1d(1))
7786 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7787 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7789 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7791 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7792 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7793 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7803 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7804 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7806 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7807 & -0.5d0*ekont*(s2d+s12d)
7809 C Derivatives in gamma(i+4)
7810 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7811 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7812 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7814 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7815 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7816 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7826 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7828 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7830 C Derivatives in gamma(i+5)
7832 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7833 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7834 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7838 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7839 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7840 s2d = scalar2(b1(1,itk),vtemp1d(1))
7842 call transpose2(AEA(1,1,2),atempd(1,1))
7843 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7844 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7848 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7849 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7851 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7852 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7853 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7863 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7864 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7866 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7867 & -0.5d0*ekont*(s2d+s12d)
7869 C Cartesian derivatives
7874 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7875 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7876 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7880 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7881 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7883 s2d = scalar2(b1(1,itk),vtemp1d(1))
7885 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7886 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7887 s8d = -(atempd(1,1)+atempd(2,2))*
7888 & scalar2(cc(1,1,itl),vtemp2(1))
7892 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7894 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7895 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7902 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7905 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7909 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7910 & - 0.5d0*(s8d+s12d)
7912 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7921 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7923 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7924 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7925 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7926 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7927 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7929 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7930 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7931 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7935 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7936 cd & 16*eel_turn6_num
7938 if (j.lt.nres-1) then
7945 if (l.lt.nres-1) then
7953 ggg1(ll)=eel_turn6*g_contij(ll,1)
7954 ggg2(ll)=eel_turn6*g_contij(ll,2)
7955 ghalf=0.5d0*ggg1(ll)
7957 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7958 & +ekont*derx_turn(ll,2,1)
7959 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7960 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7961 & +ekont*derx_turn(ll,4,1)
7962 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7963 ghalf=0.5d0*ggg2(ll)
7965 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7966 & +ekont*derx_turn(ll,2,2)
7967 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7968 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7969 & +ekont*derx_turn(ll,4,2)
7970 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7975 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7980 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7986 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7991 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7995 cd write (2,*) iii,g_corr6_loc(iii)
7998 eello_turn6=ekont*eel_turn6
7999 cd write (2,*) 'ekont',ekont
8000 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8003 crc-------------------------------------------------
8004 SUBROUTINE MATVEC2(A1,V1,V2)
8005 implicit real*8 (a-h,o-z)
8006 include 'DIMENSIONS'
8007 DIMENSION A1(2,2),V1(2),V2(2)
8011 c 3 VI=VI+A1(I,K)*V1(K)
8015 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8016 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8021 C---------------------------------------
8022 SUBROUTINE MATMAT2(A1,A2,A3)
8023 implicit real*8 (a-h,o-z)
8024 include 'DIMENSIONS'
8025 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8026 c DIMENSION AI3(2,2)
8030 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8036 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8037 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8038 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8039 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8047 c-------------------------------------------------------------------------
8048 double precision function scalar2(u,v)
8050 double precision u(2),v(2)
8053 scalar2=u(1)*v(1)+u(2)*v(2)
8057 C-----------------------------------------------------------------------------
8059 subroutine transpose2(a,at)
8061 double precision a(2,2),at(2,2)
8068 c--------------------------------------------------------------------------
8069 subroutine transpose(n,a,at)
8072 double precision a(n,n),at(n,n)
8080 C---------------------------------------------------------------------------
8081 subroutine prodmat3(a1,a2,kk,transp,prod)
8084 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8086 crc double precision auxmat(2,2),prod_(2,2)
8089 crc call transpose2(kk(1,1),auxmat(1,1))
8090 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8091 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8093 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8094 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8095 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8096 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8097 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8098 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8099 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8100 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8103 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8104 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8106 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8107 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8108 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8109 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8110 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8111 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8112 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8113 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8116 c call transpose2(a2(1,1),a2t(1,1))
8119 crc print *,((prod_(i,j),i=1,2),j=1,2)
8120 crc print *,((prod(i,j),i=1,2),j=1,2)
8124 C-----------------------------------------------------------------------------
8125 double precision function scalar(u,v)
8127 double precision u(3),v(3)