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.CONTROL'
2879 include 'COMMON.IOUNITS'
2883 C write (iout,*) ,"link_end",link_end,constr_dist
2884 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2885 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
2886 c & " constr_dist",constr_dist
2887 if (link_end.eq.0) return
2888 do i=link_start,link_end
2889 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2890 C CA-CA distance used in regularization of structure.
2893 C iii and jjj point to the residues for which the distance is assigned.
2894 if (ii.gt.nres) then
2901 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2902 c & dhpb(i),dhpb1(i),forcon(i)
2903 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2904 C distance and angle dependent SS bond potential.
2905 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2906 C & iabs(itype(jjj)).eq.1) then
2907 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2908 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
2909 if (.not.dyn_ss .and. i.le.nss) then
2910 C 15/02/13 CC dynamic SSbond - additional check
2911 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2912 & iabs(itype(jjj)).eq.1) then
2913 call ssbond_ene(iii,jjj,eij)
2916 cd write (iout,*) "eij",eij
2917 cd & ' waga=',waga,' fac=',fac
2918 ! else if (ii.gt.nres .and. jj.gt.nres) then
2920 C Calculate the distance between the two points and its difference from the
2923 if (irestr_type(i).eq.11) then
2924 ehpb=ehpb+fordepth(i)!**4.0d0
2925 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2926 fac=fordepth(i)!**4.0d0
2927 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2928 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
2929 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
2930 c & ehpb,irestr_type(i)
2931 else if (irestr_type(i).eq.10) then
2932 c AL 6//19/2018 cross-link restraints
2933 xdis = 0.5d0*(dd/forcon(i))**2
2934 expdis = dexp(-xdis)
2935 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
2936 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
2937 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
2938 c & " wboltzd",wboltzd
2939 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
2940 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
2941 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
2942 & *expdis/(aux*forcon(i)**2)
2943 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
2944 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
2945 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
2946 else if (irestr_type(i).eq.2) then
2947 c Quartic restraints
2948 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2949 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
2950 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
2951 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
2952 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2954 c Quadratic restraints
2956 C Get the force constant corresponding to this distance.
2958 C Calculate the contribution to energy.
2959 ehpb=ehpb+0.5d0*waga*rdis*rdis
2960 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
2961 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
2962 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
2964 C Evaluate gradient.
2968 c Calculate Cartesian gradient
2970 ggg(j)=fac*(c(j,jj)-c(j,ii))
2972 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2973 C If this is a SC-SC distance, we need to calculate the contributions to the
2974 C Cartesian gradient in the SC vectors (ghpbx).
2977 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2978 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2982 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2983 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2989 C--------------------------------------------------------------------------
2990 subroutine ssbond_ene(i,j,eij)
2992 C Calculate the distance and angle dependent SS-bond potential energy
2993 C using a free-energy function derived based on RHF/6-31G** ab initio
2994 C calculations of diethyl disulfide.
2996 C A. Liwo and U. Kozlowska, 11/24/03
2998 implicit real*8 (a-h,o-z)
2999 include 'DIMENSIONS'
3000 include 'sizesclu.dat'
3001 include 'COMMON.SBRIDGE'
3002 include 'COMMON.CHAIN'
3003 include 'COMMON.DERIV'
3004 include 'COMMON.LOCAL'
3005 include 'COMMON.INTERACT'
3006 include 'COMMON.VAR'
3007 include 'COMMON.IOUNITS'
3008 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3013 dxi=dc_norm(1,nres+i)
3014 dyi=dc_norm(2,nres+i)
3015 dzi=dc_norm(3,nres+i)
3016 dsci_inv=dsc_inv(itypi)
3018 dscj_inv=dsc_inv(itypj)
3022 dxj=dc_norm(1,nres+j)
3023 dyj=dc_norm(2,nres+j)
3024 dzj=dc_norm(3,nres+j)
3025 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3030 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3031 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3032 om12=dxi*dxj+dyi*dyj+dzi*dzj
3034 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3035 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3041 deltat12=om2-om1+2.0d0
3043 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3044 & +akct*deltad*deltat12+ebr
3045 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3046 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3047 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3048 c & " deltat12",deltat12," eij",eij
3049 ed=2*akcm*deltad+akct*deltat12
3051 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3052 eom1=-2*akth*deltat1-pom1-om2*pom2
3053 eom2= 2*akth*deltat2+pom1-om1*pom2
3056 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3059 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3060 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3061 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3062 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3065 C Calculate the components of the gradient in DC and X
3069 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3075 C--------------------------------------------------------------------------
3078 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3079 subroutine e_modeller(ehomology_constr)
3080 implicit real*8 (a-h,o-z)
3082 include 'DIMENSIONS'
3084 integer nnn, i, j, k, ki, irec, l
3085 integer katy, odleglosci, test7
3086 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3087 real*8 distance(max_template),distancek(max_template),
3088 & min_odl,godl(max_template),dih_diff(max_template)
3091 c FP - 30/10/2014 Temporary specifications for homology restraints
3093 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3095 double precision, dimension (maxres) :: guscdiff,usc_diff
3096 double precision, dimension (max_template) ::
3097 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3100 include 'COMMON.SBRIDGE'
3101 include 'COMMON.CHAIN'
3102 include 'COMMON.GEO'
3103 include 'COMMON.DERIV'
3104 include 'COMMON.LOCAL'
3105 include 'COMMON.INTERACT'
3106 include 'COMMON.VAR'
3107 include 'COMMON.IOUNITS'
3108 include 'COMMON.CONTROL'
3109 include 'COMMON.HOMRESTR'
3111 include 'COMMON.SETUP'
3112 include 'COMMON.NAMES'
3115 distancek(i)=9999999.9
3120 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3122 C AL 5/2/14 - Introduce list of restraints
3123 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3125 write(iout,*) "------- dist restrs start -------"
3126 write (iout,*) "link_start_homo",link_start_homo,
3127 & " link_end_homo",link_end_homo
3129 do ii = link_start_homo,link_end_homo
3133 c write (iout,*) "dij(",i,j,") =",dij
3135 do k=1,constr_homology
3136 if(.not.l_homo(k,ii)) then
3140 distance(k)=odl(k,ii)-dij
3141 c write (iout,*) "distance(",k,") =",distance(k)
3143 c For Gaussian-type Urestr
3145 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3146 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3147 c write (iout,*) "distancek(",k,") =",distancek(k)
3148 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3150 c For Lorentzian-type Urestr
3152 if (waga_dist.lt.0.0d0) then
3153 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3154 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3155 & (distance(k)**2+sigma_odlir(k,ii)**2))
3159 c min_odl=minval(distancek)
3160 do kk=1,constr_homology
3161 if(l_homo(kk,ii)) then
3162 min_odl=distancek(kk)
3166 do kk=1,constr_homology
3167 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3168 & min_odl=distancek(kk)
3170 c write (iout,* )"min_odl",min_odl
3172 write (iout,*) "ij dij",i,j,dij
3173 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3174 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3175 write (iout,* )"min_odl",min_odl
3180 if (waga_dist.ge.0.0d0) then
3186 do k=1,constr_homology
3187 c Nie wiem po co to liczycie jeszcze raz!
3188 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3189 c & (2*(sigma_odl(i,j,k))**2))
3190 if(.not.l_homo(k,ii)) cycle
3191 if (waga_dist.ge.0.0d0) then
3193 c For Gaussian-type Urestr
3195 godl(k)=dexp(-distancek(k)+min_odl)
3196 odleg2=odleg2+godl(k)
3198 c For Lorentzian-type Urestr
3201 odleg2=odleg2+distancek(k)
3204 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3205 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3206 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3207 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3210 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3211 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3213 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3214 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3216 if (waga_dist.ge.0.0d0) then
3218 c For Gaussian-type Urestr
3220 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3222 c For Lorentzian-type Urestr
3225 odleg=odleg+odleg2/constr_homology
3229 c write (iout,*) "odleg",odleg ! sum of -ln-s
3232 c For Gaussian-type Urestr
3234 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3236 do k=1,constr_homology
3237 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3238 c & *waga_dist)+min_odl
3239 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3241 if(.not.l_homo(k,ii)) cycle
3242 if (waga_dist.ge.0.0d0) then
3243 c For Gaussian-type Urestr
3245 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3247 c For Lorentzian-type Urestr
3250 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3251 & sigma_odlir(k,ii)**2)**2)
3253 sum_sgodl=sum_sgodl+sgodl
3255 c sgodl2=sgodl2+sgodl
3256 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3257 c write(iout,*) "constr_homology=",constr_homology
3258 c write(iout,*) i, j, k, "TEST K"
3260 if (waga_dist.ge.0.0d0) then
3262 c For Gaussian-type Urestr
3264 grad_odl3=waga_homology(iset)*waga_dist
3265 & *sum_sgodl/(sum_godl*dij)
3267 c For Lorentzian-type Urestr
3270 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3271 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3272 grad_odl3=-waga_homology(iset)*waga_dist*
3273 & sum_sgodl/(constr_homology*dij)
3276 c grad_odl3=sum_sgodl/(sum_godl*dij)
3279 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3280 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3281 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3283 ccc write(iout,*) godl, sgodl, grad_odl3
3285 c grad_odl=grad_odl+grad_odl3
3288 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3289 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3290 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3291 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3292 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3293 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3294 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3295 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3296 c if (i.eq.25.and.j.eq.27) then
3297 c write(iout,*) "jik",jik,"i",i,"j",j
3298 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3299 c write(iout,*) "grad_odl3",grad_odl3
3300 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3301 c write(iout,*) "ggodl",ggodl
3302 c write(iout,*) "ghpbc(",jik,i,")",
3303 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3308 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3309 ccc & dLOG(odleg2),"-odleg=", -odleg
3311 enddo ! ii-loop for dist
3313 write(iout,*) "------- dist restrs end -------"
3314 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3315 c & waga_d.eq.1.0d0) call sum_gradient
3317 c Pseudo-energy and gradient from dihedral-angle restraints from
3318 c homology templates
3319 c write (iout,*) "End of distance loop"
3322 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3324 write(iout,*) "------- dih restrs start -------"
3325 do i=idihconstr_start_homo,idihconstr_end_homo
3326 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3329 do i=idihconstr_start_homo,idihconstr_end_homo
3331 c betai=beta(i,i+1,i+2,i+3)
3333 c write (iout,*) "betai =",betai
3334 do k=1,constr_homology
3335 dih_diff(k)=pinorm(dih(k,i)-betai)
3336 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3337 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3338 c & -(6.28318-dih_diff(i,k))
3339 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3340 c & 6.28318+dih_diff(i,k)
3342 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3344 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3346 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3349 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3352 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3353 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3355 write (iout,*) "i",i," betai",betai," kat2",kat2
3356 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3358 if (kat2.le.1.0d-14) cycle
3359 kat=kat-dLOG(kat2/constr_homology)
3360 c write (iout,*) "kat",kat ! sum of -ln-s
3362 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3363 ccc & dLOG(kat2), "-kat=", -kat
3366 c ----------------------------------------------------------------------
3368 c ----------------------------------------------------------------------
3372 do k=1,constr_homology
3374 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3376 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3378 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3379 sum_sgdih=sum_sgdih+sgdih
3381 c grad_dih3=sum_sgdih/sum_gdih
3382 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3384 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3385 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3386 ccc & gloc(nphi+i-3,icg)
3387 gloc(i,icg)=gloc(i,icg)+grad_dih3
3389 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3391 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3392 ccc & gloc(nphi+i-3,icg)
3394 enddo ! i-loop for dih
3396 write(iout,*) "------- dih restrs end -------"
3399 c Pseudo-energy and gradient for theta angle restraints from
3400 c homology templates
3401 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3405 c For constr_homology reference structures (FP)
3407 c Uconst_back_tot=0.0d0
3410 c Econstr_back legacy
3413 c do i=ithet_start,ithet_end
3416 c do i=loc_start,loc_end
3419 duscdiffx(j,i)=0.0d0
3425 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3426 c write (iout,*) "waga_theta",waga_theta
3427 if (waga_theta.gt.0.0d0) then
3429 write (iout,*) "usampl",usampl
3430 write(iout,*) "------- theta restrs start -------"
3431 c do i=ithet_start,ithet_end
3432 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3435 c write (iout,*) "maxres",maxres,"nres",nres
3437 do i=ithet_start,ithet_end
3440 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3442 c Deviation of theta angles wrt constr_homology ref structures
3444 utheta_i=0.0d0 ! argument of Gaussian for single k
3445 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3446 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3447 c over residues in a fragment
3448 c write (iout,*) "theta(",i,")=",theta(i)
3449 do k=1,constr_homology
3451 c dtheta_i=theta(j)-thetaref(j,iref)
3452 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3453 theta_diff(k)=thetatpl(k,i)-theta(i)
3455 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3456 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3457 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3458 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3459 c Gradient for single Gaussian restraint in subr Econstr_back
3460 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3463 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3464 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3468 c Gradient for multiple Gaussian restraint
3469 sum_gtheta=gutheta_i
3471 do k=1,constr_homology
3472 c New generalized expr for multiple Gaussian from Econstr_back
3473 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3475 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3476 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3479 c Final value of gradient using same var as in Econstr_back
3480 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3481 & *waga_homology(iset)
3482 c dutheta(i)=sum_sgtheta/sum_gtheta
3484 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3486 Eval=Eval-dLOG(gutheta_i/constr_homology)
3487 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3488 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3489 c Uconst_back=Uconst_back+utheta(i)
3490 enddo ! (i-loop for theta)
3492 write(iout,*) "------- theta restrs end -------"
3496 c Deviation of local SC geometry
3498 c Separation of two i-loops (instructed by AL - 11/3/2014)
3500 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3501 c write (iout,*) "waga_d",waga_d
3504 write(iout,*) "------- SC restrs start -------"
3505 write (iout,*) "Initial duscdiff,duscdiffx"
3506 do i=loc_start,loc_end
3507 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3508 & (duscdiffx(jik,i),jik=1,3)
3511 do i=loc_start,loc_end
3512 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3513 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3514 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3515 c write(iout,*) "xxtab, yytab, zztab"
3516 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3517 do k=1,constr_homology
3519 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3520 c Original sign inverted for calc of gradients (s. Econstr_back)
3521 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3522 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3523 c write(iout,*) "dxx, dyy, dzz"
3524 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3526 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3527 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3528 c uscdiffk(k)=usc_diff(i)
3529 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3530 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3531 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3532 c & xxref(j),yyref(j),zzref(j)
3537 c Generalized expression for multiple Gaussian acc to that for a single
3538 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3540 c Original implementation
3541 c sum_guscdiff=guscdiff(i)
3543 c sum_sguscdiff=0.0d0
3544 c do k=1,constr_homology
3545 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3546 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3547 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3550 c Implementation of new expressions for gradient (Jan. 2015)
3552 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3554 do k=1,constr_homology
3556 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3557 c before. Now the drivatives should be correct
3559 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3560 c Original sign inverted for calc of gradients (s. Econstr_back)
3561 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3562 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3564 c New implementation
3566 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3567 & sigma_d(k,i) ! for the grad wrt r'
3568 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3571 c New implementation
3572 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3574 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3575 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3576 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3577 duscdiff(jik,i)=duscdiff(jik,i)+
3578 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3579 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3580 duscdiffx(jik,i)=duscdiffx(jik,i)+
3581 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3582 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3585 write(iout,*) "jik",jik,"i",i
3586 write(iout,*) "dxx, dyy, dzz"
3587 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3588 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3589 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3590 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3591 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3592 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3593 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3594 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3595 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3596 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3597 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3598 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3599 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3600 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3601 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3608 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3609 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3611 c write (iout,*) i," uscdiff",uscdiff(i)
3613 c Put together deviations from local geometry
3615 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3616 c & wfrag_back(3,i,iset)*uscdiff(i)
3617 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3618 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3619 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3620 c Uconst_back=Uconst_back+usc_diff(i)
3622 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3624 c New implment: multiplied by sum_sguscdiff
3627 enddo ! (i-loop for dscdiff)
3632 write(iout,*) "------- SC restrs end -------"
3633 write (iout,*) "------ After SC loop in e_modeller ------"
3634 do i=loc_start,loc_end
3635 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3636 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3638 if (waga_theta.eq.1.0d0) then
3639 write (iout,*) "in e_modeller after SC restr end: dutheta"
3640 do i=ithet_start,ithet_end
3641 write (iout,*) i,dutheta(i)
3644 if (waga_d.eq.1.0d0) then
3645 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3647 write (iout,*) i,(duscdiff(j,i),j=1,3)
3648 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3653 c Total energy from homology restraints
3655 write (iout,*) "odleg",odleg," kat",kat
3656 write (iout,*) "odleg",odleg," kat",kat
3657 write (iout,*) "Eval",Eval," Erot",Erot
3658 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3659 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3660 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3661 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3664 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3666 c ehomology_constr=odleg+kat
3668 c For Lorentzian-type Urestr
3671 if (waga_dist.ge.0.0d0) then
3673 c For Gaussian-type Urestr
3675 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3676 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3677 c write (iout,*) "ehomology_constr=",ehomology_constr
3680 c For Lorentzian-type Urestr
3682 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3683 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3684 c write (iout,*) "ehomology_constr=",ehomology_constr
3687 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
3688 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3689 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
3690 write (iout,*) "ehomology_constr",ehomology_constr
3694 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3695 747 format(a12,i4,i4,i4,f8.3,f8.3)
3696 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3697 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3698 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3699 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3701 C--------------------------------------------------------------------------
3702 subroutine ebond(estr)
3704 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3706 implicit real*8 (a-h,o-z)
3707 include 'DIMENSIONS'
3708 include 'COMMON.LOCAL'
3709 include 'COMMON.GEO'
3710 include 'COMMON.INTERACT'
3711 include 'COMMON.DERIV'
3712 include 'COMMON.VAR'
3713 include 'COMMON.CHAIN'
3714 include 'COMMON.IOUNITS'
3715 include 'COMMON.NAMES'
3716 include 'COMMON.FFIELD'
3717 include 'COMMON.CONTROL'
3718 double precision u(3),ud(3)
3721 diff = vbld(i)-vbldp0
3722 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3725 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3730 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3737 diff=vbld(i+nres)-vbldsc0(1,iti)
3738 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3739 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3740 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3742 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3746 diff=vbld(i+nres)-vbldsc0(j,iti)
3747 ud(j)=aksc(j,iti)*diff
3748 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3762 uprod2=uprod2*u(k)*u(k)
3766 usumsqder=usumsqder+ud(j)*uprod2
3768 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3769 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3770 estr=estr+uprod/usum
3772 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3780 C--------------------------------------------------------------------------
3781 subroutine ebend(etheta)
3783 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3784 C angles gamma and its derivatives in consecutive thetas and gammas.
3786 implicit real*8 (a-h,o-z)
3787 include 'DIMENSIONS'
3788 include 'sizesclu.dat'
3789 include 'COMMON.LOCAL'
3790 include 'COMMON.GEO'
3791 include 'COMMON.INTERACT'
3792 include 'COMMON.DERIV'
3793 include 'COMMON.VAR'
3794 include 'COMMON.CHAIN'
3795 include 'COMMON.IOUNITS'
3796 include 'COMMON.NAMES'
3797 include 'COMMON.FFIELD'
3798 common /calcthet/ term1,term2,termm,diffak,ratak,
3799 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3800 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3801 double precision y(2),z(2)
3803 time11=dexp(-2*time)
3806 c write (iout,*) "nres",nres
3807 c write (*,'(a,i2)') 'EBEND ICG=',icg
3808 c write (iout,*) ithet_start,ithet_end
3809 do i=ithet_start,ithet_end
3810 C Zero the energy function and its derivative at 0 or pi.
3811 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3813 c if (i.gt.ithet_start .and.
3814 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3815 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3823 c if (i.lt.nres .and. itel(i).ne.0) then
3835 call proc_proc(phii,icrc)
3836 if (icrc.eq.1) phii=150.0
3850 call proc_proc(phii1,icrc)
3851 if (icrc.eq.1) phii1=150.0
3863 C Calculate the "mean" value of theta from the part of the distribution
3864 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3865 C In following comments this theta will be referred to as t_c.
3866 thet_pred_mean=0.0d0
3870 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3872 c write (iout,*) "thet_pred_mean",thet_pred_mean
3873 dthett=thet_pred_mean*ssd
3874 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3875 c write (iout,*) "thet_pred_mean",thet_pred_mean
3876 C Derivatives of the "mean" values in gamma1 and gamma2.
3877 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3878 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3879 if (theta(i).gt.pi-delta) then
3880 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3882 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3883 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3884 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3886 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3888 else if (theta(i).lt.delta) then
3889 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3890 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3891 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3893 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3894 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3897 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3900 etheta=etheta+ethetai
3901 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3902 c & rad2deg*phii,rad2deg*phii1,ethetai
3903 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3904 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3905 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3908 C Ufff.... We've done all this!!!
3911 C---------------------------------------------------------------------------
3912 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3914 implicit real*8 (a-h,o-z)
3915 include 'DIMENSIONS'
3916 include 'COMMON.LOCAL'
3917 include 'COMMON.IOUNITS'
3918 common /calcthet/ term1,term2,termm,diffak,ratak,
3919 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3920 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3921 C Calculate the contributions to both Gaussian lobes.
3922 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3923 C The "polynomial part" of the "standard deviation" of this part of
3927 sig=sig*thet_pred_mean+polthet(j,it)
3929 C Derivative of the "interior part" of the "standard deviation of the"
3930 C gamma-dependent Gaussian lobe in t_c.
3931 sigtc=3*polthet(3,it)
3933 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3936 C Set the parameters of both Gaussian lobes of the distribution.
3937 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3938 fac=sig*sig+sigc0(it)
3941 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3942 sigsqtc=-4.0D0*sigcsq*sigtc
3943 c print *,i,sig,sigtc,sigsqtc
3944 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3945 sigtc=-sigtc/(fac*fac)
3946 C Following variable is sigma(t_c)**(-2)
3947 sigcsq=sigcsq*sigcsq
3949 sig0inv=1.0D0/sig0i**2
3950 delthec=thetai-thet_pred_mean
3951 delthe0=thetai-theta0i
3952 term1=-0.5D0*sigcsq*delthec*delthec
3953 term2=-0.5D0*sig0inv*delthe0*delthe0
3954 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3955 C NaNs in taking the logarithm. We extract the largest exponent which is added
3956 C to the energy (this being the log of the distribution) at the end of energy
3957 C term evaluation for this virtual-bond angle.
3958 if (term1.gt.term2) then
3960 term2=dexp(term2-termm)
3964 term1=dexp(term1-termm)
3967 C The ratio between the gamma-independent and gamma-dependent lobes of
3968 C the distribution is a Gaussian function of thet_pred_mean too.
3969 diffak=gthet(2,it)-thet_pred_mean
3970 ratak=diffak/gthet(3,it)**2
3971 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3972 C Let's differentiate it in thet_pred_mean NOW.
3974 C Now put together the distribution terms to make complete distribution.
3975 termexp=term1+ak*term2
3976 termpre=sigc+ak*sig0i
3977 C Contribution of the bending energy from this theta is just the -log of
3978 C the sum of the contributions from the two lobes and the pre-exponential
3979 C factor. Simple enough, isn't it?
3980 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3981 C NOW the derivatives!!!
3982 C 6/6/97 Take into account the deformation.
3983 E_theta=(delthec*sigcsq*term1
3984 & +ak*delthe0*sig0inv*term2)/termexp
3985 E_tc=((sigtc+aktc*sig0i)/termpre
3986 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3987 & aktc*term2)/termexp)
3990 c-----------------------------------------------------------------------------
3991 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3992 implicit real*8 (a-h,o-z)
3993 include 'DIMENSIONS'
3994 include 'COMMON.LOCAL'
3995 include 'COMMON.IOUNITS'
3996 common /calcthet/ term1,term2,termm,diffak,ratak,
3997 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3998 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3999 delthec=thetai-thet_pred_mean
4000 delthe0=thetai-theta0i
4001 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4002 t3 = thetai-thet_pred_mean
4006 t14 = t12+t6*sigsqtc
4008 t21 = thetai-theta0i
4014 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4015 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4016 & *(-t12*t9-ak*sig0inv*t27)
4020 C--------------------------------------------------------------------------
4021 subroutine ebend(etheta)
4023 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4024 C angles gamma and its derivatives in consecutive thetas and gammas.
4025 C ab initio-derived potentials from
4026 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4028 implicit real*8 (a-h,o-z)
4029 include 'DIMENSIONS'
4030 include 'COMMON.LOCAL'
4031 include 'COMMON.GEO'
4032 include 'COMMON.INTERACT'
4033 include 'COMMON.DERIV'
4034 include 'COMMON.VAR'
4035 include 'COMMON.CHAIN'
4036 include 'COMMON.IOUNITS'
4037 include 'COMMON.NAMES'
4038 include 'COMMON.FFIELD'
4039 include 'COMMON.CONTROL'
4040 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4041 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4042 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4043 & sinph1ph2(maxdouble,maxdouble)
4044 logical lprn /.false./, lprn1 /.false./
4046 do i=ithet_start,ithet_end
4047 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4048 & (itype(i).eq.ntyp1)) cycle
4052 theti2=0.5d0*theta(i)
4053 ityp2=ithetyp(itype(i-1))
4055 coskt(k)=dcos(k*theti2)
4056 sinkt(k)=dsin(k*theti2)
4058 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4061 if (phii.ne.phii) phii=150.0
4065 ityp1=ithetyp(itype(i-2))
4067 cosph1(k)=dcos(k*phii)
4068 sinph1(k)=dsin(k*phii)
4072 ityp1=ithetyp(itype(i-2))
4078 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4081 if (phii1.ne.phii1) phii1=150.0
4086 ityp3=ithetyp(itype(i))
4088 cosph2(k)=dcos(k*phii1)
4089 sinph2(k)=dsin(k*phii1)
4093 ityp3=ithetyp(itype(i))
4099 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4100 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4102 ethetai=aa0thet(ityp1,ityp2,ityp3)
4105 ccl=cosph1(l)*cosph2(k-l)
4106 ssl=sinph1(l)*sinph2(k-l)
4107 scl=sinph1(l)*cosph2(k-l)
4108 csl=cosph1(l)*sinph2(k-l)
4109 cosph1ph2(l,k)=ccl-ssl
4110 cosph1ph2(k,l)=ccl+ssl
4111 sinph1ph2(l,k)=scl+csl
4112 sinph1ph2(k,l)=scl-csl
4116 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4117 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4118 write (iout,*) "coskt and sinkt"
4120 write (iout,*) k,coskt(k),sinkt(k)
4124 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4125 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4128 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4129 & " ethetai",ethetai
4132 write (iout,*) "cosph and sinph"
4134 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4136 write (iout,*) "cosph1ph2 and sinph2ph2"
4139 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4140 & sinph1ph2(l,k),sinph1ph2(k,l)
4143 write(iout,*) "ethetai",ethetai
4147 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4148 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4149 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4150 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4151 ethetai=ethetai+sinkt(m)*aux
4152 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4153 dephii=dephii+k*sinkt(m)*(
4154 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4155 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4156 dephii1=dephii1+k*sinkt(m)*(
4157 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4158 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4160 & write (iout,*) "m",m," k",k," bbthet",
4161 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4162 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4163 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4164 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4168 & write(iout,*) "ethetai",ethetai
4172 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4173 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4174 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4175 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4176 ethetai=ethetai+sinkt(m)*aux
4177 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4178 dephii=dephii+l*sinkt(m)*(
4179 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4180 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4181 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4182 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4183 dephii1=dephii1+(k-l)*sinkt(m)*(
4184 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4185 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4186 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4187 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4189 write (iout,*) "m",m," k",k," l",l," ffthet",
4190 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4191 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4192 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4193 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4194 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4195 & cosph1ph2(k,l)*sinkt(m),
4196 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4203 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4204 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4205 & phii1*rad2deg,ethetai
4207 etheta=etheta+ethetai
4209 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4210 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4211 gloc(nphi+i-2,icg)=wang*dethetai
4217 c-----------------------------------------------------------------------------
4218 subroutine esc(escloc)
4219 C Calculate the local energy of a side chain and its derivatives in the
4220 C corresponding virtual-bond valence angles THETA and the spherical angles
4222 implicit real*8 (a-h,o-z)
4223 include 'DIMENSIONS'
4224 include 'sizesclu.dat'
4225 include 'COMMON.GEO'
4226 include 'COMMON.LOCAL'
4227 include 'COMMON.VAR'
4228 include 'COMMON.INTERACT'
4229 include 'COMMON.DERIV'
4230 include 'COMMON.CHAIN'
4231 include 'COMMON.IOUNITS'
4232 include 'COMMON.NAMES'
4233 include 'COMMON.FFIELD'
4234 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4235 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4236 common /sccalc/ time11,time12,time112,theti,it,nlobit
4239 c write (iout,'(a)') 'ESC'
4240 do i=loc_start,loc_end
4242 if (it.eq.10) goto 1
4244 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4245 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4246 theti=theta(i+1)-pipol
4250 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4252 if (x(2).gt.pi-delta) then
4256 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4258 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4259 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4261 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4262 & ddersc0(1),dersc(1))
4263 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4264 & ddersc0(3),dersc(3))
4266 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4268 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4269 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4270 & dersc0(2),esclocbi,dersc02)
4271 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4273 call splinthet(x(2),0.5d0*delta,ss,ssd)
4278 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4280 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4281 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4283 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4285 c write (iout,*) escloci
4286 else if (x(2).lt.delta) then
4290 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4292 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4293 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4295 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4296 & ddersc0(1),dersc(1))
4297 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4298 & ddersc0(3),dersc(3))
4300 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4302 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4303 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4304 & dersc0(2),esclocbi,dersc02)
4305 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4310 call splinthet(x(2),0.5d0*delta,ss,ssd)
4312 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4314 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4315 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4317 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4318 c write (iout,*) escloci
4320 call enesc(x,escloci,dersc,ddummy,.false.)
4323 escloc=escloc+escloci
4324 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4326 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4328 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4329 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4334 C---------------------------------------------------------------------------
4335 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4336 implicit real*8 (a-h,o-z)
4337 include 'DIMENSIONS'
4338 include 'COMMON.GEO'
4339 include 'COMMON.LOCAL'
4340 include 'COMMON.IOUNITS'
4341 common /sccalc/ time11,time12,time112,theti,it,nlobit
4342 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4343 double precision contr(maxlob,-1:1)
4345 c write (iout,*) 'it=',it,' nlobit=',nlobit
4349 if (mixed) ddersc(j)=0.0d0
4353 C Because of periodicity of the dependence of the SC energy in omega we have
4354 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4355 C To avoid underflows, first compute & store the exponents.
4363 z(k)=x(k)-censc(k,j,it)
4368 Axk=Axk+gaussc(l,k,j,it)*z(l)
4374 expfac=expfac+Ax(k,j,iii)*z(k)
4382 C As in the case of ebend, we want to avoid underflows in exponentiation and
4383 C subsequent NaNs and INFs in energy calculation.
4384 C Find the largest exponent
4388 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4392 cd print *,'it=',it,' emin=',emin
4394 C Compute the contribution to SC energy and derivatives
4398 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4399 cd print *,'j=',j,' expfac=',expfac
4400 escloc_i=escloc_i+expfac
4402 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4406 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4407 & +gaussc(k,2,j,it))*expfac
4414 dersc(1)=dersc(1)/cos(theti)**2
4415 ddersc(1)=ddersc(1)/cos(theti)**2
4418 escloci=-(dlog(escloc_i)-emin)
4420 dersc(j)=dersc(j)/escloc_i
4424 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4429 C------------------------------------------------------------------------------
4430 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4431 implicit real*8 (a-h,o-z)
4432 include 'DIMENSIONS'
4433 include 'COMMON.GEO'
4434 include 'COMMON.LOCAL'
4435 include 'COMMON.IOUNITS'
4436 common /sccalc/ time11,time12,time112,theti,it,nlobit
4437 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4438 double precision contr(maxlob)
4449 z(k)=x(k)-censc(k,j,it)
4455 Axk=Axk+gaussc(l,k,j,it)*z(l)
4461 expfac=expfac+Ax(k,j)*z(k)
4466 C As in the case of ebend, we want to avoid underflows in exponentiation and
4467 C subsequent NaNs and INFs in energy calculation.
4468 C Find the largest exponent
4471 if (emin.gt.contr(j)) emin=contr(j)
4475 C Compute the contribution to SC energy and derivatives
4479 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4480 escloc_i=escloc_i+expfac
4482 dersc(k)=dersc(k)+Ax(k,j)*expfac
4484 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4485 & +gaussc(1,2,j,it))*expfac
4489 dersc(1)=dersc(1)/cos(theti)**2
4490 dersc12=dersc12/cos(theti)**2
4491 escloci=-(dlog(escloc_i)-emin)
4493 dersc(j)=dersc(j)/escloc_i
4495 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4499 c----------------------------------------------------------------------------------
4500 subroutine esc(escloc)
4501 C Calculate the local energy of a side chain and its derivatives in the
4502 C corresponding virtual-bond valence angles THETA and the spherical angles
4503 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4504 C added by Urszula Kozlowska. 07/11/2007
4506 implicit real*8 (a-h,o-z)
4507 include 'DIMENSIONS'
4508 include 'COMMON.GEO'
4509 include 'COMMON.LOCAL'
4510 include 'COMMON.VAR'
4511 include 'COMMON.SCROT'
4512 include 'COMMON.INTERACT'
4513 include 'COMMON.DERIV'
4514 include 'COMMON.CHAIN'
4515 include 'COMMON.IOUNITS'
4516 include 'COMMON.NAMES'
4517 include 'COMMON.FFIELD'
4518 include 'COMMON.CONTROL'
4519 include 'COMMON.VECTORS'
4520 double precision x_prime(3),y_prime(3),z_prime(3)
4521 & , sumene,dsc_i,dp2_i,x(65),
4522 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4523 & de_dxx,de_dyy,de_dzz,de_dt
4524 double precision s1_t,s1_6_t,s2_t,s2_6_t
4526 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4527 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4528 & dt_dCi(3),dt_dCi1(3)
4529 common /sccalc/ time11,time12,time112,theti,it,nlobit
4532 do i=loc_start,loc_end
4533 costtab(i+1) =dcos(theta(i+1))
4534 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4535 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4536 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4537 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4538 cosfac=dsqrt(cosfac2)
4539 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4540 sinfac=dsqrt(sinfac2)
4542 if (it.eq.10) goto 1
4544 C Compute the axes of tghe local cartesian coordinates system; store in
4545 c x_prime, y_prime and z_prime
4552 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4553 C & dc_norm(3,i+nres)
4555 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4556 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4559 z_prime(j) = -uz(j,i-1)
4562 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4563 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4564 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4565 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4566 c & " xy",scalar(x_prime(1),y_prime(1)),
4567 c & " xz",scalar(x_prime(1),z_prime(1)),
4568 c & " yy",scalar(y_prime(1),y_prime(1)),
4569 c & " yz",scalar(y_prime(1),z_prime(1)),
4570 c & " zz",scalar(z_prime(1),z_prime(1))
4572 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4573 C to local coordinate system. Store in xx, yy, zz.
4579 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4580 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4581 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4588 C Compute the energy of the ith side cbain
4590 c write (2,*) "xx",xx," yy",yy," zz",zz
4593 x(j) = sc_parmin(j,it)
4596 Cc diagnostics - remove later
4598 yy1 = dsin(alph(2))*dcos(omeg(2))
4599 zz1 = -dsin(alph(2))*dsin(omeg(2))
4600 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4601 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4603 C," --- ", xx_w,yy_w,zz_w
4606 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4607 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4609 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4610 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4612 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4613 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4614 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4615 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4616 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4618 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4619 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4620 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4621 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4622 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4624 dsc_i = 0.743d0+x(61)
4626 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4627 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4628 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4629 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4630 s1=(1+x(63))/(0.1d0 + dscp1)
4631 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4632 s2=(1+x(65))/(0.1d0 + dscp2)
4633 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4634 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4635 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4636 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4638 c & dscp1,dscp2,sumene
4639 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4640 escloc = escloc + sumene
4641 c write (2,*) "escloc",escloc
4642 if (.not. calc_grad) goto 1
4645 C This section to check the numerical derivatives of the energy of ith side
4646 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4647 C #define DEBUG in the code to turn it on.
4649 write (2,*) "sumene =",sumene
4653 write (2,*) xx,yy,zz
4654 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4655 de_dxx_num=(sumenep-sumene)/aincr
4657 write (2,*) "xx+ sumene from enesc=",sumenep
4660 write (2,*) xx,yy,zz
4661 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4662 de_dyy_num=(sumenep-sumene)/aincr
4664 write (2,*) "yy+ sumene from enesc=",sumenep
4667 write (2,*) xx,yy,zz
4668 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4669 de_dzz_num=(sumenep-sumene)/aincr
4671 write (2,*) "zz+ sumene from enesc=",sumenep
4672 costsave=cost2tab(i+1)
4673 sintsave=sint2tab(i+1)
4674 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4675 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4676 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4677 de_dt_num=(sumenep-sumene)/aincr
4678 write (2,*) " t+ sumene from enesc=",sumenep
4679 cost2tab(i+1)=costsave
4680 sint2tab(i+1)=sintsave
4681 C End of diagnostics section.
4684 C Compute the gradient of esc
4686 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4687 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4688 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4689 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4690 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4691 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4692 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4693 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4694 pom1=(sumene3*sint2tab(i+1)+sumene1)
4695 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4696 pom2=(sumene4*cost2tab(i+1)+sumene2)
4697 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4698 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4699 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4700 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4702 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4703 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4704 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4706 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4707 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4708 & +(pom1+pom2)*pom_dx
4710 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4713 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4714 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4715 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4717 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4718 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4719 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4720 & +x(59)*zz**2 +x(60)*xx*zz
4721 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4722 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4723 & +(pom1-pom2)*pom_dy
4725 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4728 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4729 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4730 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4731 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4732 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4733 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4734 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4735 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4737 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4740 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4741 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4742 & +pom1*pom_dt1+pom2*pom_dt2
4744 write(2,*), "de_dt = ", de_dt,de_dt_num
4748 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4749 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4750 cosfac2xx=cosfac2*xx
4751 sinfac2yy=sinfac2*yy
4753 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4755 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4757 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4758 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4759 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4760 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4761 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4762 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4763 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4764 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4765 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4766 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4770 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4771 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4774 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4775 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4776 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4778 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4779 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4783 dXX_Ctab(k,i)=dXX_Ci(k)
4784 dXX_C1tab(k,i)=dXX_Ci1(k)
4785 dYY_Ctab(k,i)=dYY_Ci(k)
4786 dYY_C1tab(k,i)=dYY_Ci1(k)
4787 dZZ_Ctab(k,i)=dZZ_Ci(k)
4788 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4789 dXX_XYZtab(k,i)=dXX_XYZ(k)
4790 dYY_XYZtab(k,i)=dYY_XYZ(k)
4791 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4795 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4796 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4797 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4798 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4799 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4801 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4802 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4803 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4804 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4805 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4806 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4807 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4808 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4810 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4811 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4813 C to check gradient call subroutine check_grad
4820 c------------------------------------------------------------------------------
4821 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4823 C This procedure calculates two-body contact function g(rij) and its derivative:
4826 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4829 C where x=(rij-r0ij)/delta
4831 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4834 double precision rij,r0ij,eps0ij,fcont,fprimcont
4835 double precision x,x2,x4,delta
4839 if (x.lt.-1.0D0) then
4842 else if (x.le.1.0D0) then
4845 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4846 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4853 c------------------------------------------------------------------------------
4854 subroutine splinthet(theti,delta,ss,ssder)
4855 implicit real*8 (a-h,o-z)
4856 include 'DIMENSIONS'
4857 include 'sizesclu.dat'
4858 include 'COMMON.VAR'
4859 include 'COMMON.GEO'
4862 if (theti.gt.pipol) then
4863 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4865 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4870 c------------------------------------------------------------------------------
4871 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4873 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4874 double precision ksi,ksi2,ksi3,a1,a2,a3
4875 a1=fprim0*delta/(f1-f0)
4881 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4882 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4885 c------------------------------------------------------------------------------
4886 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4888 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4889 double precision ksi,ksi2,ksi3,a1,a2,a3
4894 a2=3*(f1x-f0x)-2*fprim0x*delta
4895 a3=fprim0x*delta-2*(f1x-f0x)
4896 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4899 C-----------------------------------------------------------------------------
4901 C-----------------------------------------------------------------------------
4902 subroutine etor(etors,edihcnstr,fact)
4903 implicit real*8 (a-h,o-z)
4904 include 'DIMENSIONS'
4905 include 'sizesclu.dat'
4906 include 'COMMON.VAR'
4907 include 'COMMON.GEO'
4908 include 'COMMON.LOCAL'
4909 include 'COMMON.TORSION'
4910 include 'COMMON.INTERACT'
4911 include 'COMMON.DERIV'
4912 include 'COMMON.CHAIN'
4913 include 'COMMON.NAMES'
4914 include 'COMMON.IOUNITS'
4915 include 'COMMON.FFIELD'
4916 include 'COMMON.TORCNSTR'
4918 C Set lprn=.true. for debugging
4922 do i=iphi_start,iphi_end
4923 itori=itortyp(itype(i-2))
4924 itori1=itortyp(itype(i-1))
4927 C Proline-Proline pair is a special case...
4928 if (itori.eq.3 .and. itori1.eq.3) then
4929 if (phii.gt.-dwapi3) then
4931 fac=1.0D0/(1.0D0-cosphi)
4932 etorsi=v1(1,3,3)*fac
4933 etorsi=etorsi+etorsi
4934 etors=etors+etorsi-v1(1,3,3)
4935 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4938 v1ij=v1(j+1,itori,itori1)
4939 v2ij=v2(j+1,itori,itori1)
4942 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4943 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4947 v1ij=v1(j,itori,itori1)
4948 v2ij=v2(j,itori,itori1)
4951 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4952 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4956 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4957 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4958 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4959 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4960 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4962 ! 6/20/98 - dihedral angle constraints
4965 itori=idih_constr(i)
4967 difi=pinorm(phii-phi0(i))
4968 if (difi.gt.drange(i)) then
4970 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4971 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4972 else if (difi.lt.-drange(i)) then
4974 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4975 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4977 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4978 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4980 write (iout,*) 'edihcnstr',edihcnstr
4983 c------------------------------------------------------------------------------
4985 subroutine etor(etors,edihcnstr,fact)
4986 implicit real*8 (a-h,o-z)
4987 include 'DIMENSIONS'
4988 include 'sizesclu.dat'
4989 include 'COMMON.VAR'
4990 include 'COMMON.GEO'
4991 include 'COMMON.LOCAL'
4992 include 'COMMON.TORSION'
4993 include 'COMMON.INTERACT'
4994 include 'COMMON.DERIV'
4995 include 'COMMON.CHAIN'
4996 include 'COMMON.NAMES'
4997 include 'COMMON.IOUNITS'
4998 include 'COMMON.FFIELD'
4999 include 'COMMON.TORCNSTR'
5001 C Set lprn=.true. for debugging
5005 do i=iphi_start,iphi_end
5006 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5007 itori=itortyp(itype(i-2))
5008 itori1=itortyp(itype(i-1))
5011 C Regular cosine and sine terms
5012 do j=1,nterm(itori,itori1)
5013 v1ij=v1(j,itori,itori1)
5014 v2ij=v2(j,itori,itori1)
5017 etors=etors+v1ij*cosphi+v2ij*sinphi
5018 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5022 C E = SUM ----------------------------------- - v1
5023 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5025 cosphi=dcos(0.5d0*phii)
5026 sinphi=dsin(0.5d0*phii)
5027 do j=1,nlor(itori,itori1)
5028 vl1ij=vlor1(j,itori,itori1)
5029 vl2ij=vlor2(j,itori,itori1)
5030 vl3ij=vlor3(j,itori,itori1)
5031 pom=vl2ij*cosphi+vl3ij*sinphi
5032 pom1=1.0d0/(pom*pom+1.0d0)
5033 etors=etors+vl1ij*pom1
5035 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5037 C Subtract the constant term
5038 etors=etors-v0(itori,itori1)
5040 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5041 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5042 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5043 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5044 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5047 ! 6/20/98 - dihedral angle constraints
5049 c write (iout,*) "Dihedral angle restraint energy"
5051 itori=idih_constr(i)
5053 difi=pinorm(phii-phi0(i))
5054 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5055 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
5056 if (difi.gt.drange(i)) then
5058 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5059 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5060 c write (iout,*) 0.25d0*ftors*difi**4
5061 else if (difi.lt.-drange(i)) then
5063 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5064 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5065 c write (iout,*) 0.25d0*ftors*difi**4
5068 c write (iout,*) 'edihcnstr',edihcnstr
5071 c----------------------------------------------------------------------------
5072 subroutine etor_d(etors_d,fact2)
5073 C 6/23/01 Compute double torsional energy
5074 implicit real*8 (a-h,o-z)
5075 include 'DIMENSIONS'
5076 include 'sizesclu.dat'
5077 include 'COMMON.VAR'
5078 include 'COMMON.GEO'
5079 include 'COMMON.LOCAL'
5080 include 'COMMON.TORSION'
5081 include 'COMMON.INTERACT'
5082 include 'COMMON.DERIV'
5083 include 'COMMON.CHAIN'
5084 include 'COMMON.NAMES'
5085 include 'COMMON.IOUNITS'
5086 include 'COMMON.FFIELD'
5087 include 'COMMON.TORCNSTR'
5089 C Set lprn=.true. for debugging
5093 do i=iphi_start,iphi_end-1
5094 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5096 itori=itortyp(itype(i-2))
5097 itori1=itortyp(itype(i-1))
5098 itori2=itortyp(itype(i))
5103 C Regular cosine and sine terms
5104 do j=1,ntermd_1(itori,itori1,itori2)
5105 v1cij=v1c(1,j,itori,itori1,itori2)
5106 v1sij=v1s(1,j,itori,itori1,itori2)
5107 v2cij=v1c(2,j,itori,itori1,itori2)
5108 v2sij=v1s(2,j,itori,itori1,itori2)
5109 cosphi1=dcos(j*phii)
5110 sinphi1=dsin(j*phii)
5111 cosphi2=dcos(j*phii1)
5112 sinphi2=dsin(j*phii1)
5113 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5114 & v2cij*cosphi2+v2sij*sinphi2
5115 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5116 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5118 do k=2,ntermd_2(itori,itori1,itori2)
5120 v1cdij = v2c(k,l,itori,itori1,itori2)
5121 v2cdij = v2c(l,k,itori,itori1,itori2)
5122 v1sdij = v2s(k,l,itori,itori1,itori2)
5123 v2sdij = v2s(l,k,itori,itori1,itori2)
5124 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5125 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5126 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5127 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5128 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5129 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5130 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5131 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5132 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5133 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5136 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5137 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5143 c------------------------------------------------------------------------------
5144 subroutine eback_sc_corr(esccor,fact)
5145 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5146 c conformational states; temporarily implemented as differences
5147 c between UNRES torsional potentials (dependent on three types of
5148 c residues) and the torsional potentials dependent on all 20 types
5149 c of residues computed from AM1 energy surfaces of terminally-blocked
5150 c amino-acid residues.
5151 implicit real*8 (a-h,o-z)
5152 include 'DIMENSIONS'
5153 include 'COMMON.VAR'
5154 include 'COMMON.GEO'
5155 include 'COMMON.LOCAL'
5156 include 'COMMON.TORSION'
5157 include 'COMMON.SCCOR'
5158 include 'COMMON.INTERACT'
5159 include 'COMMON.DERIV'
5160 include 'COMMON.CHAIN'
5161 include 'COMMON.NAMES'
5162 include 'COMMON.IOUNITS'
5163 include 'COMMON.FFIELD'
5164 include 'COMMON.CONTROL'
5166 C Set lprn=.true. for debugging
5169 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5171 do i=itau_start,itau_end
5173 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5174 isccori=isccortyp(itype(i-2))
5175 isccori1=isccortyp(itype(i-1))
5177 cccc Added 9 May 2012
5178 cc Tauangle is torsional engle depending on the value of first digit
5179 c(see comment below)
5180 cc Omicron is flat angle depending on the value of first digit
5181 c(see comment below)
5184 do intertyp=1,3 !intertyp
5185 cc Added 09 May 2012 (Adasko)
5186 cc Intertyp means interaction type of backbone mainchain correlation:
5187 c 1 = SC...Ca...Ca...Ca
5188 c 2 = Ca...Ca...Ca...SC
5189 c 3 = SC...Ca...Ca...SCi
5191 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5192 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5193 & (itype(i-1).eq.21)))
5194 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5195 & .or.(itype(i-2).eq.21)))
5196 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5197 & (itype(i-1).eq.21)))) cycle
5198 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5199 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5201 do j=1,nterm_sccor(isccori,isccori1)
5202 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5203 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5204 cosphi=dcos(j*tauangle(intertyp,i))
5205 sinphi=dsin(j*tauangle(intertyp,i))
5206 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5208 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5210 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5212 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5213 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5214 c &gloc_sc(intertyp,i-3,icg)
5216 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5217 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5218 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5219 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5220 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5223 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5229 c------------------------------------------------------------------------------
5230 subroutine multibody(ecorr)
5231 C This subroutine calculates multi-body contributions to energy following
5232 C the idea of Skolnick et al. If side chains I and J make a contact and
5233 C at the same time side chains I+1 and J+1 make a contact, an extra
5234 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5235 implicit real*8 (a-h,o-z)
5236 include 'DIMENSIONS'
5237 include 'COMMON.IOUNITS'
5238 include 'COMMON.DERIV'
5239 include 'COMMON.INTERACT'
5240 include 'COMMON.CONTACTS'
5241 double precision gx(3),gx1(3)
5244 C Set lprn=.true. for debugging
5248 write (iout,'(a)') 'Contact function values:'
5250 write (iout,'(i2,20(1x,i2,f10.5))')
5251 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5266 num_conti=num_cont(i)
5267 num_conti1=num_cont(i1)
5272 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5273 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5274 cd & ' ishift=',ishift
5275 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5276 C The system gains extra energy.
5277 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5278 endif ! j1==j+-ishift
5287 c------------------------------------------------------------------------------
5288 double precision function esccorr(i,j,k,l,jj,kk)
5289 implicit real*8 (a-h,o-z)
5290 include 'DIMENSIONS'
5291 include 'COMMON.IOUNITS'
5292 include 'COMMON.DERIV'
5293 include 'COMMON.INTERACT'
5294 include 'COMMON.CONTACTS'
5295 double precision gx(3),gx1(3)
5300 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5301 C Calculate the multi-body contribution to energy.
5302 C Calculate multi-body contributions to the gradient.
5303 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5304 cd & k,l,(gacont(m,kk,k),m=1,3)
5306 gx(m) =ekl*gacont(m,jj,i)
5307 gx1(m)=eij*gacont(m,kk,k)
5308 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5309 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5310 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5311 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5315 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5320 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5326 c------------------------------------------------------------------------------
5328 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5329 implicit real*8 (a-h,o-z)
5330 include 'DIMENSIONS'
5331 integer dimen1,dimen2,atom,indx
5332 double precision buffer(dimen1,dimen2)
5333 double precision zapas
5334 common /contacts_hb/ zapas(3,20,maxres,7),
5335 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5336 & num_cont_hb(maxres),jcont_hb(20,maxres)
5337 num_kont=num_cont_hb(atom)
5341 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5344 buffer(i,indx+22)=facont_hb(i,atom)
5345 buffer(i,indx+23)=ees0p(i,atom)
5346 buffer(i,indx+24)=ees0m(i,atom)
5347 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5349 buffer(1,indx+26)=dfloat(num_kont)
5352 c------------------------------------------------------------------------------
5353 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5354 implicit real*8 (a-h,o-z)
5355 include 'DIMENSIONS'
5356 integer dimen1,dimen2,atom,indx
5357 double precision buffer(dimen1,dimen2)
5358 double precision zapas
5359 common /contacts_hb/ zapas(3,20,maxres,7),
5360 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5361 & num_cont_hb(maxres),jcont_hb(20,maxres)
5362 num_kont=buffer(1,indx+26)
5363 num_kont_old=num_cont_hb(atom)
5364 num_cont_hb(atom)=num_kont+num_kont_old
5369 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5372 facont_hb(ii,atom)=buffer(i,indx+22)
5373 ees0p(ii,atom)=buffer(i,indx+23)
5374 ees0m(ii,atom)=buffer(i,indx+24)
5375 jcont_hb(ii,atom)=buffer(i,indx+25)
5379 c------------------------------------------------------------------------------
5381 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5382 C This subroutine calculates multi-body contributions to hydrogen-bonding
5383 implicit real*8 (a-h,o-z)
5384 include 'DIMENSIONS'
5385 include 'sizesclu.dat'
5386 include 'COMMON.IOUNITS'
5388 include 'COMMON.INFO'
5390 include 'COMMON.FFIELD'
5391 include 'COMMON.DERIV'
5392 include 'COMMON.INTERACT'
5393 include 'COMMON.CONTACTS'
5395 parameter (max_cont=maxconts)
5396 parameter (max_dim=2*(8*3+2))
5397 parameter (msglen1=max_cont*max_dim*4)
5398 parameter (msglen2=2*msglen1)
5399 integer source,CorrelType,CorrelID,Error
5400 double precision buffer(max_cont,max_dim)
5402 double precision gx(3),gx1(3)
5405 C Set lprn=.true. for debugging
5410 if (fgProcs.le.1) goto 30
5412 write (iout,'(a)') 'Contact function values:'
5414 write (iout,'(2i3,50(1x,i2,f5.2))')
5415 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5416 & j=1,num_cont_hb(i))
5419 C Caution! Following code assumes that electrostatic interactions concerning
5420 C a given atom are split among at most two processors!
5430 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5433 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5434 if (MyRank.gt.0) then
5435 C Send correlation contributions to the preceding processor
5437 nn=num_cont_hb(iatel_s)
5438 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5439 cd write (iout,*) 'The BUFFER array:'
5441 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5443 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5445 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5446 C Clear the contacts of the atom passed to the neighboring processor
5447 nn=num_cont_hb(iatel_s+1)
5449 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5451 num_cont_hb(iatel_s)=0
5453 cd write (iout,*) 'Processor ',MyID,MyRank,
5454 cd & ' is sending correlation contribution to processor',MyID-1,
5455 cd & ' msglen=',msglen
5456 cd write (*,*) 'Processor ',MyID,MyRank,
5457 cd & ' is sending correlation contribution to processor',MyID-1,
5458 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5459 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5460 cd write (iout,*) 'Processor ',MyID,
5461 cd & ' has sent correlation contribution to processor',MyID-1,
5462 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5463 cd write (*,*) 'Processor ',MyID,
5464 cd & ' has sent correlation contribution to processor',MyID-1,
5465 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5467 endif ! (MyRank.gt.0)
5471 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5472 if (MyRank.lt.fgProcs-1) then
5473 C Receive correlation contributions from the next processor
5475 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5476 cd write (iout,*) 'Processor',MyID,
5477 cd & ' is receiving correlation contribution from processor',MyID+1,
5478 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5479 cd write (*,*) 'Processor',MyID,
5480 cd & ' is receiving correlation contribution from processor',MyID+1,
5481 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5483 do while (nbytes.le.0)
5484 call mp_probe(MyID+1,CorrelType,nbytes)
5486 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5487 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5488 cd write (iout,*) 'Processor',MyID,
5489 cd & ' has received correlation contribution from processor',MyID+1,
5490 cd & ' msglen=',msglen,' nbytes=',nbytes
5491 cd write (iout,*) 'The received BUFFER array:'
5493 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5495 if (msglen.eq.msglen1) then
5496 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5497 else if (msglen.eq.msglen2) then
5498 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5499 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5502 & 'ERROR!!!! message length changed while processing correlations.'
5504 & 'ERROR!!!! message length changed while processing correlations.'
5505 call mp_stopall(Error)
5506 endif ! msglen.eq.msglen1
5507 endif ! MyRank.lt.fgProcs-1
5514 write (iout,'(a)') 'Contact function values:'
5516 write (iout,'(2i3,50(1x,i2,f5.2))')
5517 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5518 & j=1,num_cont_hb(i))
5522 C Remove the loop below after debugging !!!
5529 C Calculate the local-electrostatic correlation terms
5530 do i=iatel_s,iatel_e+1
5532 num_conti=num_cont_hb(i)
5533 num_conti1=num_cont_hb(i+1)
5538 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5539 c & ' jj=',jj,' kk=',kk
5540 if (j1.eq.j+1 .or. j1.eq.j-1) then
5541 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5542 C The system gains extra energy.
5543 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5545 else if (j1.eq.j) then
5546 C Contacts I-J and I-(J+1) occur simultaneously.
5547 C The system loses extra energy.
5548 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5553 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5554 c & ' jj=',jj,' kk=',kk
5556 C Contacts I-J and (I+1)-J occur simultaneously.
5557 C The system loses extra energy.
5558 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5565 c------------------------------------------------------------------------------
5566 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5568 C This subroutine calculates multi-body contributions to hydrogen-bonding
5569 implicit real*8 (a-h,o-z)
5570 include 'DIMENSIONS'
5571 include 'sizesclu.dat'
5572 include 'COMMON.IOUNITS'
5574 include 'COMMON.INFO'
5576 include 'COMMON.FFIELD'
5577 include 'COMMON.DERIV'
5578 include 'COMMON.INTERACT'
5579 include 'COMMON.CONTACTS'
5581 parameter (max_cont=maxconts)
5582 parameter (max_dim=2*(8*3+2))
5583 parameter (msglen1=max_cont*max_dim*4)
5584 parameter (msglen2=2*msglen1)
5585 integer source,CorrelType,CorrelID,Error
5586 double precision buffer(max_cont,max_dim)
5588 double precision gx(3),gx1(3)
5591 C Set lprn=.true. for debugging
5598 if (fgProcs.le.1) goto 30
5600 write (iout,'(a)') 'Contact function values:'
5602 write (iout,'(2i3,50(1x,i2,f5.2))')
5603 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5604 & j=1,num_cont_hb(i))
5607 C Caution! Following code assumes that electrostatic interactions concerning
5608 C a given atom are split among at most two processors!
5618 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5621 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5622 if (MyRank.gt.0) then
5623 C Send correlation contributions to the preceding processor
5625 nn=num_cont_hb(iatel_s)
5626 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5627 cd write (iout,*) 'The BUFFER array:'
5629 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5631 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5633 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5634 C Clear the contacts of the atom passed to the neighboring processor
5635 nn=num_cont_hb(iatel_s+1)
5637 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5639 num_cont_hb(iatel_s)=0
5641 cd write (iout,*) 'Processor ',MyID,MyRank,
5642 cd & ' is sending correlation contribution to processor',MyID-1,
5643 cd & ' msglen=',msglen
5644 cd write (*,*) 'Processor ',MyID,MyRank,
5645 cd & ' is sending correlation contribution to processor',MyID-1,
5646 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5647 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5648 cd write (iout,*) 'Processor ',MyID,
5649 cd & ' has sent correlation contribution to processor',MyID-1,
5650 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5651 cd write (*,*) 'Processor ',MyID,
5652 cd & ' has sent correlation contribution to processor',MyID-1,
5653 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5655 endif ! (MyRank.gt.0)
5659 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5660 if (MyRank.lt.fgProcs-1) then
5661 C Receive correlation contributions from the next processor
5663 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5664 cd write (iout,*) 'Processor',MyID,
5665 cd & ' is receiving correlation contribution from processor',MyID+1,
5666 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5667 cd write (*,*) 'Processor',MyID,
5668 cd & ' is receiving correlation contribution from processor',MyID+1,
5669 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5671 do while (nbytes.le.0)
5672 call mp_probe(MyID+1,CorrelType,nbytes)
5674 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5675 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5676 cd write (iout,*) 'Processor',MyID,
5677 cd & ' has received correlation contribution from processor',MyID+1,
5678 cd & ' msglen=',msglen,' nbytes=',nbytes
5679 cd write (iout,*) 'The received BUFFER array:'
5681 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5683 if (msglen.eq.msglen1) then
5684 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5685 else if (msglen.eq.msglen2) then
5686 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5687 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5690 & 'ERROR!!!! message length changed while processing correlations.'
5692 & 'ERROR!!!! message length changed while processing correlations.'
5693 call mp_stopall(Error)
5694 endif ! msglen.eq.msglen1
5695 endif ! MyRank.lt.fgProcs-1
5702 write (iout,'(a)') 'Contact function values:'
5704 write (iout,'(2i3,50(1x,i2,f5.2))')
5705 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5706 & j=1,num_cont_hb(i))
5712 C Remove the loop below after debugging !!!
5719 C Calculate the dipole-dipole interaction energies
5720 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5721 do i=iatel_s,iatel_e+1
5722 num_conti=num_cont_hb(i)
5729 C Calculate the local-electrostatic correlation terms
5730 do i=iatel_s,iatel_e+1
5732 num_conti=num_cont_hb(i)
5733 num_conti1=num_cont_hb(i+1)
5738 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5739 c & ' jj=',jj,' kk=',kk
5740 if (j1.eq.j+1 .or. j1.eq.j-1) then
5741 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5742 C The system gains extra energy.
5744 sqd1=dsqrt(d_cont(jj,i))
5745 sqd2=dsqrt(d_cont(kk,i1))
5746 sred_geom = sqd1*sqd2
5747 IF (sred_geom.lt.cutoff_corr) THEN
5748 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5750 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5751 c & ' jj=',jj,' kk=',kk
5752 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5753 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5755 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5756 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5759 cd write (iout,*) 'sred_geom=',sred_geom,
5760 cd & ' ekont=',ekont,' fprim=',fprimcont
5761 call calc_eello(i,j,i+1,j1,jj,kk)
5762 if (wcorr4.gt.0.0d0)
5763 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5764 if (wcorr5.gt.0.0d0)
5765 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5766 c print *,"wcorr5",ecorr5
5767 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5768 cd write(2,*)'ijkl',i,j,i+1,j1
5769 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5770 & .or. wturn6.eq.0.0d0))then
5771 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5772 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5773 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5774 c & 'ecorr6=',ecorr6, wcorr6
5775 cd write (iout,'(4e15.5)') sred_geom,
5776 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5777 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5778 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5779 else if (wturn6.gt.0.0d0
5780 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5781 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5782 eturn6=eturn6+eello_turn6(i,jj,kk)
5783 cd write (2,*) 'multibody_eello:eturn6',eturn6
5787 else if (j1.eq.j) then
5788 C Contacts I-J and I-(J+1) occur simultaneously.
5789 C The system loses extra energy.
5790 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5795 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5796 c & ' jj=',jj,' kk=',kk
5798 C Contacts I-J and (I+1)-J occur simultaneously.
5799 C The system loses extra energy.
5800 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5807 c------------------------------------------------------------------------------
5808 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5809 implicit real*8 (a-h,o-z)
5810 include 'DIMENSIONS'
5811 include 'COMMON.IOUNITS'
5812 include 'COMMON.DERIV'
5813 include 'COMMON.INTERACT'
5814 include 'COMMON.CONTACTS'
5815 double precision gx(3),gx1(3)
5825 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5826 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5827 C Following 4 lines for diagnostics.
5832 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5834 c write (iout,*)'Contacts have occurred for peptide groups',
5835 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5836 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5837 C Calculate the multi-body contribution to energy.
5838 ecorr=ecorr+ekont*ees
5840 C Calculate multi-body contributions to the gradient.
5842 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5843 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5844 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5845 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5846 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5847 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5848 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5849 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5850 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5851 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5852 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5853 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5854 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5855 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5859 gradcorr(ll,m)=gradcorr(ll,m)+
5860 & ees*ekl*gacont_hbr(ll,jj,i)-
5861 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5862 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5867 gradcorr(ll,m)=gradcorr(ll,m)+
5868 & ees*eij*gacont_hbr(ll,kk,k)-
5869 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5870 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5877 C---------------------------------------------------------------------------
5878 subroutine dipole(i,j,jj)
5879 implicit real*8 (a-h,o-z)
5880 include 'DIMENSIONS'
5881 include 'sizesclu.dat'
5882 include 'COMMON.IOUNITS'
5883 include 'COMMON.CHAIN'
5884 include 'COMMON.FFIELD'
5885 include 'COMMON.DERIV'
5886 include 'COMMON.INTERACT'
5887 include 'COMMON.CONTACTS'
5888 include 'COMMON.TORSION'
5889 include 'COMMON.VAR'
5890 include 'COMMON.GEO'
5891 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5893 iti1 = itortyp(itype(i+1))
5894 if (j.lt.nres-1) then
5895 itj1 = itortyp(itype(j+1))
5900 dipi(iii,1)=Ub2(iii,i)
5901 dipderi(iii)=Ub2der(iii,i)
5902 dipi(iii,2)=b1(iii,iti1)
5903 dipj(iii,1)=Ub2(iii,j)
5904 dipderj(iii)=Ub2der(iii,j)
5905 dipj(iii,2)=b1(iii,itj1)
5909 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5912 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5915 if (.not.calc_grad) return
5920 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5924 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5929 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5930 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5932 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5934 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5936 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5940 C---------------------------------------------------------------------------
5941 subroutine calc_eello(i,j,k,l,jj,kk)
5943 C This subroutine computes matrices and vectors needed to calculate
5944 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5946 implicit real*8 (a-h,o-z)
5947 include 'DIMENSIONS'
5948 include 'sizesclu.dat'
5949 include 'COMMON.IOUNITS'
5950 include 'COMMON.CHAIN'
5951 include 'COMMON.DERIV'
5952 include 'COMMON.INTERACT'
5953 include 'COMMON.CONTACTS'
5954 include 'COMMON.TORSION'
5955 include 'COMMON.VAR'
5956 include 'COMMON.GEO'
5957 include 'COMMON.FFIELD'
5958 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5959 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5962 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5963 cd & ' jj=',jj,' kk=',kk
5964 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5967 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5968 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5971 call transpose2(aa1(1,1),aa1t(1,1))
5972 call transpose2(aa2(1,1),aa2t(1,1))
5975 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5976 & aa1tder(1,1,lll,kkk))
5977 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5978 & aa2tder(1,1,lll,kkk))
5982 C parallel orientation of the two CA-CA-CA frames.
5984 iti=itortyp(itype(i))
5988 itk1=itortyp(itype(k+1))
5989 itj=itortyp(itype(j))
5990 if (l.lt.nres-1) then
5991 itl1=itortyp(itype(l+1))
5995 C A1 kernel(j+1) A2T
5997 cd write (iout,'(3f10.5,5x,3f10.5)')
5998 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6000 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6001 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6002 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6003 C Following matrices are needed only for 6-th order cumulants
6004 IF (wcorr6.gt.0.0d0) THEN
6005 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6006 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6007 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6008 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6009 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6010 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6011 & ADtEAderx(1,1,1,1,1,1))
6013 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6014 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6015 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6016 & ADtEA1derx(1,1,1,1,1,1))
6018 C End 6-th order cumulants
6021 cd write (2,*) 'In calc_eello6'
6023 cd write (2,*) 'iii=',iii
6025 cd write (2,*) 'kkk=',kkk
6027 cd write (2,'(3(2f10.5),5x)')
6028 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6033 call transpose2(EUgder(1,1,k),auxmat(1,1))
6034 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6035 call transpose2(EUg(1,1,k),auxmat(1,1))
6036 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6037 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6041 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6042 & EAEAderx(1,1,lll,kkk,iii,1))
6046 C A1T kernel(i+1) A2
6047 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6048 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6049 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6050 C Following matrices are needed only for 6-th order cumulants
6051 IF (wcorr6.gt.0.0d0) THEN
6052 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6053 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6054 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6055 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6056 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6057 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6058 & ADtEAderx(1,1,1,1,1,2))
6059 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6060 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6061 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6062 & ADtEA1derx(1,1,1,1,1,2))
6064 C End 6-th order cumulants
6065 call transpose2(EUgder(1,1,l),auxmat(1,1))
6066 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6067 call transpose2(EUg(1,1,l),auxmat(1,1))
6068 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6069 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6073 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6074 & EAEAderx(1,1,lll,kkk,iii,2))
6079 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6080 C They are needed only when the fifth- or the sixth-order cumulants are
6082 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6083 call transpose2(AEA(1,1,1),auxmat(1,1))
6084 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6085 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6086 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6087 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6088 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6089 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6090 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6091 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6092 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6093 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6094 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6095 call transpose2(AEA(1,1,2),auxmat(1,1))
6096 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6097 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6098 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6099 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6100 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6101 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6102 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6103 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6104 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6105 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6106 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6107 C Calculate the Cartesian derivatives of the vectors.
6111 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6112 call matvec2(auxmat(1,1),b1(1,iti),
6113 & AEAb1derx(1,lll,kkk,iii,1,1))
6114 call matvec2(auxmat(1,1),Ub2(1,i),
6115 & AEAb2derx(1,lll,kkk,iii,1,1))
6116 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6117 & AEAb1derx(1,lll,kkk,iii,2,1))
6118 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6119 & AEAb2derx(1,lll,kkk,iii,2,1))
6120 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6121 call matvec2(auxmat(1,1),b1(1,itj),
6122 & AEAb1derx(1,lll,kkk,iii,1,2))
6123 call matvec2(auxmat(1,1),Ub2(1,j),
6124 & AEAb2derx(1,lll,kkk,iii,1,2))
6125 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6126 & AEAb1derx(1,lll,kkk,iii,2,2))
6127 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6128 & AEAb2derx(1,lll,kkk,iii,2,2))
6135 C Antiparallel orientation of the two CA-CA-CA frames.
6137 iti=itortyp(itype(i))
6141 itk1=itortyp(itype(k+1))
6142 itl=itortyp(itype(l))
6143 itj=itortyp(itype(j))
6144 if (j.lt.nres-1) then
6145 itj1=itortyp(itype(j+1))
6149 C A2 kernel(j-1)T A1T
6150 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6151 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6152 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6153 C Following matrices are needed only for 6-th order cumulants
6154 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6155 & j.eq.i+4 .and. l.eq.i+3)) THEN
6156 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6157 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6158 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6159 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6160 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6161 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6162 & ADtEAderx(1,1,1,1,1,1))
6163 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6164 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6165 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6166 & ADtEA1derx(1,1,1,1,1,1))
6168 C End 6-th order cumulants
6169 call transpose2(EUgder(1,1,k),auxmat(1,1))
6170 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6171 call transpose2(EUg(1,1,k),auxmat(1,1))
6172 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6173 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6177 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6178 & EAEAderx(1,1,lll,kkk,iii,1))
6182 C A2T kernel(i+1)T A1
6183 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6184 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6185 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6186 C Following matrices are needed only for 6-th order cumulants
6187 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6188 & j.eq.i+4 .and. l.eq.i+3)) THEN
6189 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6190 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6191 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6192 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6193 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6194 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6195 & ADtEAderx(1,1,1,1,1,2))
6196 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6197 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6198 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6199 & ADtEA1derx(1,1,1,1,1,2))
6201 C End 6-th order cumulants
6202 call transpose2(EUgder(1,1,j),auxmat(1,1))
6203 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6204 call transpose2(EUg(1,1,j),auxmat(1,1))
6205 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6206 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6210 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6211 & EAEAderx(1,1,lll,kkk,iii,2))
6216 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6217 C They are needed only when the fifth- or the sixth-order cumulants are
6219 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6220 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6221 call transpose2(AEA(1,1,1),auxmat(1,1))
6222 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6223 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6224 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6225 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6226 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6227 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6228 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6229 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6230 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6231 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6232 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6233 call transpose2(AEA(1,1,2),auxmat(1,1))
6234 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6235 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6236 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6237 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6238 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6239 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6240 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6241 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6242 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6243 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6244 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6245 C Calculate the Cartesian derivatives of the vectors.
6249 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6250 call matvec2(auxmat(1,1),b1(1,iti),
6251 & AEAb1derx(1,lll,kkk,iii,1,1))
6252 call matvec2(auxmat(1,1),Ub2(1,i),
6253 & AEAb2derx(1,lll,kkk,iii,1,1))
6254 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6255 & AEAb1derx(1,lll,kkk,iii,2,1))
6256 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6257 & AEAb2derx(1,lll,kkk,iii,2,1))
6258 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6259 call matvec2(auxmat(1,1),b1(1,itl),
6260 & AEAb1derx(1,lll,kkk,iii,1,2))
6261 call matvec2(auxmat(1,1),Ub2(1,l),
6262 & AEAb2derx(1,lll,kkk,iii,1,2))
6263 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6264 & AEAb1derx(1,lll,kkk,iii,2,2))
6265 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6266 & AEAb2derx(1,lll,kkk,iii,2,2))
6275 C---------------------------------------------------------------------------
6276 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6277 & KK,KKderg,AKA,AKAderg,AKAderx)
6281 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6282 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6283 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6288 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6290 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6293 cd if (lprn) write (2,*) 'In kernel'
6295 cd if (lprn) write (2,*) 'kkk=',kkk
6297 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6298 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6300 cd write (2,*) 'lll=',lll
6301 cd write (2,*) 'iii=1'
6303 cd write (2,'(3(2f10.5),5x)')
6304 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6307 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6308 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6310 cd write (2,*) 'lll=',lll
6311 cd write (2,*) 'iii=2'
6313 cd write (2,'(3(2f10.5),5x)')
6314 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6321 C---------------------------------------------------------------------------
6322 double precision function eello4(i,j,k,l,jj,kk)
6323 implicit real*8 (a-h,o-z)
6324 include 'DIMENSIONS'
6325 include 'sizesclu.dat'
6326 include 'COMMON.IOUNITS'
6327 include 'COMMON.CHAIN'
6328 include 'COMMON.DERIV'
6329 include 'COMMON.INTERACT'
6330 include 'COMMON.CONTACTS'
6331 include 'COMMON.TORSION'
6332 include 'COMMON.VAR'
6333 include 'COMMON.GEO'
6334 double precision pizda(2,2),ggg1(3),ggg2(3)
6335 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6339 cd print *,'eello4:',i,j,k,l,jj,kk
6340 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6341 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6342 cold eij=facont_hb(jj,i)
6343 cold ekl=facont_hb(kk,k)
6345 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6347 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6348 gcorr_loc(k-1)=gcorr_loc(k-1)
6349 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6351 gcorr_loc(l-1)=gcorr_loc(l-1)
6352 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6354 gcorr_loc(j-1)=gcorr_loc(j-1)
6355 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6360 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6361 & -EAEAderx(2,2,lll,kkk,iii,1)
6362 cd derx(lll,kkk,iii)=0.0d0
6366 cd gcorr_loc(l-1)=0.0d0
6367 cd gcorr_loc(j-1)=0.0d0
6368 cd gcorr_loc(k-1)=0.0d0
6370 cd write (iout,*)'Contacts have occurred for peptide groups',
6371 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6372 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6373 if (j.lt.nres-1) then
6380 if (l.lt.nres-1) then
6388 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6389 ggg1(ll)=eel4*g_contij(ll,1)
6390 ggg2(ll)=eel4*g_contij(ll,2)
6391 ghalf=0.5d0*ggg1(ll)
6393 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6394 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6395 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6396 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6397 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6398 ghalf=0.5d0*ggg2(ll)
6400 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6401 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6402 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6403 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6408 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6409 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6414 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6415 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6421 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6426 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6430 cd write (2,*) iii,gcorr_loc(iii)
6434 cd write (2,*) 'ekont',ekont
6435 cd write (iout,*) 'eello4',ekont*eel4
6438 C---------------------------------------------------------------------------
6439 double precision function eello5(i,j,k,l,jj,kk)
6440 implicit real*8 (a-h,o-z)
6441 include 'DIMENSIONS'
6442 include 'sizesclu.dat'
6443 include 'COMMON.IOUNITS'
6444 include 'COMMON.CHAIN'
6445 include 'COMMON.DERIV'
6446 include 'COMMON.INTERACT'
6447 include 'COMMON.CONTACTS'
6448 include 'COMMON.TORSION'
6449 include 'COMMON.VAR'
6450 include 'COMMON.GEO'
6451 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6452 double precision ggg1(3),ggg2(3)
6453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6458 C /l\ / \ \ / \ / \ / C
6459 C / \ / \ \ / \ / \ / C
6460 C j| o |l1 | o | o| o | | o |o C
6461 C \ |/k\| |/ \| / |/ \| |/ \| C
6462 C \i/ \ / \ / / \ / \ C
6464 C (I) (II) (III) (IV) C
6466 C eello5_1 eello5_2 eello5_3 eello5_4 C
6468 C Antiparallel chains C
6471 C /j\ / \ \ / \ / \ / C
6472 C / \ / \ \ / \ / \ / C
6473 C j1| o |l | o | o| o | | o |o C
6474 C \ |/k\| |/ \| / |/ \| |/ \| C
6475 C \i/ \ / \ / / \ / \ C
6477 C (I) (II) (III) (IV) C
6479 C eello5_1 eello5_2 eello5_3 eello5_4 C
6481 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6484 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6489 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6491 itk=itortyp(itype(k))
6492 itl=itortyp(itype(l))
6493 itj=itortyp(itype(j))
6498 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6499 cd & eel5_3_num,eel5_4_num)
6503 derx(lll,kkk,iii)=0.0d0
6507 cd eij=facont_hb(jj,i)
6508 cd ekl=facont_hb(kk,k)
6510 cd write (iout,*)'Contacts have occurred for peptide groups',
6511 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6513 C Contribution from the graph I.
6514 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6515 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6516 call transpose2(EUg(1,1,k),auxmat(1,1))
6517 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6518 vv(1)=pizda(1,1)-pizda(2,2)
6519 vv(2)=pizda(1,2)+pizda(2,1)
6520 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6521 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6523 C Explicit gradient in virtual-dihedral angles.
6524 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6525 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6526 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6527 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6528 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6529 vv(1)=pizda(1,1)-pizda(2,2)
6530 vv(2)=pizda(1,2)+pizda(2,1)
6531 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6532 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6533 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6534 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6535 vv(1)=pizda(1,1)-pizda(2,2)
6536 vv(2)=pizda(1,2)+pizda(2,1)
6538 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6539 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6540 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6542 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6543 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6544 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6546 C Cartesian gradient
6550 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6552 vv(1)=pizda(1,1)-pizda(2,2)
6553 vv(2)=pizda(1,2)+pizda(2,1)
6554 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6555 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6556 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6563 C Contribution from graph II
6564 call transpose2(EE(1,1,itk),auxmat(1,1))
6565 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6566 vv(1)=pizda(1,1)+pizda(2,2)
6567 vv(2)=pizda(2,1)-pizda(1,2)
6568 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6569 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6571 C Explicit gradient in virtual-dihedral angles.
6572 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6573 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6574 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6575 vv(1)=pizda(1,1)+pizda(2,2)
6576 vv(2)=pizda(2,1)-pizda(1,2)
6578 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6579 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6580 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6582 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6583 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6584 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6586 C Cartesian gradient
6590 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6592 vv(1)=pizda(1,1)+pizda(2,2)
6593 vv(2)=pizda(2,1)-pizda(1,2)
6594 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6595 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6596 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6605 C Parallel orientation
6606 C Contribution from graph III
6607 call transpose2(EUg(1,1,l),auxmat(1,1))
6608 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6609 vv(1)=pizda(1,1)-pizda(2,2)
6610 vv(2)=pizda(1,2)+pizda(2,1)
6611 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6612 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6614 C Explicit gradient in virtual-dihedral angles.
6615 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6616 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6617 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6618 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6619 vv(1)=pizda(1,1)-pizda(2,2)
6620 vv(2)=pizda(1,2)+pizda(2,1)
6621 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6622 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6623 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6624 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6625 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6626 vv(1)=pizda(1,1)-pizda(2,2)
6627 vv(2)=pizda(1,2)+pizda(2,1)
6628 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6629 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6630 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6631 C Cartesian gradient
6635 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6637 vv(1)=pizda(1,1)-pizda(2,2)
6638 vv(2)=pizda(1,2)+pizda(2,1)
6639 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6640 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6641 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6647 C Contribution from graph IV
6649 call transpose2(EE(1,1,itl),auxmat(1,1))
6650 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6651 vv(1)=pizda(1,1)+pizda(2,2)
6652 vv(2)=pizda(2,1)-pizda(1,2)
6653 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6654 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6656 C Explicit gradient in virtual-dihedral angles.
6657 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6658 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6659 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6660 vv(1)=pizda(1,1)+pizda(2,2)
6661 vv(2)=pizda(2,1)-pizda(1,2)
6662 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6663 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6664 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6665 C Cartesian gradient
6669 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6671 vv(1)=pizda(1,1)+pizda(2,2)
6672 vv(2)=pizda(2,1)-pizda(1,2)
6673 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6674 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6675 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6681 C Antiparallel orientation
6682 C Contribution from graph III
6684 call transpose2(EUg(1,1,j),auxmat(1,1))
6685 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6686 vv(1)=pizda(1,1)-pizda(2,2)
6687 vv(2)=pizda(1,2)+pizda(2,1)
6688 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6689 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6691 C Explicit gradient in virtual-dihedral angles.
6692 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6693 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6694 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6695 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6696 vv(1)=pizda(1,1)-pizda(2,2)
6697 vv(2)=pizda(1,2)+pizda(2,1)
6698 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6699 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6700 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6701 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6702 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6703 vv(1)=pizda(1,1)-pizda(2,2)
6704 vv(2)=pizda(1,2)+pizda(2,1)
6705 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6706 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6707 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6708 C Cartesian gradient
6712 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6714 vv(1)=pizda(1,1)-pizda(2,2)
6715 vv(2)=pizda(1,2)+pizda(2,1)
6716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6717 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6718 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6724 C Contribution from graph IV
6726 call transpose2(EE(1,1,itj),auxmat(1,1))
6727 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6728 vv(1)=pizda(1,1)+pizda(2,2)
6729 vv(2)=pizda(2,1)-pizda(1,2)
6730 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6731 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6733 C Explicit gradient in virtual-dihedral angles.
6734 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6735 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6736 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6737 vv(1)=pizda(1,1)+pizda(2,2)
6738 vv(2)=pizda(2,1)-pizda(1,2)
6739 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6740 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6741 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6742 C Cartesian gradient
6746 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6748 vv(1)=pizda(1,1)+pizda(2,2)
6749 vv(2)=pizda(2,1)-pizda(1,2)
6750 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6751 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6752 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6759 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6760 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6761 cd write (2,*) 'ijkl',i,j,k,l
6762 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6763 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6765 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6766 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6767 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6768 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6770 if (j.lt.nres-1) then
6777 if (l.lt.nres-1) then
6787 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6789 ggg1(ll)=eel5*g_contij(ll,1)
6790 ggg2(ll)=eel5*g_contij(ll,2)
6791 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6792 ghalf=0.5d0*ggg1(ll)
6794 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6795 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6796 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6797 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6798 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6799 ghalf=0.5d0*ggg2(ll)
6801 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6802 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6803 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6804 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6809 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6810 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6815 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6816 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6822 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6827 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6831 cd write (2,*) iii,g_corr5_loc(iii)
6835 cd write (2,*) 'ekont',ekont
6836 cd write (iout,*) 'eello5',ekont*eel5
6839 c--------------------------------------------------------------------------
6840 double precision function eello6(i,j,k,l,jj,kk)
6841 implicit real*8 (a-h,o-z)
6842 include 'DIMENSIONS'
6843 include 'sizesclu.dat'
6844 include 'COMMON.IOUNITS'
6845 include 'COMMON.CHAIN'
6846 include 'COMMON.DERIV'
6847 include 'COMMON.INTERACT'
6848 include 'COMMON.CONTACTS'
6849 include 'COMMON.TORSION'
6850 include 'COMMON.VAR'
6851 include 'COMMON.GEO'
6852 include 'COMMON.FFIELD'
6853 double precision ggg1(3),ggg2(3)
6854 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6859 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6867 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6868 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6872 derx(lll,kkk,iii)=0.0d0
6876 cd eij=facont_hb(jj,i)
6877 cd ekl=facont_hb(kk,k)
6883 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6884 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6885 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6886 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6887 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6888 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6890 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6891 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6892 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6893 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6894 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6895 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6899 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6901 C If turn contributions are considered, they will be handled separately.
6902 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6903 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6904 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6905 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6906 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6907 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6908 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6911 if (j.lt.nres-1) then
6918 if (l.lt.nres-1) then
6926 ggg1(ll)=eel6*g_contij(ll,1)
6927 ggg2(ll)=eel6*g_contij(ll,2)
6928 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6929 ghalf=0.5d0*ggg1(ll)
6931 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6932 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6933 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6934 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6935 ghalf=0.5d0*ggg2(ll)
6936 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6938 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6939 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6940 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6941 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6946 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6947 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6952 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6953 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6959 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6964 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6968 cd write (2,*) iii,g_corr6_loc(iii)
6972 cd write (2,*) 'ekont',ekont
6973 cd write (iout,*) 'eello6',ekont*eel6
6976 c--------------------------------------------------------------------------
6977 double precision function eello6_graph1(i,j,k,l,imat,swap)
6978 implicit real*8 (a-h,o-z)
6979 include 'DIMENSIONS'
6980 include 'sizesclu.dat'
6981 include 'COMMON.IOUNITS'
6982 include 'COMMON.CHAIN'
6983 include 'COMMON.DERIV'
6984 include 'COMMON.INTERACT'
6985 include 'COMMON.CONTACTS'
6986 include 'COMMON.TORSION'
6987 include 'COMMON.VAR'
6988 include 'COMMON.GEO'
6989 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6993 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6995 C Parallel Antiparallel C
7001 C \ j|/k\| / \ |/k\|l / C
7006 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7007 itk=itortyp(itype(k))
7008 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7009 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7010 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7011 call transpose2(EUgC(1,1,k),auxmat(1,1))
7012 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7013 vv1(1)=pizda1(1,1)-pizda1(2,2)
7014 vv1(2)=pizda1(1,2)+pizda1(2,1)
7015 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7016 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7017 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7018 s5=scalar2(vv(1),Dtobr2(1,i))
7019 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7020 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7021 if (.not. calc_grad) return
7022 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7023 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7024 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7025 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7026 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7027 & +scalar2(vv(1),Dtobr2der(1,i)))
7028 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7029 vv1(1)=pizda1(1,1)-pizda1(2,2)
7030 vv1(2)=pizda1(1,2)+pizda1(2,1)
7031 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7032 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7034 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7035 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7036 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7037 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7038 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7040 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7041 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7042 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7043 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7044 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7046 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7047 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7048 vv1(1)=pizda1(1,1)-pizda1(2,2)
7049 vv1(2)=pizda1(1,2)+pizda1(2,1)
7050 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7051 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7052 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7053 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7062 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7063 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7064 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7065 call transpose2(EUgC(1,1,k),auxmat(1,1))
7066 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7068 vv1(1)=pizda1(1,1)-pizda1(2,2)
7069 vv1(2)=pizda1(1,2)+pizda1(2,1)
7070 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7071 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7072 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7073 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7074 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7075 s5=scalar2(vv(1),Dtobr2(1,i))
7076 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7082 c----------------------------------------------------------------------------
7083 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7084 implicit real*8 (a-h,o-z)
7085 include 'DIMENSIONS'
7086 include 'sizesclu.dat'
7087 include 'COMMON.IOUNITS'
7088 include 'COMMON.CHAIN'
7089 include 'COMMON.DERIV'
7090 include 'COMMON.INTERACT'
7091 include 'COMMON.CONTACTS'
7092 include 'COMMON.TORSION'
7093 include 'COMMON.VAR'
7094 include 'COMMON.GEO'
7096 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7097 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7100 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7102 C Parallel Antiparallel C
7108 C \ j|/k\| \ |/k\|l C
7113 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7114 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7115 C AL 7/4/01 s1 would occur in the sixth-order moment,
7116 C but not in a cluster cumulant
7118 s1=dip(1,jj,i)*dip(1,kk,k)
7120 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7121 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7122 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7123 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7124 call transpose2(EUg(1,1,k),auxmat(1,1))
7125 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7126 vv(1)=pizda(1,1)-pizda(2,2)
7127 vv(2)=pizda(1,2)+pizda(2,1)
7128 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7129 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7131 eello6_graph2=-(s1+s2+s3+s4)
7133 eello6_graph2=-(s2+s3+s4)
7136 if (.not. calc_grad) return
7137 C Derivatives in gamma(i-1)
7140 s1=dipderg(1,jj,i)*dip(1,kk,k)
7142 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7143 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7144 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7145 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7147 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7149 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7151 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7153 C Derivatives in gamma(k-1)
7155 s1=dip(1,jj,i)*dipderg(1,kk,k)
7157 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7158 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7159 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7160 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7161 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7162 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7163 vv(1)=pizda(1,1)-pizda(2,2)
7164 vv(2)=pizda(1,2)+pizda(2,1)
7165 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7167 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7169 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7171 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7172 C Derivatives in gamma(j-1) or gamma(l-1)
7175 s1=dipderg(3,jj,i)*dip(1,kk,k)
7177 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7178 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7179 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7180 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7181 vv(1)=pizda(1,1)-pizda(2,2)
7182 vv(2)=pizda(1,2)+pizda(2,1)
7183 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7186 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7188 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7191 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7192 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7194 C Derivatives in gamma(l-1) or gamma(j-1)
7197 s1=dip(1,jj,i)*dipderg(3,kk,k)
7199 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7200 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7201 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7202 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7203 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7204 vv(1)=pizda(1,1)-pizda(2,2)
7205 vv(2)=pizda(1,2)+pizda(2,1)
7206 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7209 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7211 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7214 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7215 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7217 C Cartesian derivatives.
7219 write (2,*) 'In eello6_graph2'
7221 write (2,*) 'iii=',iii
7223 write (2,*) 'kkk=',kkk
7225 write (2,'(3(2f10.5),5x)')
7226 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7236 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7238 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7241 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7243 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7244 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7246 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7247 call transpose2(EUg(1,1,k),auxmat(1,1))
7248 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7250 vv(1)=pizda(1,1)-pizda(2,2)
7251 vv(2)=pizda(1,2)+pizda(2,1)
7252 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7253 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7255 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7257 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7260 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7262 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7269 c----------------------------------------------------------------------------
7270 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7271 implicit real*8 (a-h,o-z)
7272 include 'DIMENSIONS'
7273 include 'sizesclu.dat'
7274 include 'COMMON.IOUNITS'
7275 include 'COMMON.CHAIN'
7276 include 'COMMON.DERIV'
7277 include 'COMMON.INTERACT'
7278 include 'COMMON.CONTACTS'
7279 include 'COMMON.TORSION'
7280 include 'COMMON.VAR'
7281 include 'COMMON.GEO'
7282 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7284 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7286 C Parallel Antiparallel C
7292 C j|/k\| / |/k\|l / C
7297 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7299 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7300 C energy moment and not to the cluster cumulant.
7301 iti=itortyp(itype(i))
7302 if (j.lt.nres-1) then
7303 itj1=itortyp(itype(j+1))
7307 itk=itortyp(itype(k))
7308 itk1=itortyp(itype(k+1))
7309 if (l.lt.nres-1) then
7310 itl1=itortyp(itype(l+1))
7315 s1=dip(4,jj,i)*dip(4,kk,k)
7317 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7318 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7319 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7320 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7321 call transpose2(EE(1,1,itk),auxmat(1,1))
7322 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7323 vv(1)=pizda(1,1)+pizda(2,2)
7324 vv(2)=pizda(2,1)-pizda(1,2)
7325 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7326 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7328 eello6_graph3=-(s1+s2+s3+s4)
7330 eello6_graph3=-(s2+s3+s4)
7333 if (.not. calc_grad) return
7334 C Derivatives in gamma(k-1)
7335 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7336 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7337 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7338 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7339 C Derivatives in gamma(l-1)
7340 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7341 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7342 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7343 vv(1)=pizda(1,1)+pizda(2,2)
7344 vv(2)=pizda(2,1)-pizda(1,2)
7345 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7346 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7347 C Cartesian derivatives.
7353 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7355 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7358 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7360 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7361 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7363 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7364 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7366 vv(1)=pizda(1,1)+pizda(2,2)
7367 vv(2)=pizda(2,1)-pizda(1,2)
7368 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7370 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7375 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7377 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7379 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7385 c----------------------------------------------------------------------------
7386 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7387 implicit real*8 (a-h,o-z)
7388 include 'DIMENSIONS'
7389 include 'sizesclu.dat'
7390 include 'COMMON.IOUNITS'
7391 include 'COMMON.CHAIN'
7392 include 'COMMON.DERIV'
7393 include 'COMMON.INTERACT'
7394 include 'COMMON.CONTACTS'
7395 include 'COMMON.TORSION'
7396 include 'COMMON.VAR'
7397 include 'COMMON.GEO'
7398 include 'COMMON.FFIELD'
7399 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7400 & auxvec1(2),auxmat1(2,2)
7402 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7404 C Parallel Antiparallel C
7410 C \ j|/k\| \ |/k\|l C
7415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7417 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7418 C energy moment and not to the cluster cumulant.
7419 cd write (2,*) 'eello_graph4: wturn6',wturn6
7420 iti=itortyp(itype(i))
7421 itj=itortyp(itype(j))
7422 if (j.lt.nres-1) then
7423 itj1=itortyp(itype(j+1))
7427 itk=itortyp(itype(k))
7428 if (k.lt.nres-1) then
7429 itk1=itortyp(itype(k+1))
7433 itl=itortyp(itype(l))
7434 if (l.lt.nres-1) then
7435 itl1=itortyp(itype(l+1))
7439 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7440 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7441 cd & ' itl',itl,' itl1',itl1
7444 s1=dip(3,jj,i)*dip(3,kk,k)
7446 s1=dip(2,jj,j)*dip(2,kk,l)
7449 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7450 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7452 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7453 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7455 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7456 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7458 call transpose2(EUg(1,1,k),auxmat(1,1))
7459 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7460 vv(1)=pizda(1,1)-pizda(2,2)
7461 vv(2)=pizda(2,1)+pizda(1,2)
7462 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7463 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7465 eello6_graph4=-(s1+s2+s3+s4)
7467 eello6_graph4=-(s2+s3+s4)
7469 if (.not. calc_grad) return
7470 C Derivatives in gamma(i-1)
7474 s1=dipderg(2,jj,i)*dip(3,kk,k)
7476 s1=dipderg(4,jj,j)*dip(2,kk,l)
7479 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7481 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7482 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7484 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7485 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7487 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7488 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7489 cd write (2,*) 'turn6 derivatives'
7491 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7493 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7497 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7503 C Derivatives in gamma(k-1)
7506 s1=dip(3,jj,i)*dipderg(2,kk,k)
7508 s1=dip(2,jj,j)*dipderg(4,kk,l)
7511 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7512 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7514 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7515 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7517 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7518 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7520 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7521 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7522 vv(1)=pizda(1,1)-pizda(2,2)
7523 vv(2)=pizda(2,1)+pizda(1,2)
7524 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7525 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7527 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7529 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7533 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7538 C Derivatives in gamma(j-1) or gamma(l-1)
7539 if (l.eq.j+1 .and. l.gt.1) then
7540 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7541 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7542 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7543 vv(1)=pizda(1,1)-pizda(2,2)
7544 vv(2)=pizda(2,1)+pizda(1,2)
7545 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7546 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7547 else if (j.gt.1) then
7548 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7549 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7550 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7551 vv(1)=pizda(1,1)-pizda(2,2)
7552 vv(2)=pizda(2,1)+pizda(1,2)
7553 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7554 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7555 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7557 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7560 C Cartesian derivatives.
7567 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7569 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7573 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7575 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7579 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7581 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7583 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7584 & b1(1,itj1),auxvec(1))
7585 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7587 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7588 & b1(1,itl1),auxvec(1))
7589 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7591 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7593 vv(1)=pizda(1,1)-pizda(2,2)
7594 vv(2)=pizda(2,1)+pizda(1,2)
7595 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7597 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7599 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7602 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7605 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7612 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7616 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7618 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7621 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7623 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7631 c----------------------------------------------------------------------------
7632 double precision function eello_turn6(i,jj,kk)
7633 implicit real*8 (a-h,o-z)
7634 include 'DIMENSIONS'
7635 include 'sizesclu.dat'
7636 include 'COMMON.IOUNITS'
7637 include 'COMMON.CHAIN'
7638 include 'COMMON.DERIV'
7639 include 'COMMON.INTERACT'
7640 include 'COMMON.CONTACTS'
7641 include 'COMMON.TORSION'
7642 include 'COMMON.VAR'
7643 include 'COMMON.GEO'
7644 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7645 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7647 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7648 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7649 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7650 C the respective energy moment and not to the cluster cumulant.
7655 iti=itortyp(itype(i))
7656 itk=itortyp(itype(k))
7657 itk1=itortyp(itype(k+1))
7658 itl=itortyp(itype(l))
7659 itj=itortyp(itype(j))
7660 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7661 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7662 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7667 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7669 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7673 derx_turn(lll,kkk,iii)=0.0d0
7680 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7682 cd write (2,*) 'eello6_5',eello6_5
7684 call transpose2(AEA(1,1,1),auxmat(1,1))
7685 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7686 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7687 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7691 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7692 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7693 s2 = scalar2(b1(1,itk),vtemp1(1))
7695 call transpose2(AEA(1,1,2),atemp(1,1))
7696 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7697 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7698 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7702 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7703 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7704 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7706 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7707 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7708 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7709 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7710 ss13 = scalar2(b1(1,itk),vtemp4(1))
7711 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7715 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7721 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7723 C Derivatives in gamma(i+2)
7725 call transpose2(AEA(1,1,1),auxmatd(1,1))
7726 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7727 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7728 call transpose2(AEAderg(1,1,2),atempd(1,1))
7729 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7730 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7734 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7735 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7736 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7742 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7743 C Derivatives in gamma(i+3)
7745 call transpose2(AEA(1,1,1),auxmatd(1,1))
7746 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7747 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7748 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7752 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7753 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7754 s2d = scalar2(b1(1,itk),vtemp1d(1))
7756 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7757 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7759 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7761 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7762 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7763 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7773 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7774 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7776 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7777 & -0.5d0*ekont*(s2d+s12d)
7779 C Derivatives in gamma(i+4)
7780 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7781 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7782 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7784 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7785 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7786 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7796 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7798 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7800 C Derivatives in gamma(i+5)
7802 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7803 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7804 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7808 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7809 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7810 s2d = scalar2(b1(1,itk),vtemp1d(1))
7812 call transpose2(AEA(1,1,2),atempd(1,1))
7813 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7814 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7818 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7819 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7821 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7822 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7823 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7833 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7834 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7836 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7837 & -0.5d0*ekont*(s2d+s12d)
7839 C Cartesian derivatives
7844 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7845 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7846 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7850 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7851 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7853 s2d = scalar2(b1(1,itk),vtemp1d(1))
7855 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7856 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7857 s8d = -(atempd(1,1)+atempd(2,2))*
7858 & scalar2(cc(1,1,itl),vtemp2(1))
7862 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7864 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7865 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7872 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7875 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7879 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7880 & - 0.5d0*(s8d+s12d)
7882 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7891 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7893 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7894 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7895 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7896 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7897 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7899 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7900 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7901 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7905 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7906 cd & 16*eel_turn6_num
7908 if (j.lt.nres-1) then
7915 if (l.lt.nres-1) then
7923 ggg1(ll)=eel_turn6*g_contij(ll,1)
7924 ggg2(ll)=eel_turn6*g_contij(ll,2)
7925 ghalf=0.5d0*ggg1(ll)
7927 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7928 & +ekont*derx_turn(ll,2,1)
7929 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7930 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7931 & +ekont*derx_turn(ll,4,1)
7932 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7933 ghalf=0.5d0*ggg2(ll)
7935 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7936 & +ekont*derx_turn(ll,2,2)
7937 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7938 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7939 & +ekont*derx_turn(ll,4,2)
7940 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7945 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7950 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7956 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7961 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7965 cd write (2,*) iii,g_corr6_loc(iii)
7968 eello_turn6=ekont*eel_turn6
7969 cd write (2,*) 'ekont',ekont
7970 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7973 crc-------------------------------------------------
7974 SUBROUTINE MATVEC2(A1,V1,V2)
7975 implicit real*8 (a-h,o-z)
7976 include 'DIMENSIONS'
7977 DIMENSION A1(2,2),V1(2),V2(2)
7981 c 3 VI=VI+A1(I,K)*V1(K)
7985 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7986 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7991 C---------------------------------------
7992 SUBROUTINE MATMAT2(A1,A2,A3)
7993 implicit real*8 (a-h,o-z)
7994 include 'DIMENSIONS'
7995 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7996 c DIMENSION AI3(2,2)
8000 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8006 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8007 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8008 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8009 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8017 c-------------------------------------------------------------------------
8018 double precision function scalar2(u,v)
8020 double precision u(2),v(2)
8023 scalar2=u(1)*v(1)+u(2)*v(2)
8027 C-----------------------------------------------------------------------------
8029 subroutine transpose2(a,at)
8031 double precision a(2,2),at(2,2)
8038 c--------------------------------------------------------------------------
8039 subroutine transpose(n,a,at)
8042 double precision a(n,n),at(n,n)
8050 C---------------------------------------------------------------------------
8051 subroutine prodmat3(a1,a2,kk,transp,prod)
8054 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8056 crc double precision auxmat(2,2),prod_(2,2)
8059 crc call transpose2(kk(1,1),auxmat(1,1))
8060 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8061 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8063 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8064 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8065 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8066 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8067 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8068 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8069 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8070 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8073 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8074 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8076 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8077 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8078 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8079 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8080 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8081 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8082 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8083 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8086 c call transpose2(a2(1,1),a2t(1,1))
8089 crc print *,((prod_(i,j),i=1,2),j=1,2)
8090 crc print *,((prod(i,j),i=1,2),j=1,2)
8094 C-----------------------------------------------------------------------------
8095 double precision function scalar(u,v)
8097 double precision u(3),v(3)