1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
11 cMS$ATTRIBUTES C :: proc_proc
14 include 'COMMON.IOUNITS'
15 double precision energia(0:max_ene),energia1(0:max_ene+1)
21 include 'COMMON.FFIELD'
22 include 'COMMON.DERIV'
23 include 'COMMON.INTERACT'
24 include 'COMMON.SBRIDGE'
25 include 'COMMON.CHAIN'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
64 C Calculate the disulfide-bridge and other energy and the contributions
65 C from other distance constraints.
66 cd print *,'Calling EHPB'
68 cd print *,'EHPB exitted succesfully.'
70 C Calculate the virtual-bond-angle energy.
73 cd print *,'Bend energy finished.'
75 C Calculate the SC local energy.
78 cd print *,'SCLOC energy finished.'
80 C Calculate the virtual-bond torsional energy.
82 cd print *,'nterm=',nterm
83 call etor(etors,edihcnstr,fact(1))
85 C 6/23/01 Calculate double-torsional energy
87 call etor_d(etors_d,fact(2))
89 C 21/5/07 Calculate local sicdechain correlation energy
91 call eback_sc_corr(esccor)
93 C 12/1/95 Multi-body terms
97 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
98 & .or. wturn6.gt.0.0d0) then
99 c print *,"calling multibody_eello"
100 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
101 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
102 c print *,ecorr,ecorr5,ecorr6,eturn6
104 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
105 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
109 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
110 if (constr_homology.ge.1) then
111 call e_modeller(ehomology_constr)
113 ehomology_constr=0.0d0
116 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
118 C BARTEK for dfa test!
119 if (wdfa_dist.gt.0) call edfad(edfadis)
120 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
121 if (wdfa_tor.gt.0) call edfat(edfator)
122 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
123 if (wdfa_nei.gt.0) call edfan(edfanei)
124 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
125 if (wdfa_beta.gt.0) call edfab(edfabet)
126 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
128 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
130 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
132 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
133 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
134 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
135 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
136 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
137 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
138 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
141 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
142 & +welec*fact(1)*(ees+evdw1)
143 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
144 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
145 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
146 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
147 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
148 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
149 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
155 energia(2)=evdw2-evdw2_14
172 energia(8)=eello_turn3
173 energia(9)=eello_turn4
182 energia(20)=edihcnstr
184 energia(22)=ehomology_constr
189 c if (dyn_ss) call dyn_set_nss
193 if (isnan(etot).ne.0) energia(0)=1.0d+99
195 if (isnan(etot)) energia(0)=1.0d+99
200 idumm=proc_proc(etot,i)
202 call proc_proc(etot,i)
204 if(i.eq.1)energia(0)=1.0d+99
211 C Sum up the components of the Cartesian gradient.
216 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
217 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
219 & wstrain*ghpbc(j,i)+
220 & wcorr*fact(3)*gradcorr(j,i)+
221 & wel_loc*fact(2)*gel_loc(j,i)+
222 & wturn3*fact(2)*gcorr3_turn(j,i)+
223 & wturn4*fact(3)*gcorr4_turn(j,i)+
224 & wcorr5*fact(4)*gradcorr5(j,i)+
225 & wcorr6*fact(5)*gradcorr6(j,i)+
226 & wturn6*fact(5)*gcorr6_turn(j,i)+
227 & wsccor*fact(2)*gsccorc(j,i)+
228 & wdfa_dist*gdfad(j,i)+
229 & wdfa_tor*gdfat(j,i)+
230 & wdfa_nei*gdfan(j,i)+
231 & wdfa_beta*gdfab(j,i)
232 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
234 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
235 & wsccor*fact(2)*gsccorx(j,i)
240 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
241 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
243 & wcorr*fact(3)*gradcorr(j,i)+
244 & wel_loc*fact(2)*gel_loc(j,i)+
245 & wturn3*fact(2)*gcorr3_turn(j,i)+
246 & wturn4*fact(3)*gcorr4_turn(j,i)+
247 & wcorr5*fact(4)*gradcorr5(j,i)+
248 & wcorr6*fact(5)*gradcorr6(j,i)+
249 & wturn6*fact(5)*gcorr6_turn(j,i)+
250 & wsccor*fact(2)*gsccorc(j,i)+
251 & wdfa_dist*gdfad(j,i)+
252 & wdfa_tor*gdfat(j,i)+
253 & wdfa_nei*gdfan(j,i)+
254 & wdfa_beta*gdfab(j,i)
255 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
257 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
258 & wsccor*fact(1)*gsccorx(j,i)
265 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
266 & +wcorr5*fact(4)*g_corr5_loc(i)
267 & +wcorr6*fact(5)*g_corr6_loc(i)
268 & +wturn4*fact(3)*gel_loc_turn4(i)
269 & +wturn3*fact(2)*gel_loc_turn3(i)
270 & +wturn6*fact(5)*gel_loc_turn6(i)
271 & +wel_loc*fact(2)*gel_loc_loc(i)
272 & +wsccor*fact(1)*gsccor_loc(i)
277 C------------------------------------------------------------------------
278 subroutine enerprint(energia,fact)
279 implicit real*8 (a-h,o-z)
281 include 'DIMENSIONS.ZSCOPT'
282 include 'COMMON.IOUNITS'
283 include 'COMMON.FFIELD'
284 include 'COMMON.SBRIDGE'
285 double precision energia(0:max_ene),fact(6)
287 evdw=energia(1)+fact(6)*energia(21)
289 evdw2=energia(2)+energia(17)
301 eello_turn3=energia(8)
302 eello_turn4=energia(9)
303 eello_turn6=energia(10)
310 edihcnstr=energia(20)
312 ehomology_constr=energia(22)
318 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
320 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
321 & etors_d,wtor_d*fact(2),ehpb,wstrain,
322 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
323 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
324 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
325 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
326 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
328 10 format (/'Virtual-chain energies:'//
329 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
330 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
331 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
332 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
333 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
334 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
335 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
336 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
337 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
338 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
339 & ' (SS bridges & dist. cnstr.)'/
340 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
341 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
342 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
343 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
344 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
345 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
346 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
347 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
348 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
349 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
350 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
351 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
352 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
353 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
354 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
355 & 'ETOT= ',1pE16.6,' (total)')
357 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
358 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
359 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
360 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
361 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
362 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
363 & edihcnstr,ehomology_constr,ebr*nss,
364 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
366 10 format (/'Virtual-chain energies:'//
367 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
368 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
369 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
370 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
371 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
372 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
373 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
374 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
375 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
376 & ' (SS bridges & dist. cnstr.)'/
377 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
378 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
379 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
380 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
381 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
382 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
383 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
384 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
385 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
386 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
387 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
388 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
389 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
390 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
391 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
392 & 'ETOT= ',1pE16.6,' (total)')
396 C-----------------------------------------------------------------------
397 subroutine elj(evdw,evdw_t)
399 C This subroutine calculates the interaction energy of nonbonded side chains
400 C assuming the LJ potential of interaction.
402 implicit real*8 (a-h,o-z)
404 include 'DIMENSIONS.ZSCOPT'
405 include "DIMENSIONS.COMPAR"
406 parameter (accur=1.0d-10)
409 include 'COMMON.LOCAL'
410 include 'COMMON.CHAIN'
411 include 'COMMON.DERIV'
412 include 'COMMON.INTERACT'
413 include 'COMMON.TORSION'
414 include 'COMMON.ENEPS'
415 include 'COMMON.SBRIDGE'
416 include 'COMMON.NAMES'
417 include 'COMMON.IOUNITS'
418 include 'COMMON.CONTACTS'
422 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
425 eneps_temp(j,i)=0.0d0
439 C Calculate SC interaction energy.
442 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
443 cd & 'iend=',iend(i,iint)
444 do j=istart(i,iint),iend(i,iint)
449 C Change 12/1/95 to calculate four-body interactions
450 rij=xj*xj+yj*yj+zj*zj
452 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
453 eps0ij=eps(itypi,itypj)
455 e1=fac*fac*aa(itypi,itypj)
456 e2=fac*bb(itypi,itypj)
458 ij=icant(itypi,itypj)
459 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
460 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
461 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
462 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
463 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
464 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
465 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
466 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
467 if (bb(itypi,itypj).gt.0.0d0) then
474 C Calculate the components of the gradient in DC and X
476 fac=-rrij*(e1+evdwij)
481 gvdwx(k,i)=gvdwx(k,i)-gg(k)
482 gvdwx(k,j)=gvdwx(k,j)+gg(k)
486 gvdwc(l,k)=gvdwc(l,k)+gg(l)
491 C 12/1/95, revised on 5/20/97
493 C Calculate the contact function. The ith column of the array JCONT will
494 C contain the numbers of atoms that make contacts with the atom I (of numbers
495 C greater than I). The arrays FACONT and GACONT will contain the values of
496 C the contact function and its derivative.
498 C Uncomment next line, if the correlation interactions include EVDW explicitly.
499 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
500 C Uncomment next line, if the correlation interactions are contact function only
501 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
503 sigij=sigma(itypi,itypj)
504 r0ij=rs0(itypi,itypj)
506 C Check whether the SC's are not too far to make a contact.
509 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
510 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
512 if (fcont.gt.0.0D0) then
513 C If the SC-SC distance if close to sigma, apply spline.
514 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
515 cAdam & fcont1,fprimcont1)
516 cAdam fcont1=1.0d0-fcont1
517 cAdam if (fcont1.gt.0.0d0) then
518 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
519 cAdam fcont=fcont*fcont1
521 C Uncomment following 4 lines to have the geometric average of the epsilon0's
522 cga eps0ij=1.0d0/dsqrt(eps0ij)
524 cga gg(k)=gg(k)*eps0ij
526 cga eps0ij=-evdwij*eps0ij
527 C Uncomment for AL's type of SC correlation interactions.
529 num_conti=num_conti+1
531 facont(num_conti,i)=fcont*eps0ij
532 fprimcont=eps0ij*fprimcont/rij
534 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
535 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
536 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
537 C Uncomment following 3 lines for Skolnick's type of SC correlation.
538 gacont(1,num_conti,i)=-fprimcont*xj
539 gacont(2,num_conti,i)=-fprimcont*yj
540 gacont(3,num_conti,i)=-fprimcont*zj
541 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
542 cd write (iout,'(2i3,3f10.5)')
543 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
549 num_cont(i)=num_conti
554 gvdwc(j,i)=expon*gvdwc(j,i)
555 gvdwx(j,i)=expon*gvdwx(j,i)
559 C******************************************************************************
563 C To save time, the factor of EXPON has been extracted from ALL components
564 C of GVDWC and GRADX. Remember to multiply them by this factor before further
567 C******************************************************************************
570 C-----------------------------------------------------------------------------
571 subroutine eljk(evdw,evdw_t)
573 C This subroutine calculates the interaction energy of nonbonded side chains
574 C assuming the LJK potential of interaction.
576 implicit real*8 (a-h,o-z)
578 include 'DIMENSIONS.ZSCOPT'
579 include "DIMENSIONS.COMPAR"
582 include 'COMMON.LOCAL'
583 include 'COMMON.CHAIN'
584 include 'COMMON.DERIV'
585 include 'COMMON.INTERACT'
586 include 'COMMON.ENEPS'
587 include 'COMMON.IOUNITS'
588 include 'COMMON.NAMES'
593 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
596 eneps_temp(j,i)=0.0d0
608 C Calculate SC interaction energy.
611 do j=istart(i,iint),iend(i,iint)
616 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
618 e_augm=augm(itypi,itypj)*fac_augm
621 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
622 fac=r_shift_inv**expon
623 e1=fac*fac*aa(itypi,itypj)
624 e2=fac*bb(itypi,itypj)
626 ij=icant(itypi,itypj)
627 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
628 & /dabs(eps(itypi,itypj))
629 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
630 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
631 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
632 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
633 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
634 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
635 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
636 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
637 if (bb(itypi,itypj).gt.0.0d0) then
644 C Calculate the components of the gradient in DC and X
646 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
651 gvdwx(k,i)=gvdwx(k,i)-gg(k)
652 gvdwx(k,j)=gvdwx(k,j)+gg(k)
656 gvdwc(l,k)=gvdwc(l,k)+gg(l)
666 gvdwc(j,i)=expon*gvdwc(j,i)
667 gvdwx(j,i)=expon*gvdwx(j,i)
673 C-----------------------------------------------------------------------------
674 subroutine ebp(evdw,evdw_t)
676 C This subroutine calculates the interaction energy of nonbonded side chains
677 C assuming the Berne-Pechukas potential of interaction.
679 implicit real*8 (a-h,o-z)
681 include 'DIMENSIONS.ZSCOPT'
682 include "DIMENSIONS.COMPAR"
685 include 'COMMON.LOCAL'
686 include 'COMMON.CHAIN'
687 include 'COMMON.DERIV'
688 include 'COMMON.NAMES'
689 include 'COMMON.INTERACT'
690 include 'COMMON.ENEPS'
691 include 'COMMON.IOUNITS'
692 include 'COMMON.CALC'
694 c double precision rrsave(maxdim)
700 eneps_temp(j,i)=0.0d0
705 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
706 c if (icall.eq.0) then
718 dxi=dc_norm(1,nres+i)
719 dyi=dc_norm(2,nres+i)
720 dzi=dc_norm(3,nres+i)
721 dsci_inv=vbld_inv(i+nres)
723 C Calculate SC interaction energy.
726 do j=istart(i,iint),iend(i,iint)
729 dscj_inv=vbld_inv(j+nres)
730 chi1=chi(itypi,itypj)
731 chi2=chi(itypj,itypi)
738 alf12=0.5D0*(alf1+alf2)
739 C For diagnostics only!!!
752 dxj=dc_norm(1,nres+j)
753 dyj=dc_norm(2,nres+j)
754 dzj=dc_norm(3,nres+j)
755 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
756 cd if (icall.eq.0) then
762 C Calculate the angle-dependent terms of energy & contributions to derivatives.
764 C Calculate whole angle-dependent part of epsilon and contributions
766 fac=(rrij*sigsq)**expon2
767 e1=fac*fac*aa(itypi,itypj)
768 e2=fac*bb(itypi,itypj)
769 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
770 eps2der=evdwij*eps3rt
771 eps3der=evdwij*eps2rt
772 evdwij=evdwij*eps2rt*eps3rt
773 ij=icant(itypi,itypj)
774 aux=eps1*eps2rt**2*eps3rt**2
775 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
776 & /dabs(eps(itypi,itypj))
777 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
778 if (bb(itypi,itypj).gt.0.0d0) then
785 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
786 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
787 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
788 cd & restyp(itypi),i,restyp(itypj),j,
789 cd & epsi,sigm,chi1,chi2,chip1,chip2,
790 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
791 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
794 C Calculate gradient components.
795 e1=e1*eps1*eps2rt**2*eps3rt**2
796 fac=-expon*(e1+evdwij)
799 C Calculate radial part of the gradient
803 C Calculate the angular part of the gradient and sum add the contributions
804 C to the appropriate components of the Cartesian gradient.
813 C-----------------------------------------------------------------------------
814 subroutine egb(evdw,evdw_t)
816 C This subroutine calculates the interaction energy of nonbonded side chains
817 C assuming the Gay-Berne potential of interaction.
819 implicit real*8 (a-h,o-z)
821 include 'DIMENSIONS.ZSCOPT'
822 include "DIMENSIONS.COMPAR"
825 include 'COMMON.LOCAL'
826 include 'COMMON.CHAIN'
827 include 'COMMON.DERIV'
828 include 'COMMON.NAMES'
829 include 'COMMON.INTERACT'
830 include 'COMMON.ENEPS'
831 include 'COMMON.IOUNITS'
832 include 'COMMON.CALC'
833 include 'COMMON.SBRIDGE'
840 eneps_temp(j,i)=0.0d0
843 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
847 c if (icall.gt.0) lprn=.true.
855 dxi=dc_norm(1,nres+i)
856 dyi=dc_norm(2,nres+i)
857 dzi=dc_norm(3,nres+i)
858 dsci_inv=vbld_inv(i+nres)
860 C Calculate SC interaction energy.
863 do j=istart(i,iint),iend(i,iint)
864 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
865 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
866 C formation no electrostatic interactions should be calculated. If it
867 C would be allowed NaN would appear
868 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
869 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
870 C residue can or cannot form disulfide bond. There is still bug allowing
871 C Cys...Cys...Cys bond formation
872 call dyn_ssbond_ene(i,j,evdwij)
873 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
876 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
877 c & 'evdw',i,j,evdwij,' ss'
881 dscj_inv=vbld_inv(j+nres)
882 sig0ij=sigma(itypi,itypj)
883 chi1=chi(itypi,itypj)
884 chi2=chi(itypj,itypi)
891 alf12=0.5D0*(alf1+alf2)
892 C For diagnostics only!!!
905 dxj=dc_norm(1,nres+j)
906 dyj=dc_norm(2,nres+j)
907 dzj=dc_norm(3,nres+j)
908 c write (iout,*) i,j,xj,yj,zj
909 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
911 C Calculate angle-dependent terms of energy and contributions to their
915 sig=sig0ij*dsqrt(sigsq)
916 rij_shift=1.0D0/rij-sig+sig0ij
917 C I hate to put IF's in the loops, but here don't have another choice!!!!
918 if (rij_shift.le.0.0D0) then
923 c---------------------------------------------------------------
924 rij_shift=1.0D0/rij_shift
926 e1=fac*fac*aa(itypi,itypj)
927 e2=fac*bb(itypi,itypj)
928 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
929 eps2der=evdwij*eps3rt
930 eps3der=evdwij*eps2rt
931 evdwij=evdwij*eps2rt*eps3rt
932 if (bb(itypi,itypj).gt.0) then
937 ij=icant(itypi,itypj)
938 aux=eps1*eps2rt**2*eps3rt**2
939 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
940 & /dabs(eps(itypi,itypj))
941 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
942 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
943 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
944 c & aux*e2/eps(itypi,itypj)
945 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
947 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
948 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
949 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
950 & restyp(itypi),i,restyp(itypj),j,
951 & epsi,sigm,chi1,chi2,chip1,chip2,
952 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
953 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
957 C Calculate gradient components.
958 e1=e1*eps1*eps2rt**2*eps3rt**2
959 fac=-expon*(e1+evdwij)*rij_shift
962 C Calculate the radial part of the gradient
966 C Calculate angular part of the gradient.
975 C-----------------------------------------------------------------------------
976 subroutine egbv(evdw,evdw_t)
978 C This subroutine calculates the interaction energy of nonbonded side chains
979 C assuming the Gay-Berne-Vorobjev potential of interaction.
981 implicit real*8 (a-h,o-z)
983 include 'DIMENSIONS.ZSCOPT'
984 include "DIMENSIONS.COMPAR"
987 include 'COMMON.LOCAL'
988 include 'COMMON.CHAIN'
989 include 'COMMON.DERIV'
990 include 'COMMON.NAMES'
991 include 'COMMON.INTERACT'
992 include 'COMMON.ENEPS'
993 include 'COMMON.IOUNITS'
994 include 'COMMON.CALC'
1001 eneps_temp(j,i)=0.0d0
1006 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1009 c if (icall.gt.0) lprn=.true.
1011 do i=iatsc_s,iatsc_e
1017 dxi=dc_norm(1,nres+i)
1018 dyi=dc_norm(2,nres+i)
1019 dzi=dc_norm(3,nres+i)
1020 dsci_inv=vbld_inv(i+nres)
1022 C Calculate SC interaction energy.
1024 do iint=1,nint_gr(i)
1025 do j=istart(i,iint),iend(i,iint)
1028 dscj_inv=vbld_inv(j+nres)
1029 sig0ij=sigma(itypi,itypj)
1030 r0ij=r0(itypi,itypj)
1031 chi1=chi(itypi,itypj)
1032 chi2=chi(itypj,itypi)
1039 alf12=0.5D0*(alf1+alf2)
1040 C For diagnostics only!!!
1053 dxj=dc_norm(1,nres+j)
1054 dyj=dc_norm(2,nres+j)
1055 dzj=dc_norm(3,nres+j)
1056 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1058 C Calculate angle-dependent terms of energy and contributions to their
1062 sig=sig0ij*dsqrt(sigsq)
1063 rij_shift=1.0D0/rij-sig+r0ij
1064 C I hate to put IF's in the loops, but here don't have another choice!!!!
1065 if (rij_shift.le.0.0D0) then
1070 c---------------------------------------------------------------
1071 rij_shift=1.0D0/rij_shift
1072 fac=rij_shift**expon
1073 e1=fac*fac*aa(itypi,itypj)
1074 e2=fac*bb(itypi,itypj)
1075 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1076 eps2der=evdwij*eps3rt
1077 eps3der=evdwij*eps2rt
1078 fac_augm=rrij**expon
1079 e_augm=augm(itypi,itypj)*fac_augm
1080 evdwij=evdwij*eps2rt*eps3rt
1081 if (bb(itypi,itypj).gt.0.0d0) then
1082 evdw=evdw+evdwij+e_augm
1084 evdw_t=evdw_t+evdwij+e_augm
1086 ij=icant(itypi,itypj)
1087 aux=eps1*eps2rt**2*eps3rt**2
1088 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1089 & /dabs(eps(itypi,itypj))
1090 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1091 c eneps_temp(ij)=eneps_temp(ij)
1092 c & +(evdwij+e_augm)/eps(itypi,itypj)
1094 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1097 c & restyp(itypi),i,restyp(itypj),j,
1098 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1099 c & chi1,chi2,chip1,chip2,
1100 c & eps1,eps2rt**2,eps3rt**2,
1101 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1105 C Calculate gradient components.
1106 e1=e1*eps1*eps2rt**2*eps3rt**2
1107 fac=-expon*(e1+evdwij)*rij_shift
1109 fac=rij*fac-2*expon*rrij*e_augm
1110 C Calculate the radial part of the gradient
1114 C Calculate angular part of the gradient.
1122 C-----------------------------------------------------------------------------
1123 subroutine sc_angular
1124 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1125 C om12. Called by ebp, egb, and egbv.
1127 include 'COMMON.CALC'
1131 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1132 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1133 om12=dxi*dxj+dyi*dyj+dzi*dzj
1135 C Calculate eps1(om12) and its derivative in om12
1136 faceps1=1.0D0-om12*chiom12
1137 faceps1_inv=1.0D0/faceps1
1138 eps1=dsqrt(faceps1_inv)
1139 C Following variable is eps1*deps1/dom12
1140 eps1_om12=faceps1_inv*chiom12
1141 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1146 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1147 sigsq=1.0D0-facsig*faceps1_inv
1148 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1149 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1150 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1151 C Calculate eps2 and its derivatives in om1, om2, and om12.
1154 chipom12=chip12*om12
1155 facp=1.0D0-om12*chipom12
1157 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1158 C Following variable is the square root of eps2
1159 eps2rt=1.0D0-facp1*facp_inv
1160 C Following three variables are the derivatives of the square root of eps
1161 C in om1, om2, and om12.
1162 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1163 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1164 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1165 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1166 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1167 C Calculate whole angle-dependent part of epsilon and contributions
1168 C to its derivatives
1171 C----------------------------------------------------------------------------
1173 implicit real*8 (a-h,o-z)
1174 include 'DIMENSIONS'
1175 include 'DIMENSIONS.ZSCOPT'
1176 include 'COMMON.CHAIN'
1177 include 'COMMON.DERIV'
1178 include 'COMMON.CALC'
1179 double precision dcosom1(3),dcosom2(3)
1180 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1181 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1182 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1183 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1185 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1186 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1189 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1193 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1194 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1195 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1196 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1197 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1200 C Calculate the components of the gradient in DC and X
1204 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1209 c------------------------------------------------------------------------------
1210 subroutine vec_and_deriv
1211 implicit real*8 (a-h,o-z)
1212 include 'DIMENSIONS'
1213 include 'DIMENSIONS.ZSCOPT'
1214 include 'COMMON.IOUNITS'
1215 include 'COMMON.GEO'
1216 include 'COMMON.VAR'
1217 include 'COMMON.LOCAL'
1218 include 'COMMON.CHAIN'
1219 include 'COMMON.VECTORS'
1220 include 'COMMON.DERIV'
1221 include 'COMMON.INTERACT'
1222 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1223 C Compute the local reference systems. For reference system (i), the
1224 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1225 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1227 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1228 if (i.eq.nres-1) then
1229 C Case of the last full residue
1230 C Compute the Z-axis
1231 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1232 costh=dcos(pi-theta(nres))
1233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1238 C Compute the derivatives of uz
1240 uzder(2,1,1)=-dc_norm(3,i-1)
1241 uzder(3,1,1)= dc_norm(2,i-1)
1242 uzder(1,2,1)= dc_norm(3,i-1)
1244 uzder(3,2,1)=-dc_norm(1,i-1)
1245 uzder(1,3,1)=-dc_norm(2,i-1)
1246 uzder(2,3,1)= dc_norm(1,i-1)
1249 uzder(2,1,2)= dc_norm(3,i)
1250 uzder(3,1,2)=-dc_norm(2,i)
1251 uzder(1,2,2)=-dc_norm(3,i)
1253 uzder(3,2,2)= dc_norm(1,i)
1254 uzder(1,3,2)= dc_norm(2,i)
1255 uzder(2,3,2)=-dc_norm(1,i)
1258 C Compute the Y-axis
1261 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1264 C Compute the derivatives of uy
1267 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1268 & -dc_norm(k,i)*dc_norm(j,i-1)
1269 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1271 uyder(j,j,1)=uyder(j,j,1)-costh
1272 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1277 uygrad(l,k,j,i)=uyder(l,k,j)
1278 uzgrad(l,k,j,i)=uzder(l,k,j)
1282 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1283 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1284 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1285 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1289 C Compute the Z-axis
1290 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1291 costh=dcos(pi-theta(i+2))
1292 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1297 C Compute the derivatives of uz
1299 uzder(2,1,1)=-dc_norm(3,i+1)
1300 uzder(3,1,1)= dc_norm(2,i+1)
1301 uzder(1,2,1)= dc_norm(3,i+1)
1303 uzder(3,2,1)=-dc_norm(1,i+1)
1304 uzder(1,3,1)=-dc_norm(2,i+1)
1305 uzder(2,3,1)= dc_norm(1,i+1)
1308 uzder(2,1,2)= dc_norm(3,i)
1309 uzder(3,1,2)=-dc_norm(2,i)
1310 uzder(1,2,2)=-dc_norm(3,i)
1312 uzder(3,2,2)= dc_norm(1,i)
1313 uzder(1,3,2)= dc_norm(2,i)
1314 uzder(2,3,2)=-dc_norm(1,i)
1317 C Compute the Y-axis
1320 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1323 C Compute the derivatives of uy
1326 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1327 & -dc_norm(k,i)*dc_norm(j,i+1)
1328 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1330 uyder(j,j,1)=uyder(j,j,1)-costh
1331 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1336 uygrad(l,k,j,i)=uyder(l,k,j)
1337 uzgrad(l,k,j,i)=uzder(l,k,j)
1341 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1342 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1343 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1344 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1350 vbld_inv_temp(1)=vbld_inv(i+1)
1351 if (i.lt.nres-1) then
1352 vbld_inv_temp(2)=vbld_inv(i+2)
1354 vbld_inv_temp(2)=vbld_inv(i)
1359 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1360 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1368 C-----------------------------------------------------------------------------
1369 subroutine vec_and_deriv_test
1370 implicit real*8 (a-h,o-z)
1371 include 'DIMENSIONS'
1372 include 'DIMENSIONS.ZSCOPT'
1373 include 'COMMON.IOUNITS'
1374 include 'COMMON.GEO'
1375 include 'COMMON.VAR'
1376 include 'COMMON.LOCAL'
1377 include 'COMMON.CHAIN'
1378 include 'COMMON.VECTORS'
1379 dimension uyder(3,3,2),uzder(3,3,2)
1380 C Compute the local reference systems. For reference system (i), the
1381 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1382 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1384 if (i.eq.nres-1) then
1385 C Case of the last full residue
1386 C Compute the Z-axis
1387 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1388 costh=dcos(pi-theta(nres))
1389 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1390 c write (iout,*) 'fac',fac,
1391 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
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 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1420 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1421 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1422 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1424 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1427 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1428 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1431 c write (iout,*) 'facy',facy,
1432 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1433 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1435 uy(k,i)=facy*uy(k,i)
1437 C Compute the derivatives of uy
1440 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1441 & -dc_norm(k,i)*dc_norm(j,i-1)
1442 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1444 c uyder(j,j,1)=uyder(j,j,1)-costh
1445 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1446 uyder(j,j,1)=uyder(j,j,1)
1447 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1448 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1454 uygrad(l,k,j,i)=uyder(l,k,j)
1455 uzgrad(l,k,j,i)=uzder(l,k,j)
1459 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1460 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1461 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1462 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1465 C Compute the Z-axis
1466 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1467 costh=dcos(pi-theta(i+2))
1468 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1469 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1473 C Compute the derivatives of uz
1475 uzder(2,1,1)=-dc_norm(3,i+1)
1476 uzder(3,1,1)= dc_norm(2,i+1)
1477 uzder(1,2,1)= dc_norm(3,i+1)
1479 uzder(3,2,1)=-dc_norm(1,i+1)
1480 uzder(1,3,1)=-dc_norm(2,i+1)
1481 uzder(2,3,1)= dc_norm(1,i+1)
1484 uzder(2,1,2)= dc_norm(3,i)
1485 uzder(3,1,2)=-dc_norm(2,i)
1486 uzder(1,2,2)=-dc_norm(3,i)
1488 uzder(3,2,2)= dc_norm(1,i)
1489 uzder(1,3,2)= dc_norm(2,i)
1490 uzder(2,3,2)=-dc_norm(1,i)
1492 C Compute the Y-axis
1494 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1495 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1496 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1498 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1501 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1502 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1505 c write (iout,*) 'facy',facy,
1506 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1507 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1509 uy(k,i)=facy*uy(k,i)
1511 C Compute the derivatives of uy
1514 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1515 & -dc_norm(k,i)*dc_norm(j,i+1)
1516 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1518 c uyder(j,j,1)=uyder(j,j,1)-costh
1519 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1520 uyder(j,j,1)=uyder(j,j,1)
1521 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1522 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1528 uygrad(l,k,j,i)=uyder(l,k,j)
1529 uzgrad(l,k,j,i)=uzder(l,k,j)
1533 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1534 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1535 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1536 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1543 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1544 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1551 C-----------------------------------------------------------------------------
1552 subroutine check_vecgrad
1553 implicit real*8 (a-h,o-z)
1554 include 'DIMENSIONS'
1555 include 'DIMENSIONS.ZSCOPT'
1556 include 'COMMON.IOUNITS'
1557 include 'COMMON.GEO'
1558 include 'COMMON.VAR'
1559 include 'COMMON.LOCAL'
1560 include 'COMMON.CHAIN'
1561 include 'COMMON.VECTORS'
1562 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1563 dimension uyt(3,maxres),uzt(3,maxres)
1564 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1565 double precision delta /1.0d-7/
1568 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1569 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1570 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1571 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1572 cd & (dc_norm(if90,i),if90=1,3)
1573 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1574 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1575 cd write(iout,'(a)')
1581 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1582 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1595 cd write (iout,*) 'i=',i
1597 erij(k)=dc_norm(k,i)
1601 dc_norm(k,i)=erij(k)
1603 dc_norm(j,i)=dc_norm(j,i)+delta
1604 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1606 c dc_norm(k,i)=dc_norm(k,i)/fac
1608 c write (iout,*) (dc_norm(k,i),k=1,3)
1609 c write (iout,*) (erij(k),k=1,3)
1612 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1613 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1614 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1615 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1617 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1618 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1619 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1622 dc_norm(k,i)=erij(k)
1625 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1626 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1627 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1628 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1629 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1630 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1631 cd write (iout,'(a)')
1636 C--------------------------------------------------------------------------
1637 subroutine set_matrices
1638 implicit real*8 (a-h,o-z)
1639 include 'DIMENSIONS'
1640 include 'DIMENSIONS.ZSCOPT'
1641 include 'COMMON.IOUNITS'
1642 include 'COMMON.GEO'
1643 include 'COMMON.VAR'
1644 include 'COMMON.LOCAL'
1645 include 'COMMON.CHAIN'
1646 include 'COMMON.DERIV'
1647 include 'COMMON.INTERACT'
1648 include 'COMMON.CONTACTS'
1649 include 'COMMON.TORSION'
1650 include 'COMMON.VECTORS'
1651 include 'COMMON.FFIELD'
1652 double precision auxvec(2),auxmat(2,2)
1654 C Compute the virtual-bond-torsional-angle dependent quantities needed
1655 C to calculate the el-loc multibody terms of various order.
1658 if (i .lt. nres+1) then
1695 if (i .gt. 3 .and. i .lt. nres+1) then
1696 obrot_der(1,i-2)=-sin1
1697 obrot_der(2,i-2)= cos1
1698 Ugder(1,1,i-2)= sin1
1699 Ugder(1,2,i-2)=-cos1
1700 Ugder(2,1,i-2)=-cos1
1701 Ugder(2,2,i-2)=-sin1
1704 obrot2_der(1,i-2)=-dwasin2
1705 obrot2_der(2,i-2)= dwacos2
1706 Ug2der(1,1,i-2)= dwasin2
1707 Ug2der(1,2,i-2)=-dwacos2
1708 Ug2der(2,1,i-2)=-dwacos2
1709 Ug2der(2,2,i-2)=-dwasin2
1711 obrot_der(1,i-2)=0.0d0
1712 obrot_der(2,i-2)=0.0d0
1713 Ugder(1,1,i-2)=0.0d0
1714 Ugder(1,2,i-2)=0.0d0
1715 Ugder(2,1,i-2)=0.0d0
1716 Ugder(2,2,i-2)=0.0d0
1717 obrot2_der(1,i-2)=0.0d0
1718 obrot2_der(2,i-2)=0.0d0
1719 Ug2der(1,1,i-2)=0.0d0
1720 Ug2der(1,2,i-2)=0.0d0
1721 Ug2der(2,1,i-2)=0.0d0
1722 Ug2der(2,2,i-2)=0.0d0
1724 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1725 iti = itortyp(itype(i-2))
1729 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1730 iti1 = itortyp(itype(i-1))
1734 cd write (iout,*) '*******i',i,' iti1',iti
1735 cd write (iout,*) 'b1',b1(:,iti)
1736 cd write (iout,*) 'b2',b2(:,iti)
1737 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1738 if (i .gt. iatel_s+2) then
1739 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1740 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1741 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1742 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1743 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1744 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1745 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1755 DtUg2(l,k,i-2)=0.0d0
1759 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1760 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1761 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1762 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1763 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1764 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1765 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1767 muder(k,i-2)=Ub2der(k,i-2)
1769 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1770 iti1 = itortyp(itype(i-1))
1775 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1777 C Vectors and matrices dependent on a single virtual-bond dihedral.
1778 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1779 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1780 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1781 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1782 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1783 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1784 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1785 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1786 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1787 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1788 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1790 C Matrices dependent on two consecutive virtual-bond dihedrals.
1791 C The order of matrices is from left to right.
1793 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1794 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1795 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1796 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1797 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1798 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1799 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1800 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1803 cd iti = itortyp(itype(i))
1806 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1807 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1812 C--------------------------------------------------------------------------
1813 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1815 C This subroutine calculates the average interaction energy and its gradient
1816 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1817 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1818 C The potential depends both on the distance of peptide-group centers and on
1819 C the orientation of the CA-CA virtual bonds.
1821 implicit real*8 (a-h,o-z)
1822 include 'DIMENSIONS'
1823 include 'DIMENSIONS.ZSCOPT'
1824 include 'DIMENSIONS.FREE'
1825 include 'COMMON.CONTROL'
1826 include 'COMMON.IOUNITS'
1827 include 'COMMON.GEO'
1828 include 'COMMON.VAR'
1829 include 'COMMON.LOCAL'
1830 include 'COMMON.CHAIN'
1831 include 'COMMON.DERIV'
1832 include 'COMMON.INTERACT'
1833 include 'COMMON.CONTACTS'
1834 include 'COMMON.TORSION'
1835 include 'COMMON.VECTORS'
1836 include 'COMMON.FFIELD'
1837 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1838 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1839 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1840 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1841 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1842 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1843 double precision scal_el /0.5d0/
1845 C 13-go grudnia roku pamietnego...
1846 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1847 & 0.0d0,1.0d0,0.0d0,
1848 & 0.0d0,0.0d0,1.0d0/
1849 cd write(iout,*) 'In EELEC'
1851 cd write(iout,*) 'Type',i
1852 cd write(iout,*) 'B1',B1(:,i)
1853 cd write(iout,*) 'B2',B2(:,i)
1854 cd write(iout,*) 'CC',CC(:,:,i)
1855 cd write(iout,*) 'DD',DD(:,:,i)
1856 cd write(iout,*) 'EE',EE(:,:,i)
1858 cd call check_vecgrad
1860 if (icheckgrad.eq.1) then
1862 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1864 dc_norm(k,i)=dc(k,i)*fac
1866 c write (iout,*) 'i',i,' fac',fac
1869 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1870 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1871 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1872 cd if (wel_loc.gt.0.0d0) then
1873 if (icheckgrad.eq.1) then
1874 call vec_and_deriv_test
1881 cd write (iout,*) 'i=',i
1883 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1886 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1887 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1900 cd print '(a)','Enter EELEC'
1901 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1903 gel_loc_loc(i)=0.0d0
1906 do i=iatel_s,iatel_e
1907 if (itel(i).eq.0) goto 1215
1911 dx_normi=dc_norm(1,i)
1912 dy_normi=dc_norm(2,i)
1913 dz_normi=dc_norm(3,i)
1914 xmedi=c(1,i)+0.5d0*dxi
1915 ymedi=c(2,i)+0.5d0*dyi
1916 zmedi=c(3,i)+0.5d0*dzi
1918 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1919 do j=ielstart(i),ielend(i)
1920 if (itel(j).eq.0) goto 1216
1924 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1925 aaa=app(iteli,itelj)
1926 bbb=bpp(iteli,itelj)
1927 C Diagnostics only!!!
1933 ael6i=ael6(iteli,itelj)
1934 ael3i=ael3(iteli,itelj)
1938 dx_normj=dc_norm(1,j)
1939 dy_normj=dc_norm(2,j)
1940 dz_normj=dc_norm(3,j)
1941 xj=c(1,j)+0.5D0*dxj-xmedi
1942 yj=c(2,j)+0.5D0*dyj-ymedi
1943 zj=c(3,j)+0.5D0*dzj-zmedi
1944 rij=xj*xj+yj*yj+zj*zj
1950 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1951 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1952 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1953 fac=cosa-3.0D0*cosb*cosg
1955 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1956 if (j.eq.i+2) ev1=scal_el*ev1
1961 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1964 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1965 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1966 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1969 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1970 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1971 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1972 cd & xmedi,ymedi,zmedi,xj,yj,zj
1974 C Calculate contributions to the Cartesian gradient.
1977 facvdw=-6*rrmij*(ev1+evdwij)
1978 facel=-3*rrmij*(el1+eesij)
1985 * Radial derivatives. First process both termini of the fragment (i,j)
1992 gelc(k,i)=gelc(k,i)+ghalf
1993 gelc(k,j)=gelc(k,j)+ghalf
1996 * Loop over residues i+1 thru j-1.
2000 gelc(l,k)=gelc(l,k)+ggg(l)
2008 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2009 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2012 * Loop over residues i+1 thru j-1.
2016 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2023 fac=-3*rrmij*(facvdw+facvdw+facel)
2029 * Radial derivatives. First process both termini of the fragment (i,j)
2036 gelc(k,i)=gelc(k,i)+ghalf
2037 gelc(k,j)=gelc(k,j)+ghalf
2040 * Loop over residues i+1 thru j-1.
2044 gelc(l,k)=gelc(l,k)+ggg(l)
2051 ecosa=2.0D0*fac3*fac1+fac4
2054 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2055 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2057 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2058 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2060 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2061 cd & (dcosg(k),k=1,3)
2063 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2067 gelc(k,i)=gelc(k,i)+ghalf
2068 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2069 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2070 gelc(k,j)=gelc(k,j)+ghalf
2071 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2072 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2076 gelc(l,k)=gelc(l,k)+ggg(l)
2081 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2082 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2083 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2085 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2086 C energy of a peptide unit is assumed in the form of a second-order
2087 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2088 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2089 C are computed for EVERY pair of non-contiguous peptide groups.
2091 if (j.lt.nres-1) then
2102 muij(kkk)=mu(k,i)*mu(l,j)
2105 cd write (iout,*) 'EELEC: i',i,' j',j
2106 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2107 cd write(iout,*) 'muij',muij
2108 ury=scalar(uy(1,i),erij)
2109 urz=scalar(uz(1,i),erij)
2110 vry=scalar(uy(1,j),erij)
2111 vrz=scalar(uz(1,j),erij)
2112 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2113 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2114 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2115 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2116 C For diagnostics only
2121 fac=dsqrt(-ael6i)*r3ij
2122 cd write (2,*) 'fac=',fac
2123 C For diagnostics only
2129 cd write (iout,'(4i5,4f10.5)')
2130 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2131 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2132 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2133 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2134 cd write (iout,'(4f10.5)')
2135 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2136 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2137 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2138 cd write (iout,'(2i3,9f10.5/)') i,j,
2139 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2141 C Derivatives of the elements of A in virtual-bond vectors
2142 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2149 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2150 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2151 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2152 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2153 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2154 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2155 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2156 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2157 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2158 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2159 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2160 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2170 C Compute radial contributions to the gradient
2192 C Add the contributions coming from er
2195 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2196 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2197 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2198 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2201 C Derivatives in DC(i)
2202 ghalf1=0.5d0*agg(k,1)
2203 ghalf2=0.5d0*agg(k,2)
2204 ghalf3=0.5d0*agg(k,3)
2205 ghalf4=0.5d0*agg(k,4)
2206 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2207 & -3.0d0*uryg(k,2)*vry)+ghalf1
2208 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2209 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2210 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2211 & -3.0d0*urzg(k,2)*vry)+ghalf3
2212 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2213 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2214 C Derivatives in DC(i+1)
2215 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2216 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2217 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2218 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2219 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2220 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2221 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2222 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2223 C Derivatives in DC(j)
2224 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2225 & -3.0d0*vryg(k,2)*ury)+ghalf1
2226 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2227 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2228 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2229 & -3.0d0*vryg(k,2)*urz)+ghalf3
2230 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2231 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2232 C Derivatives in DC(j+1) or DC(nres-1)
2233 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2234 & -3.0d0*vryg(k,3)*ury)
2235 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2236 & -3.0d0*vrzg(k,3)*ury)
2237 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2238 & -3.0d0*vryg(k,3)*urz)
2239 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2240 & -3.0d0*vrzg(k,3)*urz)
2245 C Derivatives in DC(i+1)
2246 cd aggi1(k,1)=agg(k,1)
2247 cd aggi1(k,2)=agg(k,2)
2248 cd aggi1(k,3)=agg(k,3)
2249 cd aggi1(k,4)=agg(k,4)
2250 C Derivatives in DC(j)
2255 C Derivatives in DC(j+1)
2260 if (j.eq.nres-1 .and. i.lt.j-2) then
2262 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2263 cd aggj1(k,l)=agg(k,l)
2269 C Check the loc-el terms by numerical integration
2279 aggi(k,l)=-aggi(k,l)
2280 aggi1(k,l)=-aggi1(k,l)
2281 aggj(k,l)=-aggj(k,l)
2282 aggj1(k,l)=-aggj1(k,l)
2285 if (j.lt.nres-1) then
2291 aggi(k,l)=-aggi(k,l)
2292 aggi1(k,l)=-aggi1(k,l)
2293 aggj(k,l)=-aggj(k,l)
2294 aggj1(k,l)=-aggj1(k,l)
2305 aggi(k,l)=-aggi(k,l)
2306 aggi1(k,l)=-aggi1(k,l)
2307 aggj(k,l)=-aggj(k,l)
2308 aggj1(k,l)=-aggj1(k,l)
2314 IF (wel_loc.gt.0.0d0) THEN
2315 C Contribution to the local-electrostatic energy coming from the i-j pair
2316 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2318 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2319 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2320 eel_loc=eel_loc+eel_loc_ij
2321 C Partial derivatives in virtual-bond dihedral angles gamma
2324 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2325 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2326 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2327 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2328 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2329 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2330 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2331 cd write(iout,*) 'agg ',agg
2332 cd write(iout,*) 'aggi ',aggi
2333 cd write(iout,*) 'aggi1',aggi1
2334 cd write(iout,*) 'aggj ',aggj
2335 cd write(iout,*) 'aggj1',aggj1
2337 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2339 ggg(l)=agg(l,1)*muij(1)+
2340 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2344 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2347 C Remaining derivatives of eello
2349 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2350 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2351 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2352 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2353 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2354 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2355 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2356 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2360 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2361 C Contributions from turns
2366 call eturn34(i,j,eello_turn3,eello_turn4)
2368 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2369 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2371 C Calculate the contact function. The ith column of the array JCONT will
2372 C contain the numbers of atoms that make contacts with the atom I (of numbers
2373 C greater than I). The arrays FACONT and GACONT will contain the values of
2374 C the contact function and its derivative.
2375 c r0ij=1.02D0*rpp(iteli,itelj)
2376 c r0ij=1.11D0*rpp(iteli,itelj)
2377 r0ij=2.20D0*rpp(iteli,itelj)
2378 c r0ij=1.55D0*rpp(iteli,itelj)
2379 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2380 if (fcont.gt.0.0D0) then
2381 num_conti=num_conti+1
2382 if (num_conti.gt.maxconts) then
2383 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2384 & ' will skip next contacts for this conf.'
2386 jcont_hb(num_conti,i)=j
2387 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2388 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2389 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2391 d_cont(num_conti,i)=rij
2392 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2393 C --- Electrostatic-interaction matrix ---
2394 a_chuj(1,1,num_conti,i)=a22
2395 a_chuj(1,2,num_conti,i)=a23
2396 a_chuj(2,1,num_conti,i)=a32
2397 a_chuj(2,2,num_conti,i)=a33
2398 C --- Gradient of rij
2400 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2403 c a_chuj(1,1,num_conti,i)=-0.61d0
2404 c a_chuj(1,2,num_conti,i)= 0.4d0
2405 c a_chuj(2,1,num_conti,i)= 0.65d0
2406 c a_chuj(2,2,num_conti,i)= 0.50d0
2407 c else if (i.eq.2) then
2408 c a_chuj(1,1,num_conti,i)= 0.0d0
2409 c a_chuj(1,2,num_conti,i)= 0.0d0
2410 c a_chuj(2,1,num_conti,i)= 0.0d0
2411 c a_chuj(2,2,num_conti,i)= 0.0d0
2413 C --- and its gradients
2414 cd write (iout,*) 'i',i,' j',j
2416 cd write (iout,*) 'iii 1 kkk',kkk
2417 cd write (iout,*) agg(kkk,:)
2420 cd write (iout,*) 'iii 2 kkk',kkk
2421 cd write (iout,*) aggi(kkk,:)
2424 cd write (iout,*) 'iii 3 kkk',kkk
2425 cd write (iout,*) aggi1(kkk,:)
2428 cd write (iout,*) 'iii 4 kkk',kkk
2429 cd write (iout,*) aggj(kkk,:)
2432 cd write (iout,*) 'iii 5 kkk',kkk
2433 cd write (iout,*) aggj1(kkk,:)
2440 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2441 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2442 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2443 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2444 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2446 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2452 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2453 C Calculate contact energies
2455 wij=cosa-3.0D0*cosb*cosg
2458 c fac3=dsqrt(-ael6i)/r0ij**3
2459 fac3=dsqrt(-ael6i)*r3ij
2460 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2461 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2463 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2464 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2465 C Diagnostics. Comment out or remove after debugging!
2466 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2467 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2468 c ees0m(num_conti,i)=0.0D0
2470 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2471 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2472 facont_hb(num_conti,i)=fcont
2474 C Angular derivatives of the contact function
2475 ees0pij1=fac3/ees0pij
2476 ees0mij1=fac3/ees0mij
2477 fac3p=-3.0D0*fac3*rrmij
2478 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2479 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2481 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2482 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2483 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2484 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2485 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2486 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2487 ecosap=ecosa1+ecosa2
2488 ecosbp=ecosb1+ecosb2
2489 ecosgp=ecosg1+ecosg2
2490 ecosam=ecosa1-ecosa2
2491 ecosbm=ecosb1-ecosb2
2492 ecosgm=ecosg1-ecosg2
2501 fprimcont=fprimcont/rij
2502 cd facont_hb(num_conti,i)=1.0D0
2503 C Following line is for diagnostics.
2506 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2507 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2510 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2511 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2513 gggp(1)=gggp(1)+ees0pijp*xj
2514 gggp(2)=gggp(2)+ees0pijp*yj
2515 gggp(3)=gggp(3)+ees0pijp*zj
2516 gggm(1)=gggm(1)+ees0mijp*xj
2517 gggm(2)=gggm(2)+ees0mijp*yj
2518 gggm(3)=gggm(3)+ees0mijp*zj
2519 C Derivatives due to the contact function
2520 gacont_hbr(1,num_conti,i)=fprimcont*xj
2521 gacont_hbr(2,num_conti,i)=fprimcont*yj
2522 gacont_hbr(3,num_conti,i)=fprimcont*zj
2524 ghalfp=0.5D0*gggp(k)
2525 ghalfm=0.5D0*gggm(k)
2526 gacontp_hb1(k,num_conti,i)=ghalfp
2527 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2528 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2529 gacontp_hb2(k,num_conti,i)=ghalfp
2530 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2531 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2532 gacontp_hb3(k,num_conti,i)=gggp(k)
2533 gacontm_hb1(k,num_conti,i)=ghalfm
2534 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2535 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2536 gacontm_hb2(k,num_conti,i)=ghalfm
2537 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2538 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2539 gacontm_hb3(k,num_conti,i)=gggm(k)
2542 C Diagnostics. Comment out or remove after debugging!
2544 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2545 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2546 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2547 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2548 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2549 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2552 endif ! num_conti.le.maxconts
2557 num_cont_hb(i)=num_conti
2561 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2562 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2564 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2565 ccc eel_loc=eel_loc+eello_turn3
2568 C-----------------------------------------------------------------------------
2569 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2570 C Third- and fourth-order contributions from turns
2571 implicit real*8 (a-h,o-z)
2572 include 'DIMENSIONS'
2573 include 'DIMENSIONS.ZSCOPT'
2574 include 'COMMON.IOUNITS'
2575 include 'COMMON.GEO'
2576 include 'COMMON.VAR'
2577 include 'COMMON.LOCAL'
2578 include 'COMMON.CHAIN'
2579 include 'COMMON.DERIV'
2580 include 'COMMON.INTERACT'
2581 include 'COMMON.CONTACTS'
2582 include 'COMMON.TORSION'
2583 include 'COMMON.VECTORS'
2584 include 'COMMON.FFIELD'
2586 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2587 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2588 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2589 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2590 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2591 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2595 C Third-order contributions
2602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2603 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2604 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2605 call transpose2(auxmat(1,1),auxmat1(1,1))
2606 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2607 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2608 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2609 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2610 cd & ' eello_turn3_num',4*eello_turn3_num
2612 C Derivatives in gamma(i)
2613 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2614 call transpose2(auxmat2(1,1),pizda(1,1))
2615 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2616 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2617 C Derivatives in gamma(i+1)
2618 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2619 call transpose2(auxmat2(1,1),pizda(1,1))
2620 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2621 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2622 & +0.5d0*(pizda(1,1)+pizda(2,2))
2623 C Cartesian derivatives
2625 a_temp(1,1)=aggi(l,1)
2626 a_temp(1,2)=aggi(l,2)
2627 a_temp(2,1)=aggi(l,3)
2628 a_temp(2,2)=aggi(l,4)
2629 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2630 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2631 & +0.5d0*(pizda(1,1)+pizda(2,2))
2632 a_temp(1,1)=aggi1(l,1)
2633 a_temp(1,2)=aggi1(l,2)
2634 a_temp(2,1)=aggi1(l,3)
2635 a_temp(2,2)=aggi1(l,4)
2636 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2637 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2638 & +0.5d0*(pizda(1,1)+pizda(2,2))
2639 a_temp(1,1)=aggj(l,1)
2640 a_temp(1,2)=aggj(l,2)
2641 a_temp(2,1)=aggj(l,3)
2642 a_temp(2,2)=aggj(l,4)
2643 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2644 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2645 & +0.5d0*(pizda(1,1)+pizda(2,2))
2646 a_temp(1,1)=aggj1(l,1)
2647 a_temp(1,2)=aggj1(l,2)
2648 a_temp(2,1)=aggj1(l,3)
2649 a_temp(2,2)=aggj1(l,4)
2650 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2651 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2652 & +0.5d0*(pizda(1,1)+pizda(2,2))
2655 else if (j.eq.i+3) then
2656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2658 C Fourth-order contributions
2666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2667 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2668 iti1=itortyp(itype(i+1))
2669 iti2=itortyp(itype(i+2))
2670 iti3=itortyp(itype(i+3))
2671 call transpose2(EUg(1,1,i+1),e1t(1,1))
2672 call transpose2(Eug(1,1,i+2),e2t(1,1))
2673 call transpose2(Eug(1,1,i+3),e3t(1,1))
2674 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2675 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2676 s1=scalar2(b1(1,iti2),auxvec(1))
2677 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2678 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2679 s2=scalar2(b1(1,iti1),auxvec(1))
2680 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2681 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2683 eello_turn4=eello_turn4-(s1+s2+s3)
2684 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2685 cd & ' eello_turn4_num',8*eello_turn4_num
2686 C Derivatives in gamma(i)
2688 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2689 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2690 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2691 s1=scalar2(b1(1,iti2),auxvec(1))
2692 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2693 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2694 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2695 C Derivatives in gamma(i+1)
2696 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2697 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2698 s2=scalar2(b1(1,iti1),auxvec(1))
2699 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2700 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2702 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2703 C Derivatives in gamma(i+2)
2704 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2705 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2706 s1=scalar2(b1(1,iti2),auxvec(1))
2707 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2708 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2709 s2=scalar2(b1(1,iti1),auxvec(1))
2710 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2711 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2713 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2714 C Cartesian derivatives
2715 C Derivatives of this turn contributions in DC(i+2)
2716 if (j.lt.nres-1) then
2718 a_temp(1,1)=agg(l,1)
2719 a_temp(1,2)=agg(l,2)
2720 a_temp(2,1)=agg(l,3)
2721 a_temp(2,2)=agg(l,4)
2722 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2723 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2724 s1=scalar2(b1(1,iti2),auxvec(1))
2725 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2726 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2727 s2=scalar2(b1(1,iti1),auxvec(1))
2728 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2729 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2730 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2732 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2735 C Remaining derivatives of this turn contribution
2737 a_temp(1,1)=aggi(l,1)
2738 a_temp(1,2)=aggi(l,2)
2739 a_temp(2,1)=aggi(l,3)
2740 a_temp(2,2)=aggi(l,4)
2741 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2742 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2743 s1=scalar2(b1(1,iti2),auxvec(1))
2744 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2745 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2746 s2=scalar2(b1(1,iti1),auxvec(1))
2747 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2748 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2749 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2750 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2751 a_temp(1,1)=aggi1(l,1)
2752 a_temp(1,2)=aggi1(l,2)
2753 a_temp(2,1)=aggi1(l,3)
2754 a_temp(2,2)=aggi1(l,4)
2755 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2756 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2757 s1=scalar2(b1(1,iti2),auxvec(1))
2758 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2759 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2760 s2=scalar2(b1(1,iti1),auxvec(1))
2761 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2762 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2763 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2764 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2765 a_temp(1,1)=aggj(l,1)
2766 a_temp(1,2)=aggj(l,2)
2767 a_temp(2,1)=aggj(l,3)
2768 a_temp(2,2)=aggj(l,4)
2769 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2770 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2771 s1=scalar2(b1(1,iti2),auxvec(1))
2772 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2773 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2774 s2=scalar2(b1(1,iti1),auxvec(1))
2775 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2776 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2777 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2778 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2779 a_temp(1,1)=aggj1(l,1)
2780 a_temp(1,2)=aggj1(l,2)
2781 a_temp(2,1)=aggj1(l,3)
2782 a_temp(2,2)=aggj1(l,4)
2783 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2784 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2785 s1=scalar2(b1(1,iti2),auxvec(1))
2786 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2787 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2788 s2=scalar2(b1(1,iti1),auxvec(1))
2789 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2790 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2791 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2792 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2798 C-----------------------------------------------------------------------------
2799 subroutine vecpr(u,v,w)
2800 implicit real*8(a-h,o-z)
2801 dimension u(3),v(3),w(3)
2802 w(1)=u(2)*v(3)-u(3)*v(2)
2803 w(2)=-u(1)*v(3)+u(3)*v(1)
2804 w(3)=u(1)*v(2)-u(2)*v(1)
2807 C-----------------------------------------------------------------------------
2808 subroutine unormderiv(u,ugrad,unorm,ungrad)
2809 C This subroutine computes the derivatives of a normalized vector u, given
2810 C the derivatives computed without normalization conditions, ugrad. Returns
2813 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2814 double precision vec(3)
2815 double precision scalar
2817 c write (2,*) 'ugrad',ugrad
2820 vec(i)=scalar(ugrad(1,i),u(1))
2822 c write (2,*) 'vec',vec
2825 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2828 c write (2,*) 'ungrad',ungrad
2831 C-----------------------------------------------------------------------------
2832 subroutine escp(evdw2,evdw2_14)
2834 C This subroutine calculates the excluded-volume interaction energy between
2835 C peptide-group centers and side chains and its gradient in virtual-bond and
2836 C side-chain vectors.
2838 implicit real*8 (a-h,o-z)
2839 include 'DIMENSIONS'
2840 include 'DIMENSIONS.ZSCOPT'
2841 include 'COMMON.GEO'
2842 include 'COMMON.VAR'
2843 include 'COMMON.LOCAL'
2844 include 'COMMON.CHAIN'
2845 include 'COMMON.DERIV'
2846 include 'COMMON.INTERACT'
2847 include 'COMMON.FFIELD'
2848 include 'COMMON.IOUNITS'
2852 cd print '(a)','Enter ESCP'
2853 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2854 c & ' scal14',scal14
2855 do i=iatscp_s,iatscp_e
2857 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2858 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2859 if (iteli.eq.0) goto 1225
2860 xi=0.5D0*(c(1,i)+c(1,i+1))
2861 yi=0.5D0*(c(2,i)+c(2,i+1))
2862 zi=0.5D0*(c(3,i)+c(3,i+1))
2864 do iint=1,nscp_gr(i)
2866 do j=iscpstart(i,iint),iscpend(i,iint)
2868 C Uncomment following three lines for SC-p interactions
2872 C Uncomment following three lines for Ca-p interactions
2876 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2878 e1=fac*fac*aad(itypj,iteli)
2879 e2=fac*bad(itypj,iteli)
2880 if (iabs(j-i) .le. 2) then
2883 evdw2_14=evdw2_14+e1+e2
2886 c write (iout,*) i,j,evdwij
2890 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2892 fac=-(evdwij+e1)*rrij
2897 cd write (iout,*) 'j<i'
2898 C Uncomment following three lines for SC-p interactions
2900 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2903 cd write (iout,*) 'j>i'
2906 C Uncomment following line for SC-p interactions
2907 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2911 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2915 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2916 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2919 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2929 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2930 gradx_scp(j,i)=expon*gradx_scp(j,i)
2933 C******************************************************************************
2937 C To save time the factor EXPON has been extracted from ALL components
2938 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2941 C******************************************************************************
2944 C--------------------------------------------------------------------------
2945 subroutine edis(ehpb)
2947 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2949 implicit real*8 (a-h,o-z)
2950 include 'DIMENSIONS'
2951 include 'DIMENSIONS.FREE'
2952 include 'COMMON.SBRIDGE'
2953 include 'COMMON.CHAIN'
2954 include 'COMMON.DERIV'
2955 include 'COMMON.VAR'
2956 include 'COMMON.INTERACT'
2957 include 'COMMON.CONTROL'
2958 include 'COMMON.IOUNITS'
2964 C write (iout,*) ,"link_end",link_end,constr_dist
2965 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2966 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
2967 c & " constr_dist",constr_dist
2968 if (link_end.eq.0) return
2969 do i=link_start,link_end
2970 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2971 C CA-CA distance used in regularization of structure.
2974 C iii and jjj point to the residues for which the distance is assigned.
2975 if (ii.gt.nres) then
2982 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2983 c & dhpb(i),dhpb1(i),forcon(i)
2984 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2985 C distance and angle dependent SS bond potential.
2986 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2987 C & iabs(itype(jjj)).eq.1) then
2988 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2989 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
2990 if (.not.dyn_ss .and. i.le.nss) then
2991 C 15/02/13 CC dynamic SSbond - additional check
2992 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2993 & iabs(itype(jjj)).eq.1) then
2994 call ssbond_ene(iii,jjj,eij)
2997 cd write (iout,*) "eij",eij
2998 cd & ' waga=',waga,' fac=',fac
2999 ! else if (ii.gt.nres .and. jj.gt.nres) then
3001 C Calculate the distance between the two points and its difference from the
3004 if (irestr_type(i).eq.11) then
3005 ehpb=ehpb+fordepth(i)!**4.0d0
3006 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3007 fac=fordepth(i)!**4.0d0
3008 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3009 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
3010 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3011 c & ehpb,irestr_type(i)
3012 else if (irestr_type(i).eq.10) then
3013 c AL 6//19/2018 cross-link restraints
3014 xdis = 0.5d0*(dd/forcon(i))**2
3015 expdis = dexp(-xdis)
3016 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
3017 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
3018 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
3019 c & " wboltzd",wboltzd
3020 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
3021 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
3022 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
3023 & *expdis/(aux*forcon(i)**2)
3024 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
3025 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3026 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
3027 else if (irestr_type(i).eq.2) then
3028 c Quartic restraints
3029 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3030 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3031 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3032 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
3033 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3035 c Quadratic restraints
3037 C Get the force constant corresponding to this distance.
3039 C Calculate the contribution to energy.
3040 ehpb=ehpb+0.5d0*waga*rdis*rdis
3041 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3042 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3043 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
3045 C Evaluate gradient.
3049 c Calculate Cartesian gradient
3051 ggg(j)=fac*(c(j,jj)-c(j,ii))
3053 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3054 C If this is a SC-SC distance, we need to calculate the contributions to the
3055 C Cartesian gradient in the SC vectors (ghpbx).
3058 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3059 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3063 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3064 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3070 C--------------------------------------------------------------------------
3071 subroutine ssbond_ene(i,j,eij)
3073 C Calculate the distance and angle dependent SS-bond potential energy
3074 C using a free-energy function derived based on RHF/6-31G** ab initio
3075 C calculations of diethyl disulfide.
3077 C A. Liwo and U. Kozlowska, 11/24/03
3079 implicit real*8 (a-h,o-z)
3080 include 'DIMENSIONS'
3081 include 'DIMENSIONS.ZSCOPT'
3082 include 'COMMON.SBRIDGE'
3083 include 'COMMON.CHAIN'
3084 include 'COMMON.DERIV'
3085 include 'COMMON.LOCAL'
3086 include 'COMMON.INTERACT'
3087 include 'COMMON.VAR'
3088 include 'COMMON.IOUNITS'
3089 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3094 dxi=dc_norm(1,nres+i)
3095 dyi=dc_norm(2,nres+i)
3096 dzi=dc_norm(3,nres+i)
3097 dsci_inv=dsc_inv(itypi)
3099 dscj_inv=dsc_inv(itypj)
3103 dxj=dc_norm(1,nres+j)
3104 dyj=dc_norm(2,nres+j)
3105 dzj=dc_norm(3,nres+j)
3106 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3111 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3112 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3113 om12=dxi*dxj+dyi*dyj+dzi*dzj
3115 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3116 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3122 deltat12=om2-om1+2.0d0
3124 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3125 & +akct*deltad*deltat12+ebr
3126 c & +akct*deltad*deltat12
3127 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3128 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3129 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3130 & " deltat12",deltat12," eij",eij,"ebr",ebr
3131 ed=2*akcm*deltad+akct*deltat12
3133 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3134 eom1=-2*akth*deltat1-pom1-om2*pom2
3135 eom2= 2*akth*deltat2+pom1-om1*pom2
3138 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3141 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3142 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3143 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3144 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3147 C Calculate the components of the gradient in DC and X
3151 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3156 C--------------------------------------------------------------------------
3157 c MODELLER restraint function
3158 subroutine e_modeller(ehomology_constr)
3159 implicit real*8 (a-h,o-z)
3160 include 'DIMENSIONS'
3161 include 'DIMENSIONS.ZSCOPT'
3162 include 'DIMENSIONS.FREE'
3163 integer nnn, i, j, k, ki, irec, l
3164 integer katy, odleglosci, test7
3165 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3166 real*8 distance(max_template),distancek(max_template),
3167 & min_odl,godl(max_template),dih_diff(max_template)
3170 c FP - 30/10/2014 Temporary specifications for homology restraints
3172 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3174 double precision, dimension (maxres) :: guscdiff,usc_diff
3175 double precision, dimension (max_template) ::
3176 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3179 include 'COMMON.SBRIDGE'
3180 include 'COMMON.CHAIN'
3181 include 'COMMON.GEO'
3182 include 'COMMON.DERIV'
3183 include 'COMMON.LOCAL'
3184 include 'COMMON.INTERACT'
3185 include 'COMMON.VAR'
3186 include 'COMMON.IOUNITS'
3187 include 'COMMON.CONTROL'
3188 include 'COMMON.HOMRESTR'
3190 include 'COMMON.SETUP'
3191 include 'COMMON.NAMES'
3194 distancek(i)=9999999.9
3199 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3201 C AL 5/2/14 - Introduce list of restraints
3202 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3204 write(iout,*) "------- dist restrs start -------"
3206 do ii = link_start_homo,link_end_homo
3210 c write (iout,*) "dij(",i,j,") =",dij
3212 do k=1,constr_homology
3213 if(.not.l_homo(k,ii)) then
3217 distance(k)=odl(k,ii)-dij
3218 c write (iout,*) "distance(",k,") =",distance(k)
3220 c For Gaussian-type Urestr
3222 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3223 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3224 c write (iout,*) "distancek(",k,") =",distancek(k)
3225 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3227 c For Lorentzian-type Urestr
3229 if (waga_dist.lt.0.0d0) then
3230 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3231 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3232 & (distance(k)**2+sigma_odlir(k,ii)**2))
3236 c min_odl=minval(distancek)
3237 do kk=1,constr_homology
3238 if(l_homo(kk,ii)) then
3239 min_odl=distancek(kk)
3243 do kk=1,constr_homology
3244 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3245 & min_odl=distancek(kk)
3247 c write (iout,* )"min_odl",min_odl
3249 write (iout,*) "ij dij",i,j,dij
3250 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3251 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3252 write (iout,* )"min_odl",min_odl
3257 if (waga_dist.ge.0.0d0) then
3263 do k=1,constr_homology
3264 c Nie wiem po co to liczycie jeszcze raz!
3265 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3266 c & (2*(sigma_odl(i,j,k))**2))
3267 if(.not.l_homo(k,ii)) cycle
3268 if (waga_dist.ge.0.0d0) then
3270 c For Gaussian-type Urestr
3272 godl(k)=dexp(-distancek(k)+min_odl)
3273 odleg2=odleg2+godl(k)
3275 c For Lorentzian-type Urestr
3278 odleg2=odleg2+distancek(k)
3281 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3282 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3283 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3284 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3287 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3288 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3290 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3291 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3293 if (waga_dist.ge.0.0d0) then
3295 c For Gaussian-type Urestr
3297 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3299 c For Lorentzian-type Urestr
3302 odleg=odleg+odleg2/constr_homology
3306 c write (iout,*) "odleg",odleg ! sum of -ln-s
3309 c For Gaussian-type Urestr
3311 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3313 do k=1,constr_homology
3314 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3315 c & *waga_dist)+min_odl
3316 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3318 if(.not.l_homo(k,ii)) cycle
3319 if (waga_dist.ge.0.0d0) then
3320 c For Gaussian-type Urestr
3322 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3324 c For Lorentzian-type Urestr
3327 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3328 & sigma_odlir(k,ii)**2)**2)
3330 sum_sgodl=sum_sgodl+sgodl
3332 c sgodl2=sgodl2+sgodl
3333 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3334 c write(iout,*) "constr_homology=",constr_homology
3335 c write(iout,*) i, j, k, "TEST K"
3337 if (waga_dist.ge.0.0d0) then
3339 c For Gaussian-type Urestr
3341 grad_odl3=waga_homology(iset)*waga_dist
3342 & *sum_sgodl/(sum_godl*dij)
3344 c For Lorentzian-type Urestr
3347 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3348 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3349 grad_odl3=-waga_homology(iset)*waga_dist*
3350 & sum_sgodl/(constr_homology*dij)
3353 c grad_odl3=sum_sgodl/(sum_godl*dij)
3356 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3357 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3358 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3360 ccc write(iout,*) godl, sgodl, grad_odl3
3362 c grad_odl=grad_odl+grad_odl3
3365 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3366 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3367 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3368 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3369 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3370 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3371 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3372 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3373 c if (i.eq.25.and.j.eq.27) then
3374 c write(iout,*) "jik",jik,"i",i,"j",j
3375 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3376 c write(iout,*) "grad_odl3",grad_odl3
3377 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3378 c write(iout,*) "ggodl",ggodl
3379 c write(iout,*) "ghpbc(",jik,i,")",
3380 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3385 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3386 ccc & dLOG(odleg2),"-odleg=", -odleg
3388 enddo ! ii-loop for dist
3390 write(iout,*) "------- dist restrs end -------"
3391 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3392 c & waga_d.eq.1.0d0) call sum_gradient
3394 c Pseudo-energy and gradient from dihedral-angle restraints from
3395 c homology templates
3396 c write (iout,*) "End of distance loop"
3399 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3401 write(iout,*) "------- dih restrs start -------"
3402 do i=idihconstr_start_homo,idihconstr_end_homo
3403 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3406 do i=idihconstr_start_homo,idihconstr_end_homo
3408 c betai=beta(i,i+1,i+2,i+3)
3410 c write (iout,*) "betai =",betai
3411 do k=1,constr_homology
3412 dih_diff(k)=pinorm(dih(k,i)-betai)
3413 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3414 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3415 c & -(6.28318-dih_diff(i,k))
3416 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3417 c & 6.28318+dih_diff(i,k)
3419 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3421 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3423 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3426 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3429 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3430 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3432 write (iout,*) "i",i," betai",betai," kat2",kat2
3433 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3435 if (kat2.le.1.0d-14) cycle
3436 kat=kat-dLOG(kat2/constr_homology)
3437 c write (iout,*) "kat",kat ! sum of -ln-s
3439 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3440 ccc & dLOG(kat2), "-kat=", -kat
3443 c ----------------------------------------------------------------------
3445 c ----------------------------------------------------------------------
3449 do k=1,constr_homology
3451 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3453 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3455 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3456 sum_sgdih=sum_sgdih+sgdih
3458 c grad_dih3=sum_sgdih/sum_gdih
3459 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3461 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3462 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3463 ccc & gloc(nphi+i-3,icg)
3464 gloc(i,icg)=gloc(i,icg)+grad_dih3
3466 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3468 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3469 ccc & gloc(nphi+i-3,icg)
3471 enddo ! i-loop for dih
3473 write(iout,*) "------- dih restrs end -------"
3476 c Pseudo-energy and gradient for theta angle restraints from
3477 c homology templates
3478 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3482 c For constr_homology reference structures (FP)
3484 c Uconst_back_tot=0.0d0
3487 c Econstr_back legacy
3490 c do i=ithet_start,ithet_end
3493 c do i=loc_start,loc_end
3496 duscdiffx(j,i)=0.0d0
3502 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3503 c write (iout,*) "waga_theta",waga_theta
3504 if (waga_theta.gt.0.0d0) then
3506 write (iout,*) "usampl",usampl
3507 write(iout,*) "------- theta restrs start -------"
3508 c do i=ithet_start,ithet_end
3509 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3512 c write (iout,*) "maxres",maxres,"nres",nres
3514 do i=ithet_start,ithet_end
3517 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3519 c Deviation of theta angles wrt constr_homology ref structures
3521 utheta_i=0.0d0 ! argument of Gaussian for single k
3522 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3523 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3524 c over residues in a fragment
3525 c write (iout,*) "theta(",i,")=",theta(i)
3526 do k=1,constr_homology
3528 c dtheta_i=theta(j)-thetaref(j,iref)
3529 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3530 theta_diff(k)=thetatpl(k,i)-theta(i)
3532 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3533 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3534 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3535 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3536 c Gradient for single Gaussian restraint in subr Econstr_back
3537 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3540 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3541 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3545 c Gradient for multiple Gaussian restraint
3546 sum_gtheta=gutheta_i
3548 do k=1,constr_homology
3549 c New generalized expr for multiple Gaussian from Econstr_back
3550 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3552 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3553 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3556 c Final value of gradient using same var as in Econstr_back
3557 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3558 & *waga_homology(iset)
3559 c dutheta(i)=sum_sgtheta/sum_gtheta
3561 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3563 Eval=Eval-dLOG(gutheta_i/constr_homology)
3564 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3565 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3566 c Uconst_back=Uconst_back+utheta(i)
3567 enddo ! (i-loop for theta)
3569 write(iout,*) "------- theta restrs end -------"
3573 c Deviation of local SC geometry
3575 c Separation of two i-loops (instructed by AL - 11/3/2014)
3577 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3578 c write (iout,*) "waga_d",waga_d
3581 write(iout,*) "------- SC restrs start -------"
3582 write (iout,*) "Initial duscdiff,duscdiffx"
3583 do i=loc_start,loc_end
3584 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3585 & (duscdiffx(jik,i),jik=1,3)
3588 do i=loc_start,loc_end
3589 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3590 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3591 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3592 c write(iout,*) "xxtab, yytab, zztab"
3593 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3594 do k=1,constr_homology
3596 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3597 c Original sign inverted for calc of gradients (s. Econstr_back)
3598 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3599 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3600 c write(iout,*) "dxx, dyy, dzz"
3601 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3603 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3604 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3605 c uscdiffk(k)=usc_diff(i)
3606 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3607 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3608 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3609 c & xxref(j),yyref(j),zzref(j)
3614 c Generalized expression for multiple Gaussian acc to that for a single
3615 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3617 c Original implementation
3618 c sum_guscdiff=guscdiff(i)
3620 c sum_sguscdiff=0.0d0
3621 c do k=1,constr_homology
3622 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3623 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3624 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3627 c Implementation of new expressions for gradient (Jan. 2015)
3629 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3631 do k=1,constr_homology
3633 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3634 c before. Now the drivatives should be correct
3636 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3637 c Original sign inverted for calc of gradients (s. Econstr_back)
3638 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3639 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3641 c New implementation
3643 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3644 & sigma_d(k,i) ! for the grad wrt r'
3645 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3648 c New implementation
3649 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3651 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3652 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3653 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3654 duscdiff(jik,i)=duscdiff(jik,i)+
3655 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3656 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3657 duscdiffx(jik,i)=duscdiffx(jik,i)+
3658 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3659 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3662 write(iout,*) "jik",jik,"i",i
3663 write(iout,*) "dxx, dyy, dzz"
3664 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3665 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3666 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3667 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3668 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3669 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3670 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3671 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3672 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3673 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3674 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3675 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3676 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3677 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3678 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3685 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3686 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3688 c write (iout,*) i," uscdiff",uscdiff(i)
3690 c Put together deviations from local geometry
3692 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3693 c & wfrag_back(3,i,iset)*uscdiff(i)
3694 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3695 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3696 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3697 c Uconst_back=Uconst_back+usc_diff(i)
3699 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3701 c New implment: multiplied by sum_sguscdiff
3704 enddo ! (i-loop for dscdiff)
3709 write(iout,*) "------- SC restrs end -------"
3710 write (iout,*) "------ After SC loop in e_modeller ------"
3711 do i=loc_start,loc_end
3712 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3713 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3715 if (waga_theta.eq.1.0d0) then
3716 write (iout,*) "in e_modeller after SC restr end: dutheta"
3717 do i=ithet_start,ithet_end
3718 write (iout,*) i,dutheta(i)
3721 if (waga_d.eq.1.0d0) then
3722 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3724 write (iout,*) i,(duscdiff(j,i),j=1,3)
3725 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3730 c Total energy from homology restraints
3732 write (iout,*) "odleg",odleg," kat",kat
3733 write (iout,*) "odleg",odleg," kat",kat
3734 write (iout,*) "Eval",Eval," Erot",Erot
3735 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3736 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3737 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3740 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3742 c ehomology_constr=odleg+kat
3744 c For Lorentzian-type Urestr
3747 if (waga_dist.ge.0.0d0) then
3749 c For Gaussian-type Urestr
3751 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3752 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3753 ehomology_constr=waga_dist*odleg+waga_angle*kat+
3754 & waga_theta*Eval+waga_d*Erot
3755 c write (iout,*) "ehomology_constr=",ehomology_constr
3758 c For Lorentzian-type Urestr
3760 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3761 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3762 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
3763 & waga_theta*Eval+waga_d*Erot
3764 c write (iout,*) "ehomology_constr=",ehomology_constr
3767 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3768 & "Eval",waga_theta,eval,
3769 & "Erot",waga_d,Erot
3770 write (iout,*) "ehomology_constr",ehomology_constr
3774 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3775 747 format(a12,i4,i4,i4,f8.3,f8.3)
3776 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3777 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3778 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3779 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3781 c-----------------------------------------------------------------------
3782 subroutine ebond(estr)
3784 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3786 implicit real*8 (a-h,o-z)
3787 include 'DIMENSIONS'
3788 include 'DIMENSIONS.ZSCOPT'
3789 include 'DIMENSIONS.FREE'
3790 include 'COMMON.LOCAL'
3791 include 'COMMON.GEO'
3792 include 'COMMON.INTERACT'
3793 include 'COMMON.DERIV'
3794 include 'COMMON.VAR'
3795 include 'COMMON.CHAIN'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.NAMES'
3798 include 'COMMON.FFIELD'
3799 include 'COMMON.CONTROL'
3800 double precision u(3),ud(3)
3801 logical :: lprn=.false.
3804 diff = vbld(i)-vbldp0
3805 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3808 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3813 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3820 diff=vbld(i+nres)-vbldsc0(1,iti)
3822 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3823 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3824 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3826 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3830 diff=vbld(i+nres)-vbldsc0(j,iti)
3831 ud(j)=aksc(j,iti)*diff
3832 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3846 uprod2=uprod2*u(k)*u(k)
3850 usumsqder=usumsqder+ud(j)*uprod2
3853 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3854 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3855 estr=estr+uprod/usum
3857 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3865 C--------------------------------------------------------------------------
3866 subroutine ebend(etheta)
3868 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3869 C angles gamma and its derivatives in consecutive thetas and gammas.
3871 implicit real*8 (a-h,o-z)
3872 include 'DIMENSIONS'
3873 include 'DIMENSIONS.ZSCOPT'
3874 include 'COMMON.LOCAL'
3875 include 'COMMON.GEO'
3876 include 'COMMON.INTERACT'
3877 include 'COMMON.DERIV'
3878 include 'COMMON.VAR'
3879 include 'COMMON.CHAIN'
3880 include 'COMMON.IOUNITS'
3881 include 'COMMON.NAMES'
3882 include 'COMMON.FFIELD'
3883 common /calcthet/ term1,term2,termm,diffak,ratak,
3884 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3885 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3886 double precision y(2),z(2)
3888 time11=dexp(-2*time)
3891 c write (iout,*) "nres",nres
3892 c write (*,'(a,i2)') 'EBEND ICG=',icg
3893 c write (iout,*) ithet_start,ithet_end
3894 do i=ithet_start,ithet_end
3895 C Zero the energy function and its derivative at 0 or pi.
3896 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3898 c if (i.gt.ithet_start .and.
3899 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3900 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3908 c if (i.lt.nres .and. itel(i).ne.0) then
3920 call proc_proc(phii,icrc)
3921 if (icrc.eq.1) phii=150.0
3935 call proc_proc(phii1,icrc)
3936 if (icrc.eq.1) phii1=150.0
3948 C Calculate the "mean" value of theta from the part of the distribution
3949 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3950 C In following comments this theta will be referred to as t_c.
3951 thet_pred_mean=0.0d0
3955 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3957 c write (iout,*) "thet_pred_mean",thet_pred_mean
3958 dthett=thet_pred_mean*ssd
3959 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3960 c write (iout,*) "thet_pred_mean",thet_pred_mean
3961 C Derivatives of the "mean" values in gamma1 and gamma2.
3962 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3963 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3964 if (theta(i).gt.pi-delta) then
3965 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3967 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3968 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3969 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3971 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3973 else if (theta(i).lt.delta) then
3974 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3975 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3976 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3978 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3979 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3982 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3985 etheta=etheta+ethetai
3986 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3987 c & rad2deg*phii,rad2deg*phii1,ethetai
3988 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3989 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3990 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3993 C Ufff.... We've done all this!!!
3996 C---------------------------------------------------------------------------
3997 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3999 implicit real*8 (a-h,o-z)
4000 include 'DIMENSIONS'
4001 include 'COMMON.LOCAL'
4002 include 'COMMON.IOUNITS'
4003 common /calcthet/ term1,term2,termm,diffak,ratak,
4004 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4005 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4006 C Calculate the contributions to both Gaussian lobes.
4007 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4008 C The "polynomial part" of the "standard deviation" of this part of
4012 sig=sig*thet_pred_mean+polthet(j,it)
4014 C Derivative of the "interior part" of the "standard deviation of the"
4015 C gamma-dependent Gaussian lobe in t_c.
4016 sigtc=3*polthet(3,it)
4018 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4021 C Set the parameters of both Gaussian lobes of the distribution.
4022 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4023 fac=sig*sig+sigc0(it)
4026 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4027 sigsqtc=-4.0D0*sigcsq*sigtc
4028 c print *,i,sig,sigtc,sigsqtc
4029 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4030 sigtc=-sigtc/(fac*fac)
4031 C Following variable is sigma(t_c)**(-2)
4032 sigcsq=sigcsq*sigcsq
4034 sig0inv=1.0D0/sig0i**2
4035 delthec=thetai-thet_pred_mean
4036 delthe0=thetai-theta0i
4037 term1=-0.5D0*sigcsq*delthec*delthec
4038 term2=-0.5D0*sig0inv*delthe0*delthe0
4039 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4040 C NaNs in taking the logarithm. We extract the largest exponent which is added
4041 C to the energy (this being the log of the distribution) at the end of energy
4042 C term evaluation for this virtual-bond angle.
4043 if (term1.gt.term2) then
4045 term2=dexp(term2-termm)
4049 term1=dexp(term1-termm)
4052 C The ratio between the gamma-independent and gamma-dependent lobes of
4053 C the distribution is a Gaussian function of thet_pred_mean too.
4054 diffak=gthet(2,it)-thet_pred_mean
4055 ratak=diffak/gthet(3,it)**2
4056 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4057 C Let's differentiate it in thet_pred_mean NOW.
4059 C Now put together the distribution terms to make complete distribution.
4060 termexp=term1+ak*term2
4061 termpre=sigc+ak*sig0i
4062 C Contribution of the bending energy from this theta is just the -log of
4063 C the sum of the contributions from the two lobes and the pre-exponential
4064 C factor. Simple enough, isn't it?
4065 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4066 C NOW the derivatives!!!
4067 C 6/6/97 Take into account the deformation.
4068 E_theta=(delthec*sigcsq*term1
4069 & +ak*delthe0*sig0inv*term2)/termexp
4070 E_tc=((sigtc+aktc*sig0i)/termpre
4071 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4072 & aktc*term2)/termexp)
4075 c-----------------------------------------------------------------------------
4076 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4077 implicit real*8 (a-h,o-z)
4078 include 'DIMENSIONS'
4079 include 'COMMON.LOCAL'
4080 include 'COMMON.IOUNITS'
4081 common /calcthet/ term1,term2,termm,diffak,ratak,
4082 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4083 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4084 delthec=thetai-thet_pred_mean
4085 delthe0=thetai-theta0i
4086 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4087 t3 = thetai-thet_pred_mean
4091 t14 = t12+t6*sigsqtc
4093 t21 = thetai-theta0i
4099 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4100 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4101 & *(-t12*t9-ak*sig0inv*t27)
4105 C--------------------------------------------------------------------------
4106 subroutine ebend(etheta)
4108 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4109 C angles gamma and its derivatives in consecutive thetas and gammas.
4110 C ab initio-derived potentials from
4111 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4113 implicit real*8 (a-h,o-z)
4114 include 'DIMENSIONS'
4115 include 'DIMENSIONS.ZSCOPT'
4116 include 'DIMENSIONS.FREE'
4117 include 'COMMON.LOCAL'
4118 include 'COMMON.GEO'
4119 include 'COMMON.INTERACT'
4120 include 'COMMON.DERIV'
4121 include 'COMMON.VAR'
4122 include 'COMMON.CHAIN'
4123 include 'COMMON.IOUNITS'
4124 include 'COMMON.NAMES'
4125 include 'COMMON.FFIELD'
4126 include 'COMMON.CONTROL'
4127 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4128 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4129 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4130 & sinph1ph2(maxdouble,maxdouble)
4131 logical lprn /.false./, lprn1 /.false./
4133 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4134 do i=ithet_start,ithet_end
4135 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4136 & (itype(i).eq.ntyp1)) cycle
4140 theti2=0.5d0*theta(i)
4141 ityp2=ithetyp(itype(i-1))
4143 coskt(k)=dcos(k*theti2)
4144 sinkt(k)=dsin(k*theti2)
4146 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4149 if (phii.ne.phii) phii=150.0
4153 ityp1=ithetyp(itype(i-2))
4155 cosph1(k)=dcos(k*phii)
4156 sinph1(k)=dsin(k*phii)
4160 ityp1=ithetyp(itype(i-2))
4166 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4169 if (phii1.ne.phii1) phii1=150.0
4174 ityp3=ithetyp(itype(i))
4176 cosph2(k)=dcos(k*phii1)
4177 sinph2(k)=dsin(k*phii1)
4182 ityp3=ithetyp(itype(i))
4188 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4189 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4191 ethetai=aa0thet(ityp1,ityp2,ityp3)
4194 ccl=cosph1(l)*cosph2(k-l)
4195 ssl=sinph1(l)*sinph2(k-l)
4196 scl=sinph1(l)*cosph2(k-l)
4197 csl=cosph1(l)*sinph2(k-l)
4198 cosph1ph2(l,k)=ccl-ssl
4199 cosph1ph2(k,l)=ccl+ssl
4200 sinph1ph2(l,k)=scl+csl
4201 sinph1ph2(k,l)=scl-csl
4205 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4206 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4207 write (iout,*) "coskt and sinkt"
4209 write (iout,*) k,coskt(k),sinkt(k)
4213 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4214 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4217 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4218 & " ethetai",ethetai
4221 write (iout,*) "cosph and sinph"
4223 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4225 write (iout,*) "cosph1ph2 and sinph2ph2"
4228 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4229 & sinph1ph2(l,k),sinph1ph2(k,l)
4232 write(iout,*) "ethetai",ethetai
4236 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4237 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4238 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4239 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4240 ethetai=ethetai+sinkt(m)*aux
4241 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4242 dephii=dephii+k*sinkt(m)*(
4243 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4244 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4245 dephii1=dephii1+k*sinkt(m)*(
4246 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4247 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4249 & write (iout,*) "m",m," k",k," bbthet",
4250 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4251 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4252 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4253 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4257 & write(iout,*) "ethetai",ethetai
4261 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4262 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4263 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4264 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4265 ethetai=ethetai+sinkt(m)*aux
4266 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4267 dephii=dephii+l*sinkt(m)*(
4268 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4269 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4270 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4271 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4272 dephii1=dephii1+(k-l)*sinkt(m)*(
4273 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4274 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4275 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4276 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4278 write (iout,*) "m",m," k",k," l",l," ffthet",
4279 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4280 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4281 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4282 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4283 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4284 & cosph1ph2(k,l)*sinkt(m),
4285 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4292 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4293 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4294 & phii1*rad2deg,ethetai
4296 etheta=etheta+ethetai
4298 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4299 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4300 gloc(nphi+i-2,icg)=wang*dethetai
4306 c-----------------------------------------------------------------------------
4307 subroutine esc(escloc)
4308 C Calculate the local energy of a side chain and its derivatives in the
4309 C corresponding virtual-bond valence angles THETA and the spherical angles
4311 implicit real*8 (a-h,o-z)
4312 include 'DIMENSIONS'
4313 include 'DIMENSIONS.ZSCOPT'
4314 include 'COMMON.GEO'
4315 include 'COMMON.LOCAL'
4316 include 'COMMON.VAR'
4317 include 'COMMON.INTERACT'
4318 include 'COMMON.DERIV'
4319 include 'COMMON.CHAIN'
4320 include 'COMMON.IOUNITS'
4321 include 'COMMON.NAMES'
4322 include 'COMMON.FFIELD'
4323 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4324 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4325 common /sccalc/ time11,time12,time112,theti,it,nlobit
4328 c write (iout,'(a)') 'ESC'
4329 do i=loc_start,loc_end
4331 if (it.eq.10) goto 1
4333 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4334 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4335 theti=theta(i+1)-pipol
4339 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4341 if (x(2).gt.pi-delta) then
4345 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4347 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4348 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4350 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4351 & ddersc0(1),dersc(1))
4352 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4353 & ddersc0(3),dersc(3))
4355 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4357 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4358 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4359 & dersc0(2),esclocbi,dersc02)
4360 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4362 call splinthet(x(2),0.5d0*delta,ss,ssd)
4367 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4369 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4370 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4372 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4374 c write (iout,*) escloci
4375 else if (x(2).lt.delta) then
4379 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4381 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4382 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4384 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4385 & ddersc0(1),dersc(1))
4386 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4387 & ddersc0(3),dersc(3))
4389 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4391 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4392 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4393 & dersc0(2),esclocbi,dersc02)
4394 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4399 call splinthet(x(2),0.5d0*delta,ss,ssd)
4401 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4403 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4404 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4406 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4407 c write (iout,*) escloci
4409 call enesc(x,escloci,dersc,ddummy,.false.)
4412 escloc=escloc+escloci
4413 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4415 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4417 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4418 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4423 C---------------------------------------------------------------------------
4424 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'COMMON.GEO'
4428 include 'COMMON.LOCAL'
4429 include 'COMMON.IOUNITS'
4430 common /sccalc/ time11,time12,time112,theti,it,nlobit
4431 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4432 double precision contr(maxlob,-1:1)
4434 c write (iout,*) 'it=',it,' nlobit=',nlobit
4438 if (mixed) ddersc(j)=0.0d0
4442 C Because of periodicity of the dependence of the SC energy in omega we have
4443 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4444 C To avoid underflows, first compute & store the exponents.
4452 z(k)=x(k)-censc(k,j,it)
4457 Axk=Axk+gaussc(l,k,j,it)*z(l)
4463 expfac=expfac+Ax(k,j,iii)*z(k)
4471 C As in the case of ebend, we want to avoid underflows in exponentiation and
4472 C subsequent NaNs and INFs in energy calculation.
4473 C Find the largest exponent
4477 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4481 cd print *,'it=',it,' emin=',emin
4483 C Compute the contribution to SC energy and derivatives
4487 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4488 cd print *,'j=',j,' expfac=',expfac
4489 escloc_i=escloc_i+expfac
4491 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4495 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4496 & +gaussc(k,2,j,it))*expfac
4503 dersc(1)=dersc(1)/cos(theti)**2
4504 ddersc(1)=ddersc(1)/cos(theti)**2
4507 escloci=-(dlog(escloc_i)-emin)
4509 dersc(j)=dersc(j)/escloc_i
4513 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4518 C------------------------------------------------------------------------------
4519 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4520 implicit real*8 (a-h,o-z)
4521 include 'DIMENSIONS'
4522 include 'COMMON.GEO'
4523 include 'COMMON.LOCAL'
4524 include 'COMMON.IOUNITS'
4525 common /sccalc/ time11,time12,time112,theti,it,nlobit
4526 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4527 double precision contr(maxlob)
4538 z(k)=x(k)-censc(k,j,it)
4544 Axk=Axk+gaussc(l,k,j,it)*z(l)
4550 expfac=expfac+Ax(k,j)*z(k)
4555 C As in the case of ebend, we want to avoid underflows in exponentiation and
4556 C subsequent NaNs and INFs in energy calculation.
4557 C Find the largest exponent
4560 if (emin.gt.contr(j)) emin=contr(j)
4564 C Compute the contribution to SC energy and derivatives
4568 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4569 escloc_i=escloc_i+expfac
4571 dersc(k)=dersc(k)+Ax(k,j)*expfac
4573 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4574 & +gaussc(1,2,j,it))*expfac
4578 dersc(1)=dersc(1)/cos(theti)**2
4579 dersc12=dersc12/cos(theti)**2
4580 escloci=-(dlog(escloc_i)-emin)
4582 dersc(j)=dersc(j)/escloc_i
4584 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4588 c----------------------------------------------------------------------------------
4589 subroutine esc(escloc)
4590 C Calculate the local energy of a side chain and its derivatives in the
4591 C corresponding virtual-bond valence angles THETA and the spherical angles
4592 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4593 C added by Urszula Kozlowska. 07/11/2007
4595 implicit real*8 (a-h,o-z)
4596 include 'DIMENSIONS'
4597 include 'DIMENSIONS.ZSCOPT'
4598 include 'DIMENSIONS.FREE'
4599 include 'COMMON.GEO'
4600 include 'COMMON.LOCAL'
4601 include 'COMMON.VAR'
4602 include 'COMMON.SCROT'
4603 include 'COMMON.INTERACT'
4604 include 'COMMON.DERIV'
4605 include 'COMMON.CHAIN'
4606 include 'COMMON.IOUNITS'
4607 include 'COMMON.NAMES'
4608 include 'COMMON.FFIELD'
4609 include 'COMMON.CONTROL'
4610 include 'COMMON.VECTORS'
4611 double precision x_prime(3),y_prime(3),z_prime(3)
4612 & , sumene,dsc_i,dp2_i,x(65),
4613 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4614 & de_dxx,de_dyy,de_dzz,de_dt
4615 double precision s1_t,s1_6_t,s2_t,s2_6_t
4617 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4618 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4619 & dt_dCi(3),dt_dCi1(3)
4620 common /sccalc/ time11,time12,time112,theti,it,nlobit
4623 do i=loc_start,loc_end
4624 costtab(i+1) =dcos(theta(i+1))
4625 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4626 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4627 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4628 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4629 cosfac=dsqrt(cosfac2)
4630 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4631 sinfac=dsqrt(sinfac2)
4633 if (it.eq.10) goto 1
4635 C Compute the axes of tghe local cartesian coordinates system; store in
4636 c x_prime, y_prime and z_prime
4643 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4644 C & dc_norm(3,i+nres)
4646 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4647 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4650 z_prime(j) = -uz(j,i-1)
4653 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4654 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4655 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4656 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4657 c & " xy",scalar(x_prime(1),y_prime(1)),
4658 c & " xz",scalar(x_prime(1),z_prime(1)),
4659 c & " yy",scalar(y_prime(1),y_prime(1)),
4660 c & " yz",scalar(y_prime(1),z_prime(1)),
4661 c & " zz",scalar(z_prime(1),z_prime(1))
4663 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4664 C to local coordinate system. Store in xx, yy, zz.
4670 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4671 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4672 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4679 C Compute the energy of the ith side cbain
4681 c write (2,*) "xx",xx," yy",yy," zz",zz
4684 x(j) = sc_parmin(j,it)
4687 Cc diagnostics - remove later
4689 yy1 = dsin(alph(2))*dcos(omeg(2))
4690 zz1 = -dsin(alph(2))*dsin(omeg(2))
4691 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4692 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4694 C," --- ", xx_w,yy_w,zz_w
4697 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4698 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4700 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4701 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4703 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4704 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4705 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4706 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4707 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4709 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4710 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4711 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4712 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4713 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4715 dsc_i = 0.743d0+x(61)
4717 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4718 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4719 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4720 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4721 s1=(1+x(63))/(0.1d0 + dscp1)
4722 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4723 s2=(1+x(65))/(0.1d0 + dscp2)
4724 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4725 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4726 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4727 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4729 c & dscp1,dscp2,sumene
4730 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4731 escloc = escloc + sumene
4732 c write (2,*) "escloc",escloc
4733 if (.not. calc_grad) goto 1
4737 C This section to check the numerical derivatives of the energy of ith side
4738 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4739 C #define DEBUG in the code to turn it on.
4741 write (2,*) "sumene =",sumene
4745 write (2,*) xx,yy,zz
4746 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4747 de_dxx_num=(sumenep-sumene)/aincr
4749 write (2,*) "xx+ sumene from enesc=",sumenep
4752 write (2,*) xx,yy,zz
4753 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4754 de_dyy_num=(sumenep-sumene)/aincr
4756 write (2,*) "yy+ sumene from enesc=",sumenep
4759 write (2,*) xx,yy,zz
4760 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4761 de_dzz_num=(sumenep-sumene)/aincr
4763 write (2,*) "zz+ sumene from enesc=",sumenep
4764 costsave=cost2tab(i+1)
4765 sintsave=sint2tab(i+1)
4766 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4767 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4768 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4769 de_dt_num=(sumenep-sumene)/aincr
4770 write (2,*) " t+ sumene from enesc=",sumenep
4771 cost2tab(i+1)=costsave
4772 sint2tab(i+1)=sintsave
4773 C End of diagnostics section.
4776 C Compute the gradient of esc
4778 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4779 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4780 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4781 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4782 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4783 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4784 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4785 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4786 pom1=(sumene3*sint2tab(i+1)+sumene1)
4787 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4788 pom2=(sumene4*cost2tab(i+1)+sumene2)
4789 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4790 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4791 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4792 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4794 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4795 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4796 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4798 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4799 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4800 & +(pom1+pom2)*pom_dx
4802 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4805 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4806 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4807 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4809 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4810 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4811 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4812 & +x(59)*zz**2 +x(60)*xx*zz
4813 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4814 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4815 & +(pom1-pom2)*pom_dy
4817 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4820 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4821 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4822 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4823 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4824 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4825 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4826 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4827 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4829 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4832 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4833 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4834 & +pom1*pom_dt1+pom2*pom_dt2
4836 write(2,*), "de_dt = ", de_dt,de_dt_num
4840 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4841 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4842 cosfac2xx=cosfac2*xx
4843 sinfac2yy=sinfac2*yy
4845 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4847 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4849 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4850 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4851 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4852 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4853 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4854 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4855 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4856 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4857 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4858 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4862 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4863 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4866 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4867 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4868 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4870 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4871 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4875 dXX_Ctab(k,i)=dXX_Ci(k)
4876 dXX_C1tab(k,i)=dXX_Ci1(k)
4877 dYY_Ctab(k,i)=dYY_Ci(k)
4878 dYY_C1tab(k,i)=dYY_Ci1(k)
4879 dZZ_Ctab(k,i)=dZZ_Ci(k)
4880 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4881 dXX_XYZtab(k,i)=dXX_XYZ(k)
4882 dYY_XYZtab(k,i)=dYY_XYZ(k)
4883 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4887 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4888 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4889 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4890 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4891 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4893 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4894 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4895 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4896 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4897 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4898 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4899 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4900 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4902 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4903 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4905 C to check gradient call subroutine check_grad
4912 c------------------------------------------------------------------------------
4913 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4915 C This procedure calculates two-body contact function g(rij) and its derivative:
4918 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4921 C where x=(rij-r0ij)/delta
4923 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4926 double precision rij,r0ij,eps0ij,fcont,fprimcont
4927 double precision x,x2,x4,delta
4931 if (x.lt.-1.0D0) then
4934 else if (x.le.1.0D0) then
4937 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4938 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4945 c------------------------------------------------------------------------------
4946 subroutine splinthet(theti,delta,ss,ssder)
4947 implicit real*8 (a-h,o-z)
4948 include 'DIMENSIONS'
4949 include 'DIMENSIONS.ZSCOPT'
4950 include 'COMMON.VAR'
4951 include 'COMMON.GEO'
4954 if (theti.gt.pipol) then
4955 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4957 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4962 c------------------------------------------------------------------------------
4963 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4965 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4966 double precision ksi,ksi2,ksi3,a1,a2,a3
4967 a1=fprim0*delta/(f1-f0)
4973 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4974 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4977 c------------------------------------------------------------------------------
4978 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4980 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4981 double precision ksi,ksi2,ksi3,a1,a2,a3
4986 a2=3*(f1x-f0x)-2*fprim0x*delta
4987 a3=fprim0x*delta-2*(f1x-f0x)
4988 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4991 C-----------------------------------------------------------------------------
4993 C-----------------------------------------------------------------------------
4994 subroutine etor(etors,edihcnstr,fact)
4995 implicit real*8 (a-h,o-z)
4996 include 'DIMENSIONS'
4997 include 'DIMENSIONS.ZSCOPT'
4998 include 'COMMON.VAR'
4999 include 'COMMON.GEO'
5000 include 'COMMON.LOCAL'
5001 include 'COMMON.TORSION'
5002 include 'COMMON.INTERACT'
5003 include 'COMMON.DERIV'
5004 include 'COMMON.CHAIN'
5005 include 'COMMON.NAMES'
5006 include 'COMMON.IOUNITS'
5007 include 'COMMON.FFIELD'
5008 include 'COMMON.TORCNSTR'
5010 C Set lprn=.true. for debugging
5014 do i=iphi_start,iphi_end
5015 itori=itortyp(itype(i-2))
5016 itori1=itortyp(itype(i-1))
5019 C Proline-Proline pair is a special case...
5020 if (itori.eq.3 .and. itori1.eq.3) then
5021 if (phii.gt.-dwapi3) then
5023 fac=1.0D0/(1.0D0-cosphi)
5024 etorsi=v1(1,3,3)*fac
5025 etorsi=etorsi+etorsi
5026 etors=etors+etorsi-v1(1,3,3)
5027 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5030 v1ij=v1(j+1,itori,itori1)
5031 v2ij=v2(j+1,itori,itori1)
5034 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5035 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5039 v1ij=v1(j,itori,itori1)
5040 v2ij=v2(j,itori,itori1)
5043 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5044 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5048 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5049 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5050 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5051 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5052 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5054 ! 6/20/98 - dihedral angle constraints
5057 itori=idih_constr(i)
5060 if (difi.gt.drange(i)) then
5062 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5063 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5064 else if (difi.lt.-drange(i)) then
5066 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5067 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5069 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5070 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5072 ! write (iout,*) 'edihcnstr',edihcnstr
5075 c------------------------------------------------------------------------------
5077 subroutine etor(etors,edihcnstr,fact)
5078 implicit real*8 (a-h,o-z)
5079 include 'DIMENSIONS'
5080 include 'DIMENSIONS.ZSCOPT'
5081 include 'COMMON.VAR'
5082 include 'COMMON.GEO'
5083 include 'COMMON.LOCAL'
5084 include 'COMMON.TORSION'
5085 include 'COMMON.INTERACT'
5086 include 'COMMON.DERIV'
5087 include 'COMMON.CHAIN'
5088 include 'COMMON.NAMES'
5089 include 'COMMON.IOUNITS'
5090 include 'COMMON.FFIELD'
5091 include 'COMMON.TORCNSTR'
5093 C Set lprn=.true. for debugging
5097 do i=iphi_start,iphi_end
5098 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5099 itori=itortyp(itype(i-2))
5100 itori1=itortyp(itype(i-1))
5103 C Regular cosine and sine terms
5104 do j=1,nterm(itori,itori1)
5105 v1ij=v1(j,itori,itori1)
5106 v2ij=v2(j,itori,itori1)
5109 etors=etors+v1ij*cosphi+v2ij*sinphi
5110 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5114 C E = SUM ----------------------------------- - v1
5115 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5117 cosphi=dcos(0.5d0*phii)
5118 sinphi=dsin(0.5d0*phii)
5119 do j=1,nlor(itori,itori1)
5120 vl1ij=vlor1(j,itori,itori1)
5121 vl2ij=vlor2(j,itori,itori1)
5122 vl3ij=vlor3(j,itori,itori1)
5123 pom=vl2ij*cosphi+vl3ij*sinphi
5124 pom1=1.0d0/(pom*pom+1.0d0)
5125 etors=etors+vl1ij*pom1
5127 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5129 C Subtract the constant term
5130 etors=etors-v0(itori,itori1)
5132 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5133 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5134 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5135 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5136 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5139 ! 6/20/98 - dihedral angle constraints
5142 itori=idih_constr(i)
5144 difi=pinorm(phii-phi0(i))
5146 if (difi.gt.drange(i)) then
5148 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5149 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5150 edihi=0.25d0*ftors*difi**4
5151 else if (difi.lt.-drange(i)) then
5153 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5154 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5155 edihi=0.25d0*ftors*difi**4
5159 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5161 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5162 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5164 ! write (iout,*) 'edihcnstr',edihcnstr
5167 c----------------------------------------------------------------------------
5168 subroutine etor_d(etors_d,fact2)
5169 C 6/23/01 Compute double torsional energy
5170 implicit real*8 (a-h,o-z)
5171 include 'DIMENSIONS'
5172 include 'DIMENSIONS.ZSCOPT'
5173 include 'COMMON.VAR'
5174 include 'COMMON.GEO'
5175 include 'COMMON.LOCAL'
5176 include 'COMMON.TORSION'
5177 include 'COMMON.INTERACT'
5178 include 'COMMON.DERIV'
5179 include 'COMMON.CHAIN'
5180 include 'COMMON.NAMES'
5181 include 'COMMON.IOUNITS'
5182 include 'COMMON.FFIELD'
5183 include 'COMMON.TORCNSTR'
5185 C Set lprn=.true. for debugging
5189 do i=iphi_start,iphi_end-1
5190 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5192 itori=itortyp(itype(i-2))
5193 itori1=itortyp(itype(i-1))
5194 itori2=itortyp(itype(i))
5199 C Regular cosine and sine terms
5200 do j=1,ntermd_1(itori,itori1,itori2)
5201 v1cij=v1c(1,j,itori,itori1,itori2)
5202 v1sij=v1s(1,j,itori,itori1,itori2)
5203 v2cij=v1c(2,j,itori,itori1,itori2)
5204 v2sij=v1s(2,j,itori,itori1,itori2)
5205 cosphi1=dcos(j*phii)
5206 sinphi1=dsin(j*phii)
5207 cosphi2=dcos(j*phii1)
5208 sinphi2=dsin(j*phii1)
5209 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5210 & v2cij*cosphi2+v2sij*sinphi2
5211 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5212 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5214 do k=2,ntermd_2(itori,itori1,itori2)
5216 v1cdij = v2c(k,l,itori,itori1,itori2)
5217 v2cdij = v2c(l,k,itori,itori1,itori2)
5218 v1sdij = v2s(k,l,itori,itori1,itori2)
5219 v2sdij = v2s(l,k,itori,itori1,itori2)
5220 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5221 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5222 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5223 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5224 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5225 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5226 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5227 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5228 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5229 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5232 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5233 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5239 c------------------------------------------------------------------------------
5240 subroutine eback_sc_corr(esccor)
5241 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5242 c conformational states; temporarily implemented as differences
5243 c between UNRES torsional potentials (dependent on three types of
5244 c residues) and the torsional potentials dependent on all 20 types
5245 c of residues computed from AM1 energy surfaces of terminally-blocked
5246 c amino-acid residues.
5247 implicit real*8 (a-h,o-z)
5248 include 'DIMENSIONS'
5249 include 'DIMENSIONS.ZSCOPT'
5250 include 'DIMENSIONS.FREE'
5251 include 'COMMON.VAR'
5252 include 'COMMON.GEO'
5253 include 'COMMON.LOCAL'
5254 include 'COMMON.TORSION'
5255 include 'COMMON.SCCOR'
5256 include 'COMMON.INTERACT'
5257 include 'COMMON.DERIV'
5258 include 'COMMON.CHAIN'
5259 include 'COMMON.NAMES'
5260 include 'COMMON.IOUNITS'
5261 include 'COMMON.FFIELD'
5262 include 'COMMON.CONTROL'
5264 C Set lprn=.true. for debugging
5267 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5269 do i=itau_start,itau_end
5271 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5272 isccori=isccortyp(itype(i-2))
5273 isccori1=isccortyp(itype(i-1))
5275 cccc Added 9 May 2012
5276 cc Tauangle is torsional engle depending on the value of first digit
5277 c(see comment below)
5278 cc Omicron is flat angle depending on the value of first digit
5279 c(see comment below)
5282 do intertyp=1,3 !intertyp
5283 cc Added 09 May 2012 (Adasko)
5284 cc Intertyp means interaction type of backbone mainchain correlation:
5285 c 1 = SC...Ca...Ca...Ca
5286 c 2 = Ca...Ca...Ca...SC
5287 c 3 = SC...Ca...Ca...SCi
5289 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5290 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5291 & (itype(i-1).eq.21)))
5292 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5293 & .or.(itype(i-2).eq.21)))
5294 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5295 & (itype(i-1).eq.21)))) cycle
5296 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5297 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5299 do j=1,nterm_sccor(isccori,isccori1)
5300 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5301 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5302 cosphi=dcos(j*tauangle(intertyp,i))
5303 sinphi=dsin(j*tauangle(intertyp,i))
5304 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5306 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5308 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5310 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5311 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5312 c &gloc_sc(intertyp,i-3,icg)
5314 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5315 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5316 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5317 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5318 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5321 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5325 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5329 c------------------------------------------------------------------------------
5330 subroutine multibody(ecorr)
5331 C This subroutine calculates multi-body contributions to energy following
5332 C the idea of Skolnick et al. If side chains I and J make a contact and
5333 C at the same time side chains I+1 and J+1 make a contact, an extra
5334 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5335 implicit real*8 (a-h,o-z)
5336 include 'DIMENSIONS'
5337 include 'COMMON.IOUNITS'
5338 include 'COMMON.DERIV'
5339 include 'COMMON.INTERACT'
5340 include 'COMMON.CONTACTS'
5341 double precision gx(3),gx1(3)
5344 C Set lprn=.true. for debugging
5348 write (iout,'(a)') 'Contact function values:'
5350 write (iout,'(i2,20(1x,i2,f10.5))')
5351 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5366 num_conti=num_cont(i)
5367 num_conti1=num_cont(i1)
5372 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5373 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5374 cd & ' ishift=',ishift
5375 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5376 C The system gains extra energy.
5377 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5378 endif ! j1==j+-ishift
5387 c------------------------------------------------------------------------------
5388 double precision function esccorr(i,j,k,l,jj,kk)
5389 implicit real*8 (a-h,o-z)
5390 include 'DIMENSIONS'
5391 include 'COMMON.IOUNITS'
5392 include 'COMMON.DERIV'
5393 include 'COMMON.INTERACT'
5394 include 'COMMON.CONTACTS'
5395 double precision gx(3),gx1(3)
5400 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5401 C Calculate the multi-body contribution to energy.
5402 C Calculate multi-body contributions to the gradient.
5403 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5404 cd & k,l,(gacont(m,kk,k),m=1,3)
5406 gx(m) =ekl*gacont(m,jj,i)
5407 gx1(m)=eij*gacont(m,kk,k)
5408 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5409 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5410 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5411 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5415 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5420 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5426 c------------------------------------------------------------------------------
5428 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5429 implicit real*8 (a-h,o-z)
5430 include 'DIMENSIONS'
5431 integer dimen1,dimen2,atom,indx
5432 double precision buffer(dimen1,dimen2)
5433 double precision zapas
5434 common /contacts_hb/ zapas(3,20,maxres,7),
5435 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5436 & num_cont_hb(maxres),jcont_hb(20,maxres)
5437 num_kont=num_cont_hb(atom)
5441 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5444 buffer(i,indx+22)=facont_hb(i,atom)
5445 buffer(i,indx+23)=ees0p(i,atom)
5446 buffer(i,indx+24)=ees0m(i,atom)
5447 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5449 buffer(1,indx+26)=dfloat(num_kont)
5452 c------------------------------------------------------------------------------
5453 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5454 implicit real*8 (a-h,o-z)
5455 include 'DIMENSIONS'
5456 integer dimen1,dimen2,atom,indx
5457 double precision buffer(dimen1,dimen2)
5458 double precision zapas
5459 common /contacts_hb/ zapas(3,20,maxres,7),
5460 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5461 & num_cont_hb(maxres),jcont_hb(20,maxres)
5462 num_kont=buffer(1,indx+26)
5463 num_kont_old=num_cont_hb(atom)
5464 num_cont_hb(atom)=num_kont+num_kont_old
5469 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5472 facont_hb(ii,atom)=buffer(i,indx+22)
5473 ees0p(ii,atom)=buffer(i,indx+23)
5474 ees0m(ii,atom)=buffer(i,indx+24)
5475 jcont_hb(ii,atom)=buffer(i,indx+25)
5479 c------------------------------------------------------------------------------
5481 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5482 C This subroutine calculates multi-body contributions to hydrogen-bonding
5483 implicit real*8 (a-h,o-z)
5484 include 'DIMENSIONS'
5485 include 'DIMENSIONS.ZSCOPT'
5486 include 'COMMON.IOUNITS'
5488 include 'COMMON.INFO'
5490 include 'COMMON.FFIELD'
5491 include 'COMMON.DERIV'
5492 include 'COMMON.INTERACT'
5493 include 'COMMON.CONTACTS'
5495 parameter (max_cont=maxconts)
5496 parameter (max_dim=2*(8*3+2))
5497 parameter (msglen1=max_cont*max_dim*4)
5498 parameter (msglen2=2*msglen1)
5499 integer source,CorrelType,CorrelID,Error
5500 double precision buffer(max_cont,max_dim)
5502 double precision gx(3),gx1(3)
5505 C Set lprn=.true. for debugging
5510 if (fgProcs.le.1) goto 30
5512 write (iout,'(a)') 'Contact function values:'
5514 write (iout,'(2i3,50(1x,i2,f5.2))')
5515 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5516 & j=1,num_cont_hb(i))
5519 C Caution! Following code assumes that electrostatic interactions concerning
5520 C a given atom are split among at most two processors!
5530 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5533 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5534 if (MyRank.gt.0) then
5535 C Send correlation contributions to the preceding processor
5537 nn=num_cont_hb(iatel_s)
5538 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5539 cd write (iout,*) 'The BUFFER array:'
5541 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5543 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5545 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5546 C Clear the contacts of the atom passed to the neighboring processor
5547 nn=num_cont_hb(iatel_s+1)
5549 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5551 num_cont_hb(iatel_s)=0
5553 cd write (iout,*) 'Processor ',MyID,MyRank,
5554 cd & ' is sending correlation contribution to processor',MyID-1,
5555 cd & ' msglen=',msglen
5556 cd write (*,*) 'Processor ',MyID,MyRank,
5557 cd & ' is sending correlation contribution to processor',MyID-1,
5558 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5559 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5560 cd write (iout,*) 'Processor ',MyID,
5561 cd & ' has sent correlation contribution to processor',MyID-1,
5562 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5563 cd write (*,*) 'Processor ',MyID,
5564 cd & ' has sent correlation contribution to processor',MyID-1,
5565 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5567 endif ! (MyRank.gt.0)
5571 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5572 if (MyRank.lt.fgProcs-1) then
5573 C Receive correlation contributions from the next processor
5575 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5576 cd write (iout,*) 'Processor',MyID,
5577 cd & ' is receiving correlation contribution from processor',MyID+1,
5578 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5579 cd write (*,*) 'Processor',MyID,
5580 cd & ' is receiving correlation contribution from processor',MyID+1,
5581 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5583 do while (nbytes.le.0)
5584 call mp_probe(MyID+1,CorrelType,nbytes)
5586 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5587 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5588 cd write (iout,*) 'Processor',MyID,
5589 cd & ' has received correlation contribution from processor',MyID+1,
5590 cd & ' msglen=',msglen,' nbytes=',nbytes
5591 cd write (iout,*) 'The received BUFFER array:'
5593 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5595 if (msglen.eq.msglen1) then
5596 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5597 else if (msglen.eq.msglen2) then
5598 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5599 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5602 & 'ERROR!!!! message length changed while processing correlations.'
5604 & 'ERROR!!!! message length changed while processing correlations.'
5605 call mp_stopall(Error)
5606 endif ! msglen.eq.msglen1
5607 endif ! MyRank.lt.fgProcs-1
5614 write (iout,'(a)') 'Contact function values:'
5616 write (iout,'(2i3,50(1x,i2,f5.2))')
5617 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5618 & j=1,num_cont_hb(i))
5622 C Remove the loop below after debugging !!!
5629 C Calculate the local-electrostatic correlation terms
5630 do i=iatel_s,iatel_e+1
5632 num_conti=num_cont_hb(i)
5633 num_conti1=num_cont_hb(i+1)
5638 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5639 c & ' jj=',jj,' kk=',kk
5640 if (j1.eq.j+1 .or. j1.eq.j-1) then
5641 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5642 C The system gains extra energy.
5643 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5645 write (iout,*) "ecorr",i,j,i+1,j1,
5646 & ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5649 else if (j1.eq.j) then
5650 C Contacts I-J and I-(J+1) occur simultaneously.
5651 C The system loses extra energy.
5652 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5657 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5658 c & ' jj=',jj,' kk=',kk
5660 C Contacts I-J and (I+1)-J occur simultaneously.
5661 C The system loses extra energy.
5662 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5669 c------------------------------------------------------------------------------
5670 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5672 C This subroutine calculates multi-body contributions to hydrogen-bonding
5673 implicit real*8 (a-h,o-z)
5674 include 'DIMENSIONS'
5675 include 'DIMENSIONS.ZSCOPT'
5676 include 'COMMON.IOUNITS'
5678 include 'COMMON.INFO'
5680 include 'COMMON.FFIELD'
5681 include 'COMMON.DERIV'
5682 include 'COMMON.INTERACT'
5683 include 'COMMON.CONTACTS'
5685 parameter (max_cont=maxconts)
5686 parameter (max_dim=2*(8*3+2))
5687 parameter (msglen1=max_cont*max_dim*4)
5688 parameter (msglen2=2*msglen1)
5689 integer source,CorrelType,CorrelID,Error
5690 double precision buffer(max_cont,max_dim)
5692 double precision gx(3),gx1(3)
5695 C Set lprn=.true. for debugging
5701 if (fgProcs.le.1) goto 30
5703 write (iout,'(a)') 'Contact function values:'
5705 write (iout,'(2i3,50(1x,i2,f5.2))')
5706 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5707 & j=1,num_cont_hb(i))
5710 C Caution! Following code assumes that electrostatic interactions concerning
5711 C a given atom are split among at most two processors!
5721 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5724 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5725 if (MyRank.gt.0) then
5726 C Send correlation contributions to the preceding processor
5728 nn=num_cont_hb(iatel_s)
5729 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5730 cd write (iout,*) 'The BUFFER array:'
5732 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5734 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5736 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5737 C Clear the contacts of the atom passed to the neighboring processor
5738 nn=num_cont_hb(iatel_s+1)
5740 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5742 num_cont_hb(iatel_s)=0
5744 cd write (iout,*) 'Processor ',MyID,MyRank,
5745 cd & ' is sending correlation contribution to processor',MyID-1,
5746 cd & ' msglen=',msglen
5747 cd write (*,*) 'Processor ',MyID,MyRank,
5748 cd & ' is sending correlation contribution to processor',MyID-1,
5749 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5750 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5751 cd write (iout,*) 'Processor ',MyID,
5752 cd & ' has sent correlation contribution to processor',MyID-1,
5753 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5754 cd write (*,*) 'Processor ',MyID,
5755 cd & ' has sent correlation contribution to processor',MyID-1,
5756 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5758 endif ! (MyRank.gt.0)
5762 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5763 if (MyRank.lt.fgProcs-1) then
5764 C Receive correlation contributions from the next processor
5766 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5767 cd write (iout,*) 'Processor',MyID,
5768 cd & ' is receiving correlation contribution from processor',MyID+1,
5769 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5770 cd write (*,*) 'Processor',MyID,
5771 cd & ' is receiving correlation contribution from processor',MyID+1,
5772 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5774 do while (nbytes.le.0)
5775 call mp_probe(MyID+1,CorrelType,nbytes)
5777 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5778 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5779 cd write (iout,*) 'Processor',MyID,
5780 cd & ' has received correlation contribution from processor',MyID+1,
5781 cd & ' msglen=',msglen,' nbytes=',nbytes
5782 cd write (iout,*) 'The received BUFFER array:'
5784 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5786 if (msglen.eq.msglen1) then
5787 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5788 else if (msglen.eq.msglen2) then
5789 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5790 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5793 & 'ERROR!!!! message length changed while processing correlations.'
5795 & 'ERROR!!!! message length changed while processing correlations.'
5796 call mp_stopall(Error)
5797 endif ! msglen.eq.msglen1
5798 endif ! MyRank.lt.fgProcs-1
5805 write (iout,'(a)') 'Contact function values:'
5807 write (iout,'(2i3,50(1x,i2,f5.2))')
5808 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5809 & j=1,num_cont_hb(i))
5815 C Remove the loop below after debugging !!!
5822 C Calculate the dipole-dipole interaction energies
5823 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5824 do i=iatel_s,iatel_e+1
5825 num_conti=num_cont_hb(i)
5832 C Calculate the local-electrostatic correlation terms
5833 do i=iatel_s,iatel_e+1
5835 num_conti=num_cont_hb(i)
5836 num_conti1=num_cont_hb(i+1)
5841 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5842 c & ' jj=',jj,' kk=',kk
5843 if (j1.eq.j+1 .or. j1.eq.j-1) then
5844 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5845 C The system gains extra energy.
5847 sqd1=dsqrt(d_cont(jj,i))
5848 sqd2=dsqrt(d_cont(kk,i1))
5849 sred_geom = sqd1*sqd2
5850 IF (sred_geom.lt.cutoff_corr) THEN
5851 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5853 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5854 c & ' jj=',jj,' kk=',kk
5855 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5856 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5858 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5859 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5862 cd write (iout,*) 'sred_geom=',sred_geom,
5863 cd & ' ekont=',ekont,' fprim=',fprimcont
5864 call calc_eello(i,j,i+1,j1,jj,kk)
5865 if (wcorr4.gt.0.0d0)
5866 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5867 if (wcorr5.gt.0.0d0)
5868 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5869 c print *,"wcorr5",ecorr5
5870 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5871 cd write(2,*)'ijkl',i,j,i+1,j1
5872 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5873 & .or. wturn6.eq.0.0d0))then
5874 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5875 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5876 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5877 cd & 'ecorr6=',ecorr6
5878 cd write (iout,'(4e15.5)') sred_geom,
5879 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5880 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5881 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5882 else if (wturn6.gt.0.0d0
5883 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5884 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5885 eturn6=eturn6+eello_turn6(i,jj,kk)
5886 cd write (2,*) 'multibody_eello:eturn6',eturn6
5890 else if (j1.eq.j) then
5891 C Contacts I-J and I-(J+1) occur simultaneously.
5892 C The system loses extra energy.
5893 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5898 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5899 c & ' jj=',jj,' kk=',kk
5901 C Contacts I-J and (I+1)-J occur simultaneously.
5902 C The system loses extra energy.
5903 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5910 c------------------------------------------------------------------------------
5911 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5912 implicit real*8 (a-h,o-z)
5913 include 'DIMENSIONS'
5914 include 'COMMON.IOUNITS'
5915 include 'COMMON.DERIV'
5916 include 'COMMON.INTERACT'
5917 include 'COMMON.CONTACTS'
5918 double precision gx(3),gx1(3)
5928 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5929 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5930 C Following 4 lines for diagnostics.
5935 cd write (iout,*)'Contacts have occurred for peptide groups',i,j,
5937 cd write (iout,*)'Contacts have occurred for peptide groups',
5938 cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5939 cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5940 C Calculate the multi-body contribution to energy.
5941 ecorr=ecorr+ekont*ees
5943 C Calculate multi-body contributions to the gradient.
5945 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5946 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5947 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5948 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5949 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5950 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5951 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5952 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5953 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5954 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5955 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5956 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5957 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5958 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5962 gradcorr(ll,m)=gradcorr(ll,m)+
5963 & ees*ekl*gacont_hbr(ll,jj,i)-
5964 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5965 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5970 gradcorr(ll,m)=gradcorr(ll,m)+
5971 & ees*eij*gacont_hbr(ll,kk,k)-
5972 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5973 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5980 C---------------------------------------------------------------------------
5981 subroutine dipole(i,j,jj)
5982 implicit real*8 (a-h,o-z)
5983 include 'DIMENSIONS'
5984 include 'DIMENSIONS.ZSCOPT'
5985 include 'COMMON.IOUNITS'
5986 include 'COMMON.CHAIN'
5987 include 'COMMON.FFIELD'
5988 include 'COMMON.DERIV'
5989 include 'COMMON.INTERACT'
5990 include 'COMMON.CONTACTS'
5991 include 'COMMON.TORSION'
5992 include 'COMMON.VAR'
5993 include 'COMMON.GEO'
5994 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5996 iti1 = itortyp(itype(i+1))
5997 if (j.lt.nres-1) then
5998 itj1 = itortyp(itype(j+1))
6003 dipi(iii,1)=Ub2(iii,i)
6004 dipderi(iii)=Ub2der(iii,i)
6005 dipi(iii,2)=b1(iii,iti1)
6006 dipj(iii,1)=Ub2(iii,j)
6007 dipderj(iii)=Ub2der(iii,j)
6008 dipj(iii,2)=b1(iii,itj1)
6012 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6015 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6018 if (.not.calc_grad) return
6023 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6027 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6032 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6033 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6035 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6037 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6039 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6043 C---------------------------------------------------------------------------
6044 subroutine calc_eello(i,j,k,l,jj,kk)
6046 C This subroutine computes matrices and vectors needed to calculate
6047 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6049 implicit real*8 (a-h,o-z)
6050 include 'DIMENSIONS'
6051 include 'DIMENSIONS.ZSCOPT'
6052 include 'COMMON.IOUNITS'
6053 include 'COMMON.CHAIN'
6054 include 'COMMON.DERIV'
6055 include 'COMMON.INTERACT'
6056 include 'COMMON.CONTACTS'
6057 include 'COMMON.TORSION'
6058 include 'COMMON.VAR'
6059 include 'COMMON.GEO'
6060 include 'COMMON.FFIELD'
6061 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6062 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6065 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6066 cd & ' jj=',jj,' kk=',kk
6067 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6070 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6071 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6074 call transpose2(aa1(1,1),aa1t(1,1))
6075 call transpose2(aa2(1,1),aa2t(1,1))
6078 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6079 & aa1tder(1,1,lll,kkk))
6080 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6081 & aa2tder(1,1,lll,kkk))
6085 C parallel orientation of the two CA-CA-CA frames.
6087 iti=itortyp(itype(i))
6091 itk1=itortyp(itype(k+1))
6092 itj=itortyp(itype(j))
6093 if (l.lt.nres-1) then
6094 itl1=itortyp(itype(l+1))
6098 C A1 kernel(j+1) A2T
6100 cd write (iout,'(3f10.5,5x,3f10.5)')
6101 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6103 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6104 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6105 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6106 C Following matrices are needed only for 6-th order cumulants
6107 IF (wcorr6.gt.0.0d0) THEN
6108 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6109 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6110 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6111 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6112 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6113 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6114 & ADtEAderx(1,1,1,1,1,1))
6116 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6117 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6118 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6119 & ADtEA1derx(1,1,1,1,1,1))
6121 C End 6-th order cumulants
6124 cd write (2,*) 'In calc_eello6'
6126 cd write (2,*) 'iii=',iii
6128 cd write (2,*) 'kkk=',kkk
6130 cd write (2,'(3(2f10.5),5x)')
6131 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6136 call transpose2(EUgder(1,1,k),auxmat(1,1))
6137 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6138 call transpose2(EUg(1,1,k),auxmat(1,1))
6139 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6140 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6144 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6145 & EAEAderx(1,1,lll,kkk,iii,1))
6149 C A1T kernel(i+1) A2
6150 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6151 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6152 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6153 C Following matrices are needed only for 6-th order cumulants
6154 IF (wcorr6.gt.0.0d0) THEN
6155 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6156 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6157 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6158 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6159 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6160 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6161 & ADtEAderx(1,1,1,1,1,2))
6162 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6163 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6164 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6165 & ADtEA1derx(1,1,1,1,1,2))
6167 C End 6-th order cumulants
6168 call transpose2(EUgder(1,1,l),auxmat(1,1))
6169 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6170 call transpose2(EUg(1,1,l),auxmat(1,1))
6171 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6172 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6176 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6177 & EAEAderx(1,1,lll,kkk,iii,2))
6182 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6183 C They are needed only when the fifth- or the sixth-order cumulants are
6185 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6186 call transpose2(AEA(1,1,1),auxmat(1,1))
6187 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6188 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6189 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6190 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6191 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6192 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6193 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6194 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6195 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6196 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6197 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6198 call transpose2(AEA(1,1,2),auxmat(1,1))
6199 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6200 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6201 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6202 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6203 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6204 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6205 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6206 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6207 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6208 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6209 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6210 C Calculate the Cartesian derivatives of the vectors.
6214 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6215 call matvec2(auxmat(1,1),b1(1,iti),
6216 & AEAb1derx(1,lll,kkk,iii,1,1))
6217 call matvec2(auxmat(1,1),Ub2(1,i),
6218 & AEAb2derx(1,lll,kkk,iii,1,1))
6219 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6220 & AEAb1derx(1,lll,kkk,iii,2,1))
6221 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6222 & AEAb2derx(1,lll,kkk,iii,2,1))
6223 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6224 call matvec2(auxmat(1,1),b1(1,itj),
6225 & AEAb1derx(1,lll,kkk,iii,1,2))
6226 call matvec2(auxmat(1,1),Ub2(1,j),
6227 & AEAb2derx(1,lll,kkk,iii,1,2))
6228 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6229 & AEAb1derx(1,lll,kkk,iii,2,2))
6230 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6231 & AEAb2derx(1,lll,kkk,iii,2,2))
6238 C Antiparallel orientation of the two CA-CA-CA frames.
6240 iti=itortyp(itype(i))
6244 itk1=itortyp(itype(k+1))
6245 itl=itortyp(itype(l))
6246 itj=itortyp(itype(j))
6247 if (j.lt.nres-1) then
6248 itj1=itortyp(itype(j+1))
6252 C A2 kernel(j-1)T A1T
6253 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6254 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6255 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6256 C Following matrices are needed only for 6-th order cumulants
6257 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6258 & j.eq.i+4 .and. l.eq.i+3)) THEN
6259 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6260 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6261 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6262 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6263 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6264 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6265 & ADtEAderx(1,1,1,1,1,1))
6266 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6267 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6268 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6269 & ADtEA1derx(1,1,1,1,1,1))
6271 C End 6-th order cumulants
6272 call transpose2(EUgder(1,1,k),auxmat(1,1))
6273 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6274 call transpose2(EUg(1,1,k),auxmat(1,1))
6275 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6276 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6280 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6281 & EAEAderx(1,1,lll,kkk,iii,1))
6285 C A2T kernel(i+1)T A1
6286 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6287 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6288 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6289 C Following matrices are needed only for 6-th order cumulants
6290 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6291 & j.eq.i+4 .and. l.eq.i+3)) THEN
6292 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6293 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6294 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6295 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6296 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6297 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6298 & ADtEAderx(1,1,1,1,1,2))
6299 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6300 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6301 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6302 & ADtEA1derx(1,1,1,1,1,2))
6304 C End 6-th order cumulants
6305 call transpose2(EUgder(1,1,j),auxmat(1,1))
6306 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6307 call transpose2(EUg(1,1,j),auxmat(1,1))
6308 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6309 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6313 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6314 & EAEAderx(1,1,lll,kkk,iii,2))
6319 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6320 C They are needed only when the fifth- or the sixth-order cumulants are
6322 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6323 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6324 call transpose2(AEA(1,1,1),auxmat(1,1))
6325 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6326 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6327 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6328 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6329 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6330 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6331 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6332 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6333 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6334 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6335 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6336 call transpose2(AEA(1,1,2),auxmat(1,1))
6337 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6338 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6339 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6340 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6341 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6342 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6343 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6344 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6345 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6346 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6347 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6348 C Calculate the Cartesian derivatives of the vectors.
6352 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6353 call matvec2(auxmat(1,1),b1(1,iti),
6354 & AEAb1derx(1,lll,kkk,iii,1,1))
6355 call matvec2(auxmat(1,1),Ub2(1,i),
6356 & AEAb2derx(1,lll,kkk,iii,1,1))
6357 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6358 & AEAb1derx(1,lll,kkk,iii,2,1))
6359 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6360 & AEAb2derx(1,lll,kkk,iii,2,1))
6361 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6362 call matvec2(auxmat(1,1),b1(1,itl),
6363 & AEAb1derx(1,lll,kkk,iii,1,2))
6364 call matvec2(auxmat(1,1),Ub2(1,l),
6365 & AEAb2derx(1,lll,kkk,iii,1,2))
6366 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6367 & AEAb1derx(1,lll,kkk,iii,2,2))
6368 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6369 & AEAb2derx(1,lll,kkk,iii,2,2))
6378 C---------------------------------------------------------------------------
6379 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6380 & KK,KKderg,AKA,AKAderg,AKAderx)
6384 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6385 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6386 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6391 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6393 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6396 cd if (lprn) write (2,*) 'In kernel'
6398 cd if (lprn) write (2,*) 'kkk=',kkk
6400 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6401 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6403 cd write (2,*) 'lll=',lll
6404 cd write (2,*) 'iii=1'
6406 cd write (2,'(3(2f10.5),5x)')
6407 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6410 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6411 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6413 cd write (2,*) 'lll=',lll
6414 cd write (2,*) 'iii=2'
6416 cd write (2,'(3(2f10.5),5x)')
6417 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6424 C---------------------------------------------------------------------------
6425 double precision function eello4(i,j,k,l,jj,kk)
6426 implicit real*8 (a-h,o-z)
6427 include 'DIMENSIONS'
6428 include 'DIMENSIONS.ZSCOPT'
6429 include 'COMMON.IOUNITS'
6430 include 'COMMON.CHAIN'
6431 include 'COMMON.DERIV'
6432 include 'COMMON.INTERACT'
6433 include 'COMMON.CONTACTS'
6434 include 'COMMON.TORSION'
6435 include 'COMMON.VAR'
6436 include 'COMMON.GEO'
6437 double precision pizda(2,2),ggg1(3),ggg2(3)
6438 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6442 cd print *,'eello4:',i,j,k,l,jj,kk
6443 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6444 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6445 cold eij=facont_hb(jj,i)
6446 cold ekl=facont_hb(kk,k)
6448 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6450 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6451 gcorr_loc(k-1)=gcorr_loc(k-1)
6452 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6454 gcorr_loc(l-1)=gcorr_loc(l-1)
6455 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6457 gcorr_loc(j-1)=gcorr_loc(j-1)
6458 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6463 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6464 & -EAEAderx(2,2,lll,kkk,iii,1)
6465 cd derx(lll,kkk,iii)=0.0d0
6469 cd gcorr_loc(l-1)=0.0d0
6470 cd gcorr_loc(j-1)=0.0d0
6471 cd gcorr_loc(k-1)=0.0d0
6473 cd write (iout,*)'Contacts have occurred for peptide groups',
6474 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6475 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6476 if (j.lt.nres-1) then
6483 if (l.lt.nres-1) then
6491 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6492 ggg1(ll)=eel4*g_contij(ll,1)
6493 ggg2(ll)=eel4*g_contij(ll,2)
6494 ghalf=0.5d0*ggg1(ll)
6496 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6497 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6498 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6499 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6500 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6501 ghalf=0.5d0*ggg2(ll)
6503 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6504 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6505 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6506 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6511 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6512 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6517 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6518 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6524 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6529 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6533 cd write (2,*) iii,gcorr_loc(iii)
6537 cd write (2,*) 'ekont',ekont
6538 cd write (iout,*) 'eello4',ekont*eel4
6541 C---------------------------------------------------------------------------
6542 double precision function eello5(i,j,k,l,jj,kk)
6543 implicit real*8 (a-h,o-z)
6544 include 'DIMENSIONS'
6545 include 'DIMENSIONS.ZSCOPT'
6546 include 'COMMON.IOUNITS'
6547 include 'COMMON.CHAIN'
6548 include 'COMMON.DERIV'
6549 include 'COMMON.INTERACT'
6550 include 'COMMON.CONTACTS'
6551 include 'COMMON.TORSION'
6552 include 'COMMON.VAR'
6553 include 'COMMON.GEO'
6554 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6555 double precision ggg1(3),ggg2(3)
6556 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6561 C /l\ / \ \ / \ / \ / C
6562 C / \ / \ \ / \ / \ / C
6563 C j| o |l1 | o | o| o | | o |o C
6564 C \ |/k\| |/ \| / |/ \| |/ \| C
6565 C \i/ \ / \ / / \ / \ C
6567 C (I) (II) (III) (IV) C
6569 C eello5_1 eello5_2 eello5_3 eello5_4 C
6571 C Antiparallel chains C
6574 C /j\ / \ \ / \ / \ / C
6575 C / \ / \ \ / \ / \ / C
6576 C j1| o |l | o | o| o | | o |o C
6577 C \ |/k\| |/ \| / |/ \| |/ \| C
6578 C \i/ \ / \ / / \ / \ C
6580 C (I) (II) (III) (IV) C
6582 C eello5_1 eello5_2 eello5_3 eello5_4 C
6584 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6587 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6592 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6594 itk=itortyp(itype(k))
6595 itl=itortyp(itype(l))
6596 itj=itortyp(itype(j))
6601 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6602 cd & eel5_3_num,eel5_4_num)
6606 derx(lll,kkk,iii)=0.0d0
6610 cd eij=facont_hb(jj,i)
6611 cd ekl=facont_hb(kk,k)
6613 cd write (iout,*)'Contacts have occurred for peptide groups',
6614 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6616 C Contribution from the graph I.
6617 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6618 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6619 call transpose2(EUg(1,1,k),auxmat(1,1))
6620 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6621 vv(1)=pizda(1,1)-pizda(2,2)
6622 vv(2)=pizda(1,2)+pizda(2,1)
6623 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6624 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6626 C Explicit gradient in virtual-dihedral angles.
6627 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6628 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6629 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6630 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6631 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6632 vv(1)=pizda(1,1)-pizda(2,2)
6633 vv(2)=pizda(1,2)+pizda(2,1)
6634 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6635 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6636 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6637 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6638 vv(1)=pizda(1,1)-pizda(2,2)
6639 vv(2)=pizda(1,2)+pizda(2,1)
6641 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6642 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6643 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6645 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6646 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6647 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6649 C Cartesian gradient
6653 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6655 vv(1)=pizda(1,1)-pizda(2,2)
6656 vv(2)=pizda(1,2)+pizda(2,1)
6657 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6658 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6659 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6666 C Contribution from graph II
6667 call transpose2(EE(1,1,itk),auxmat(1,1))
6668 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6669 vv(1)=pizda(1,1)+pizda(2,2)
6670 vv(2)=pizda(2,1)-pizda(1,2)
6671 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6672 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6674 C Explicit gradient in virtual-dihedral angles.
6675 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6676 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6677 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6678 vv(1)=pizda(1,1)+pizda(2,2)
6679 vv(2)=pizda(2,1)-pizda(1,2)
6681 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6682 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6683 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6685 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6686 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6687 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6689 C Cartesian gradient
6693 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6695 vv(1)=pizda(1,1)+pizda(2,2)
6696 vv(2)=pizda(2,1)-pizda(1,2)
6697 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6698 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6699 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6708 C Parallel orientation
6709 C Contribution from graph III
6710 call transpose2(EUg(1,1,l),auxmat(1,1))
6711 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6712 vv(1)=pizda(1,1)-pizda(2,2)
6713 vv(2)=pizda(1,2)+pizda(2,1)
6714 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6715 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6717 C Explicit gradient in virtual-dihedral angles.
6718 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6719 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6720 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6721 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6722 vv(1)=pizda(1,1)-pizda(2,2)
6723 vv(2)=pizda(1,2)+pizda(2,1)
6724 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6725 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6726 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6727 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6728 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6729 vv(1)=pizda(1,1)-pizda(2,2)
6730 vv(2)=pizda(1,2)+pizda(2,1)
6731 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6732 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6733 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6734 C Cartesian gradient
6738 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6740 vv(1)=pizda(1,1)-pizda(2,2)
6741 vv(2)=pizda(1,2)+pizda(2,1)
6742 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6743 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6744 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6750 C Contribution from graph IV
6752 call transpose2(EE(1,1,itl),auxmat(1,1))
6753 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6754 vv(1)=pizda(1,1)+pizda(2,2)
6755 vv(2)=pizda(2,1)-pizda(1,2)
6756 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6757 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6759 C Explicit gradient in virtual-dihedral angles.
6760 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6761 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6762 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6763 vv(1)=pizda(1,1)+pizda(2,2)
6764 vv(2)=pizda(2,1)-pizda(1,2)
6765 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6766 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6767 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6768 C Cartesian gradient
6772 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6774 vv(1)=pizda(1,1)+pizda(2,2)
6775 vv(2)=pizda(2,1)-pizda(1,2)
6776 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6777 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6778 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6784 C Antiparallel orientation
6785 C Contribution from graph III
6787 call transpose2(EUg(1,1,j),auxmat(1,1))
6788 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6789 vv(1)=pizda(1,1)-pizda(2,2)
6790 vv(2)=pizda(1,2)+pizda(2,1)
6791 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6792 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6794 C Explicit gradient in virtual-dihedral angles.
6795 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6796 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6797 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6798 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6799 vv(1)=pizda(1,1)-pizda(2,2)
6800 vv(2)=pizda(1,2)+pizda(2,1)
6801 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6802 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6803 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6804 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6805 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6806 vv(1)=pizda(1,1)-pizda(2,2)
6807 vv(2)=pizda(1,2)+pizda(2,1)
6808 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6809 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6810 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6811 C Cartesian gradient
6815 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6817 vv(1)=pizda(1,1)-pizda(2,2)
6818 vv(2)=pizda(1,2)+pizda(2,1)
6819 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6820 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6821 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6827 C Contribution from graph IV
6829 call transpose2(EE(1,1,itj),auxmat(1,1))
6830 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6831 vv(1)=pizda(1,1)+pizda(2,2)
6832 vv(2)=pizda(2,1)-pizda(1,2)
6833 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6834 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6836 C Explicit gradient in virtual-dihedral angles.
6837 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6838 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6839 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6840 vv(1)=pizda(1,1)+pizda(2,2)
6841 vv(2)=pizda(2,1)-pizda(1,2)
6842 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6843 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6844 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6845 C Cartesian gradient
6849 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6851 vv(1)=pizda(1,1)+pizda(2,2)
6852 vv(2)=pizda(2,1)-pizda(1,2)
6853 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6854 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6855 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6862 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6863 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6864 cd write (2,*) 'ijkl',i,j,k,l
6865 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6866 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6868 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6869 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6870 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6871 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6873 if (j.lt.nres-1) then
6880 if (l.lt.nres-1) then
6890 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6892 ggg1(ll)=eel5*g_contij(ll,1)
6893 ggg2(ll)=eel5*g_contij(ll,2)
6894 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6895 ghalf=0.5d0*ggg1(ll)
6897 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6898 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6899 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6900 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6901 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6902 ghalf=0.5d0*ggg2(ll)
6904 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6905 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6906 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6907 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6912 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6913 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6918 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6919 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6925 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6930 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6934 cd write (2,*) iii,g_corr5_loc(iii)
6938 cd write (2,*) 'ekont',ekont
6939 cd write (iout,*) 'eello5',ekont*eel5
6942 c--------------------------------------------------------------------------
6943 double precision function eello6(i,j,k,l,jj,kk)
6944 implicit real*8 (a-h,o-z)
6945 include 'DIMENSIONS'
6946 include 'DIMENSIONS.ZSCOPT'
6947 include 'COMMON.IOUNITS'
6948 include 'COMMON.CHAIN'
6949 include 'COMMON.DERIV'
6950 include 'COMMON.INTERACT'
6951 include 'COMMON.CONTACTS'
6952 include 'COMMON.TORSION'
6953 include 'COMMON.VAR'
6954 include 'COMMON.GEO'
6955 include 'COMMON.FFIELD'
6956 double precision ggg1(3),ggg2(3)
6957 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6962 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6970 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6971 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6975 derx(lll,kkk,iii)=0.0d0
6979 cd eij=facont_hb(jj,i)
6980 cd ekl=facont_hb(kk,k)
6986 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6987 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6988 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6989 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6990 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6991 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6993 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6994 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6995 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6996 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6997 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6998 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7002 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7004 C If turn contributions are considered, they will be handled separately.
7005 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7006 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7007 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7008 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7009 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7010 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7011 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7014 if (j.lt.nres-1) then
7021 if (l.lt.nres-1) then
7029 ggg1(ll)=eel6*g_contij(ll,1)
7030 ggg2(ll)=eel6*g_contij(ll,2)
7031 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7032 ghalf=0.5d0*ggg1(ll)
7034 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7035 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7036 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7037 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7038 ghalf=0.5d0*ggg2(ll)
7039 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7041 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7042 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7043 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7044 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7049 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7050 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7055 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7056 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7062 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7067 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7071 cd write (2,*) iii,g_corr6_loc(iii)
7075 cd write (2,*) 'ekont',ekont
7076 cd write (iout,*) 'eello6',ekont*eel6
7079 c--------------------------------------------------------------------------
7080 double precision function eello6_graph1(i,j,k,l,imat,swap)
7081 implicit real*8 (a-h,o-z)
7082 include 'DIMENSIONS'
7083 include 'DIMENSIONS.ZSCOPT'
7084 include 'COMMON.IOUNITS'
7085 include 'COMMON.CHAIN'
7086 include 'COMMON.DERIV'
7087 include 'COMMON.INTERACT'
7088 include 'COMMON.CONTACTS'
7089 include 'COMMON.TORSION'
7090 include 'COMMON.VAR'
7091 include 'COMMON.GEO'
7092 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7096 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7098 C Parallel Antiparallel C
7104 C \ j|/k\| / \ |/k\|l / C
7109 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7110 itk=itortyp(itype(k))
7111 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7112 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7113 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7114 call transpose2(EUgC(1,1,k),auxmat(1,1))
7115 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7116 vv1(1)=pizda1(1,1)-pizda1(2,2)
7117 vv1(2)=pizda1(1,2)+pizda1(2,1)
7118 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7119 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7120 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7121 s5=scalar2(vv(1),Dtobr2(1,i))
7122 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7123 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7124 if (.not. calc_grad) return
7125 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7126 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7127 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7128 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7129 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7130 & +scalar2(vv(1),Dtobr2der(1,i)))
7131 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7132 vv1(1)=pizda1(1,1)-pizda1(2,2)
7133 vv1(2)=pizda1(1,2)+pizda1(2,1)
7134 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7135 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7137 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7138 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7139 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7140 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7141 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7143 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7144 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7145 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7146 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7147 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7149 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7150 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7151 vv1(1)=pizda1(1,1)-pizda1(2,2)
7152 vv1(2)=pizda1(1,2)+pizda1(2,1)
7153 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7154 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7155 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7156 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7165 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7166 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7167 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7168 call transpose2(EUgC(1,1,k),auxmat(1,1))
7169 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7171 vv1(1)=pizda1(1,1)-pizda1(2,2)
7172 vv1(2)=pizda1(1,2)+pizda1(2,1)
7173 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7174 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7175 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7176 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7177 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7178 s5=scalar2(vv(1),Dtobr2(1,i))
7179 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7185 c----------------------------------------------------------------------------
7186 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7187 implicit real*8 (a-h,o-z)
7188 include 'DIMENSIONS'
7189 include 'DIMENSIONS.ZSCOPT'
7190 include 'COMMON.IOUNITS'
7191 include 'COMMON.CHAIN'
7192 include 'COMMON.DERIV'
7193 include 'COMMON.INTERACT'
7194 include 'COMMON.CONTACTS'
7195 include 'COMMON.TORSION'
7196 include 'COMMON.VAR'
7197 include 'COMMON.GEO'
7199 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7200 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7203 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7205 C Parallel Antiparallel C
7211 C \ j|/k\| \ |/k\|l C
7216 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7217 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7218 C AL 7/4/01 s1 would occur in the sixth-order moment,
7219 C but not in a cluster cumulant
7221 s1=dip(1,jj,i)*dip(1,kk,k)
7223 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7224 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7225 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7226 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7227 call transpose2(EUg(1,1,k),auxmat(1,1))
7228 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7229 vv(1)=pizda(1,1)-pizda(2,2)
7230 vv(2)=pizda(1,2)+pizda(2,1)
7231 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7232 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7234 eello6_graph2=-(s1+s2+s3+s4)
7236 eello6_graph2=-(s2+s3+s4)
7239 if (.not. calc_grad) return
7240 C Derivatives in gamma(i-1)
7243 s1=dipderg(1,jj,i)*dip(1,kk,k)
7245 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7246 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7247 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7248 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7250 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7252 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7254 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7256 C Derivatives in gamma(k-1)
7258 s1=dip(1,jj,i)*dipderg(1,kk,k)
7260 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7261 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7262 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7263 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7264 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7265 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7266 vv(1)=pizda(1,1)-pizda(2,2)
7267 vv(2)=pizda(1,2)+pizda(2,1)
7268 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7270 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7272 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7274 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7275 C Derivatives in gamma(j-1) or gamma(l-1)
7278 s1=dipderg(3,jj,i)*dip(1,kk,k)
7280 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7281 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7282 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7283 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7284 vv(1)=pizda(1,1)-pizda(2,2)
7285 vv(2)=pizda(1,2)+pizda(2,1)
7286 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7289 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7291 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7294 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7295 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7297 C Derivatives in gamma(l-1) or gamma(j-1)
7300 s1=dip(1,jj,i)*dipderg(3,kk,k)
7302 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7303 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7304 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7305 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7306 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7307 vv(1)=pizda(1,1)-pizda(2,2)
7308 vv(2)=pizda(1,2)+pizda(2,1)
7309 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7312 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7314 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7317 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7318 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7320 C Cartesian derivatives.
7322 write (2,*) 'In eello6_graph2'
7324 write (2,*) 'iii=',iii
7326 write (2,*) 'kkk=',kkk
7328 write (2,'(3(2f10.5),5x)')
7329 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7339 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7341 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7344 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7346 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7347 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7349 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7350 call transpose2(EUg(1,1,k),auxmat(1,1))
7351 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7353 vv(1)=pizda(1,1)-pizda(2,2)
7354 vv(2)=pizda(1,2)+pizda(2,1)
7355 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7356 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7358 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7360 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7363 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7372 c----------------------------------------------------------------------------
7373 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 include 'DIMENSIONS.ZSCOPT'
7377 include 'COMMON.IOUNITS'
7378 include 'COMMON.CHAIN'
7379 include 'COMMON.DERIV'
7380 include 'COMMON.INTERACT'
7381 include 'COMMON.CONTACTS'
7382 include 'COMMON.TORSION'
7383 include 'COMMON.VAR'
7384 include 'COMMON.GEO'
7385 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7387 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7389 C Parallel Antiparallel C
7395 C j|/k\| / |/k\|l / C
7400 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7402 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7403 C energy moment and not to the cluster cumulant.
7404 iti=itortyp(itype(i))
7405 if (j.lt.nres-1) then
7406 itj1=itortyp(itype(j+1))
7410 itk=itortyp(itype(k))
7411 itk1=itortyp(itype(k+1))
7412 if (l.lt.nres-1) then
7413 itl1=itortyp(itype(l+1))
7418 s1=dip(4,jj,i)*dip(4,kk,k)
7420 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7421 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7422 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7423 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7424 call transpose2(EE(1,1,itk),auxmat(1,1))
7425 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7426 vv(1)=pizda(1,1)+pizda(2,2)
7427 vv(2)=pizda(2,1)-pizda(1,2)
7428 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7429 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7431 eello6_graph3=-(s1+s2+s3+s4)
7433 eello6_graph3=-(s2+s3+s4)
7436 if (.not. calc_grad) return
7437 C Derivatives in gamma(k-1)
7438 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7439 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7440 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7441 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7442 C Derivatives in gamma(l-1)
7443 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7444 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7445 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7446 vv(1)=pizda(1,1)+pizda(2,2)
7447 vv(2)=pizda(2,1)-pizda(1,2)
7448 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7449 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7450 C Cartesian derivatives.
7456 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7458 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7461 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7463 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7464 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7466 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7467 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7469 vv(1)=pizda(1,1)+pizda(2,2)
7470 vv(2)=pizda(2,1)-pizda(1,2)
7471 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7473 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7475 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7478 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7480 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7482 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7488 c----------------------------------------------------------------------------
7489 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7490 implicit real*8 (a-h,o-z)
7491 include 'DIMENSIONS'
7492 include 'DIMENSIONS.ZSCOPT'
7493 include 'COMMON.IOUNITS'
7494 include 'COMMON.CHAIN'
7495 include 'COMMON.DERIV'
7496 include 'COMMON.INTERACT'
7497 include 'COMMON.CONTACTS'
7498 include 'COMMON.TORSION'
7499 include 'COMMON.VAR'
7500 include 'COMMON.GEO'
7501 include 'COMMON.FFIELD'
7502 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7503 & auxvec1(2),auxmat1(2,2)
7505 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7507 C Parallel Antiparallel C
7513 C \ j|/k\| \ |/k\|l C
7518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7520 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7521 C energy moment and not to the cluster cumulant.
7522 cd write (2,*) 'eello_graph4: wturn6',wturn6
7523 iti=itortyp(itype(i))
7524 itj=itortyp(itype(j))
7525 if (j.lt.nres-1) then
7526 itj1=itortyp(itype(j+1))
7530 itk=itortyp(itype(k))
7531 if (k.lt.nres-1) then
7532 itk1=itortyp(itype(k+1))
7536 itl=itortyp(itype(l))
7537 if (l.lt.nres-1) then
7538 itl1=itortyp(itype(l+1))
7542 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7543 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7544 cd & ' itl',itl,' itl1',itl1
7547 s1=dip(3,jj,i)*dip(3,kk,k)
7549 s1=dip(2,jj,j)*dip(2,kk,l)
7552 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7553 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7555 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7556 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7558 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7559 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7561 call transpose2(EUg(1,1,k),auxmat(1,1))
7562 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7563 vv(1)=pizda(1,1)-pizda(2,2)
7564 vv(2)=pizda(2,1)+pizda(1,2)
7565 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7566 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7568 eello6_graph4=-(s1+s2+s3+s4)
7570 eello6_graph4=-(s2+s3+s4)
7572 if (.not. calc_grad) return
7573 C Derivatives in gamma(i-1)
7577 s1=dipderg(2,jj,i)*dip(3,kk,k)
7579 s1=dipderg(4,jj,j)*dip(2,kk,l)
7582 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7584 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7585 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7587 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7588 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7590 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7591 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7592 cd write (2,*) 'turn6 derivatives'
7594 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7596 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7600 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7602 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7606 C Derivatives in gamma(k-1)
7609 s1=dip(3,jj,i)*dipderg(2,kk,k)
7611 s1=dip(2,jj,j)*dipderg(4,kk,l)
7614 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7615 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7617 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7618 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7620 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7621 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7623 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7624 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(2,1)+pizda(1,2)
7627 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7628 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7630 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7632 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7636 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7638 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7641 C Derivatives in gamma(j-1) or gamma(l-1)
7642 if (l.eq.j+1 .and. l.gt.1) then
7643 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7644 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7645 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(2,1)+pizda(1,2)
7648 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7649 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7650 else if (j.gt.1) then
7651 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7652 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7653 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7654 vv(1)=pizda(1,1)-pizda(2,2)
7655 vv(2)=pizda(2,1)+pizda(1,2)
7656 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7657 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7658 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7660 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7663 C Cartesian derivatives.
7670 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7672 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7676 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7678 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7682 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7684 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7686 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7687 & b1(1,itj1),auxvec(1))
7688 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7690 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7691 & b1(1,itl1),auxvec(1))
7692 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7694 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7696 vv(1)=pizda(1,1)-pizda(2,2)
7697 vv(2)=pizda(2,1)+pizda(1,2)
7698 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7700 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7702 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7705 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7708 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7711 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7713 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7715 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7719 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7721 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7724 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7726 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7734 c----------------------------------------------------------------------------
7735 double precision function eello_turn6(i,jj,kk)
7736 implicit real*8 (a-h,o-z)
7737 include 'DIMENSIONS'
7738 include 'DIMENSIONS.ZSCOPT'
7739 include 'COMMON.IOUNITS'
7740 include 'COMMON.CHAIN'
7741 include 'COMMON.DERIV'
7742 include 'COMMON.INTERACT'
7743 include 'COMMON.CONTACTS'
7744 include 'COMMON.TORSION'
7745 include 'COMMON.VAR'
7746 include 'COMMON.GEO'
7747 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7748 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7750 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7751 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7752 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7753 C the respective energy moment and not to the cluster cumulant.
7758 iti=itortyp(itype(i))
7759 itk=itortyp(itype(k))
7760 itk1=itortyp(itype(k+1))
7761 itl=itortyp(itype(l))
7762 itj=itortyp(itype(j))
7763 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7764 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7765 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7770 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7772 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7776 derx_turn(lll,kkk,iii)=0.0d0
7783 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7785 cd write (2,*) 'eello6_5',eello6_5
7787 call transpose2(AEA(1,1,1),auxmat(1,1))
7788 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7789 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7790 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7794 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7795 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7796 s2 = scalar2(b1(1,itk),vtemp1(1))
7798 call transpose2(AEA(1,1,2),atemp(1,1))
7799 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7800 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7801 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7805 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7806 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7807 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7809 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7810 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7811 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7812 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7813 ss13 = scalar2(b1(1,itk),vtemp4(1))
7814 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7818 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7824 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7826 C Derivatives in gamma(i+2)
7828 call transpose2(AEA(1,1,1),auxmatd(1,1))
7829 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7830 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7831 call transpose2(AEAderg(1,1,2),atempd(1,1))
7832 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7833 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7837 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7838 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7839 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7845 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7846 C Derivatives in gamma(i+3)
7848 call transpose2(AEA(1,1,1),auxmatd(1,1))
7849 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7850 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7851 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7855 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7856 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7857 s2d = scalar2(b1(1,itk),vtemp1d(1))
7859 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7860 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7862 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7864 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7865 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7866 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7876 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7877 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7879 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7880 & -0.5d0*ekont*(s2d+s12d)
7882 C Derivatives in gamma(i+4)
7883 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7884 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7885 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7887 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7888 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7889 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7899 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7901 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7903 C Derivatives in gamma(i+5)
7905 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7906 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7907 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7911 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7912 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7913 s2d = scalar2(b1(1,itk),vtemp1d(1))
7915 call transpose2(AEA(1,1,2),atempd(1,1))
7916 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7917 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7921 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7922 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7924 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7925 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7926 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7936 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7937 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7939 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7940 & -0.5d0*ekont*(s2d+s12d)
7942 C Cartesian derivatives
7947 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7948 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7949 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7953 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7954 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7956 s2d = scalar2(b1(1,itk),vtemp1d(1))
7958 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7959 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7960 s8d = -(atempd(1,1)+atempd(2,2))*
7961 & scalar2(cc(1,1,itl),vtemp2(1))
7965 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7967 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7968 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7975 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7978 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7982 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7983 & - 0.5d0*(s8d+s12d)
7985 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7994 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7996 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7997 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7998 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7999 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8000 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8002 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8003 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8004 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8008 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8009 cd & 16*eel_turn6_num
8011 if (j.lt.nres-1) then
8018 if (l.lt.nres-1) then
8026 ggg1(ll)=eel_turn6*g_contij(ll,1)
8027 ggg2(ll)=eel_turn6*g_contij(ll,2)
8028 ghalf=0.5d0*ggg1(ll)
8030 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8031 & +ekont*derx_turn(ll,2,1)
8032 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8033 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8034 & +ekont*derx_turn(ll,4,1)
8035 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8036 ghalf=0.5d0*ggg2(ll)
8038 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8039 & +ekont*derx_turn(ll,2,2)
8040 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8041 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8042 & +ekont*derx_turn(ll,4,2)
8043 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8048 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8053 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8059 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8064 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8068 cd write (2,*) iii,g_corr6_loc(iii)
8071 eello_turn6=ekont*eel_turn6
8072 cd write (2,*) 'ekont',ekont
8073 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8076 crc-------------------------------------------------
8077 SUBROUTINE MATVEC2(A1,V1,V2)
8078 implicit real*8 (a-h,o-z)
8079 include 'DIMENSIONS'
8080 DIMENSION A1(2,2),V1(2),V2(2)
8084 c 3 VI=VI+A1(I,K)*V1(K)
8088 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8089 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8094 C---------------------------------------
8095 SUBROUTINE MATMAT2(A1,A2,A3)
8096 implicit real*8 (a-h,o-z)
8097 include 'DIMENSIONS'
8098 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8099 c DIMENSION AI3(2,2)
8103 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8109 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8110 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8111 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8112 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8120 c-------------------------------------------------------------------------
8121 double precision function scalar2(u,v)
8123 double precision u(2),v(2)
8126 scalar2=u(1)*v(1)+u(2)*v(2)
8130 C-----------------------------------------------------------------------------
8132 subroutine transpose2(a,at)
8134 double precision a(2,2),at(2,2)
8141 c--------------------------------------------------------------------------
8142 subroutine transpose(n,a,at)
8145 double precision a(n,n),at(n,n)
8153 C---------------------------------------------------------------------------
8154 subroutine prodmat3(a1,a2,kk,transp,prod)
8157 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8159 crc double precision auxmat(2,2),prod_(2,2)
8162 crc call transpose2(kk(1,1),auxmat(1,1))
8163 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8164 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8166 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8167 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8168 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8169 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8170 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8171 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8172 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8173 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8176 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8177 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8179 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8180 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8181 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8182 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8183 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8184 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8185 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8186 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8189 c call transpose2(a2(1,1),a2t(1,1))
8192 crc print *,((prod_(i,j),i=1,2),j=1,2)
8193 crc print *,((prod(i,j),i=1,2),j=1,2)
8197 C-----------------------------------------------------------------------------
8198 double precision function scalar(u,v)
8200 double precision u(3),v(3)