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 'COMMON.SBRIDGE'
2952 include 'COMMON.CHAIN'
2953 include 'COMMON.DERIV'
2954 include 'COMMON.VAR'
2955 include 'COMMON.INTERACT'
2956 include 'COMMON.IOUNITS'
2959 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2960 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2961 if (link_end.eq.0) return
2962 do i=link_start,link_end
2963 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2964 C CA-CA distance used in regularization of structure.
2967 C iii and jjj point to the residues for which the distance is assigned.
2968 if (ii.gt.nres) then
2975 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2976 c & dhpb(i),dhpb1(i),forcon(i)
2977 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2978 C distance and angle dependent SS bond potential.
2979 if (.not.dyn_ss .and. i.le.nss) then
2980 C 15/02/13 CC dynamic SSbond - additional check
2981 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2982 call ssbond_ene(iii,jjj,eij)
2985 cd write (iout,*) "eij",eij
2986 else if (ii.gt.nres .and. jj.gt.nres) then
2987 c Restraints from contact prediction
2989 if (dhpb1(i).gt.0.0d0) then
2990 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2991 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2992 c write (iout,*) "beta nmr",
2993 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2997 C Get the force constant corresponding to this distance.
2999 C Calculate the contribution to energy.
3000 ehpb=ehpb+waga*rdis*rdis
3001 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3003 C Evaluate gradient.
3008 ggg(j)=fac*(c(j,jj)-c(j,ii))
3011 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3012 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3015 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3016 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3019 C Calculate the distance between the two points and its difference from the
3022 if (dhpb1(i).gt.0.0d0) then
3023 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3024 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3025 c write (iout,*) "alph nmr",
3026 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3029 C Get the force constant corresponding to this distance.
3031 C Calculate the contribution to energy.
3032 ehpb=ehpb+waga*rdis*rdis
3033 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3035 C Evaluate gradient.
3039 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3040 cd & ' waga=',waga,' fac=',fac
3042 ggg(j)=fac*(c(j,jj)-c(j,ii))
3044 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3045 C If this is a SC-SC distance, we need to calculate the contributions to the
3046 C Cartesian gradient in the SC vectors (ghpbx).
3049 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3050 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3054 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3055 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3062 C--------------------------------------------------------------------------
3063 subroutine ssbond_ene(i,j,eij)
3065 C Calculate the distance and angle dependent SS-bond potential energy
3066 C using a free-energy function derived based on RHF/6-31G** ab initio
3067 C calculations of diethyl disulfide.
3069 C A. Liwo and U. Kozlowska, 11/24/03
3071 implicit real*8 (a-h,o-z)
3072 include 'DIMENSIONS'
3073 include 'DIMENSIONS.ZSCOPT'
3074 include 'COMMON.SBRIDGE'
3075 include 'COMMON.CHAIN'
3076 include 'COMMON.DERIV'
3077 include 'COMMON.LOCAL'
3078 include 'COMMON.INTERACT'
3079 include 'COMMON.VAR'
3080 include 'COMMON.IOUNITS'
3081 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3086 dxi=dc_norm(1,nres+i)
3087 dyi=dc_norm(2,nres+i)
3088 dzi=dc_norm(3,nres+i)
3089 dsci_inv=dsc_inv(itypi)
3091 dscj_inv=dsc_inv(itypj)
3095 dxj=dc_norm(1,nres+j)
3096 dyj=dc_norm(2,nres+j)
3097 dzj=dc_norm(3,nres+j)
3098 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3103 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3104 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3105 om12=dxi*dxj+dyi*dyj+dzi*dzj
3107 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3108 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3114 deltat12=om2-om1+2.0d0
3116 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3117 & +akct*deltad*deltat12+ebr
3118 c & +akct*deltad*deltat12
3119 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3120 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3121 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3122 & " deltat12",deltat12," eij",eij,"ebr",ebr
3123 ed=2*akcm*deltad+akct*deltat12
3125 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3126 eom1=-2*akth*deltat1-pom1-om2*pom2
3127 eom2= 2*akth*deltat2+pom1-om1*pom2
3130 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3133 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3134 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3135 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3136 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3139 C Calculate the components of the gradient in DC and X
3143 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3148 C--------------------------------------------------------------------------
3149 c MODELLER restraint function
3150 subroutine e_modeller(ehomology_constr)
3151 implicit real*8 (a-h,o-z)
3152 include 'DIMENSIONS'
3153 include 'DIMENSIONS.ZSCOPT'
3154 include 'DIMENSIONS.FREE'
3155 integer nnn, i, j, k, ki, irec, l
3156 integer katy, odleglosci, test7
3157 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3158 real*8 distance(max_template),distancek(max_template),
3159 & min_odl,godl(max_template),dih_diff(max_template)
3162 c FP - 30/10/2014 Temporary specifications for homology restraints
3164 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3166 double precision, dimension (maxres) :: guscdiff,usc_diff
3167 double precision, dimension (max_template) ::
3168 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3171 include 'COMMON.SBRIDGE'
3172 include 'COMMON.CHAIN'
3173 include 'COMMON.GEO'
3174 include 'COMMON.DERIV'
3175 include 'COMMON.LOCAL'
3176 include 'COMMON.INTERACT'
3177 include 'COMMON.VAR'
3178 include 'COMMON.IOUNITS'
3179 include 'COMMON.CONTROL'
3180 include 'COMMON.HOMRESTR'
3182 include 'COMMON.SETUP'
3183 include 'COMMON.NAMES'
3186 distancek(i)=9999999.9
3191 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3193 C AL 5/2/14 - Introduce list of restraints
3194 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3196 write(iout,*) "------- dist restrs start -------"
3198 do ii = link_start_homo,link_end_homo
3202 c write (iout,*) "dij(",i,j,") =",dij
3203 do k=1,constr_homology
3204 if(.not.l_homo(k,ii)) cycle
3205 distance(k)=odl(k,ii)-dij
3206 c write (iout,*) "distance(",k,") =",distance(k)
3208 c For Gaussian-type Urestr
3210 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3211 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3212 c write (iout,*) "distancek(",k,") =",distancek(k)
3213 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3215 c For Lorentzian-type Urestr
3217 if (waga_dist.lt.0.0d0) then
3218 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3219 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3220 & (distance(k)**2+sigma_odlir(k,ii)**2))
3224 c min_odl=minval(distancek)
3225 do kk=1,constr_homology
3226 if(l_homo(kk,ii)) then
3227 min_odl=distancek(kk)
3231 do kk=1,constr_homology
3232 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3233 & min_odl=distancek(kk)
3235 c write (iout,* )"min_odl",min_odl
3237 write (iout,*) "ij dij",i,j,dij
3238 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3239 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3240 write (iout,* )"min_odl",min_odl
3243 do k=1,constr_homology
3244 c Nie wiem po co to liczycie jeszcze raz!
3245 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3246 c & (2*(sigma_odl(i,j,k))**2))
3247 if(.not.l_homo(k,ii)) cycle
3248 if (waga_dist.ge.0.0d0) then
3250 c For Gaussian-type Urestr
3252 godl(k)=dexp(-distancek(k)+min_odl)
3253 odleg2=odleg2+godl(k)
3255 c For Lorentzian-type Urestr
3258 odleg2=odleg2+distancek(k)
3261 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3262 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3263 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3264 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3267 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3268 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3270 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3271 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3273 if (waga_dist.ge.0.0d0) then
3275 c For Gaussian-type Urestr
3277 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3279 c For Lorentzian-type Urestr
3282 odleg=odleg+odleg2/constr_homology
3286 c write (iout,*) "odleg",odleg ! sum of -ln-s
3289 c For Gaussian-type Urestr
3291 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3293 do k=1,constr_homology
3294 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3295 c & *waga_dist)+min_odl
3296 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3298 if(.not.l_homo(k,ii)) cycle
3299 if (waga_dist.ge.0.0d0) then
3300 c For Gaussian-type Urestr
3302 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3304 c For Lorentzian-type Urestr
3307 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3308 & sigma_odlir(k,ii)**2)**2)
3310 sum_sgodl=sum_sgodl+sgodl
3312 c sgodl2=sgodl2+sgodl
3313 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3314 c write(iout,*) "constr_homology=",constr_homology
3315 c write(iout,*) i, j, k, "TEST K"
3317 if (waga_dist.ge.0.0d0) then
3319 c For Gaussian-type Urestr
3321 grad_odl3=waga_homology(iset)*waga_dist
3322 & *sum_sgodl/(sum_godl*dij)
3324 c For Lorentzian-type Urestr
3327 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3328 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3329 grad_odl3=-waga_homology(iset)*waga_dist*
3330 & sum_sgodl/(constr_homology*dij)
3333 c grad_odl3=sum_sgodl/(sum_godl*dij)
3336 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3337 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3338 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3340 ccc write(iout,*) godl, sgodl, grad_odl3
3342 c grad_odl=grad_odl+grad_odl3
3345 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3346 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3347 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3348 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3349 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3350 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3351 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3352 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3353 c if (i.eq.25.and.j.eq.27) then
3354 c write(iout,*) "jik",jik,"i",i,"j",j
3355 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3356 c write(iout,*) "grad_odl3",grad_odl3
3357 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3358 c write(iout,*) "ggodl",ggodl
3359 c write(iout,*) "ghpbc(",jik,i,")",
3360 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3365 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3366 ccc & dLOG(odleg2),"-odleg=", -odleg
3368 enddo ! ii-loop for dist
3370 write(iout,*) "------- dist restrs end -------"
3371 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3372 c & waga_d.eq.1.0d0) call sum_gradient
3374 c Pseudo-energy and gradient from dihedral-angle restraints from
3375 c homology templates
3376 c write (iout,*) "End of distance loop"
3379 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3381 write(iout,*) "------- dih restrs start -------"
3382 do i=idihconstr_start_homo,idihconstr_end_homo
3383 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3386 do i=idihconstr_start_homo,idihconstr_end_homo
3388 c betai=beta(i,i+1,i+2,i+3)
3390 c write (iout,*) "betai =",betai
3391 do k=1,constr_homology
3392 dih_diff(k)=pinorm(dih(k,i)-betai)
3393 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3394 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3395 c & -(6.28318-dih_diff(i,k))
3396 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3397 c & 6.28318+dih_diff(i,k)
3399 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3400 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3403 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3406 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3407 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3409 write (iout,*) "i",i," betai",betai," kat2",kat2
3410 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3412 if (kat2.le.1.0d-14) cycle
3413 kat=kat-dLOG(kat2/constr_homology)
3414 c write (iout,*) "kat",kat ! sum of -ln-s
3416 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3417 ccc & dLOG(kat2), "-kat=", -kat
3420 c ----------------------------------------------------------------------
3422 c ----------------------------------------------------------------------
3426 do k=1,constr_homology
3427 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3428 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3429 sum_sgdih=sum_sgdih+sgdih
3431 c grad_dih3=sum_sgdih/sum_gdih
3432 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3434 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3435 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3436 ccc & gloc(nphi+i-3,icg)
3437 gloc(i,icg)=gloc(i,icg)+grad_dih3
3439 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3441 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3442 ccc & gloc(nphi+i-3,icg)
3444 enddo ! i-loop for dih
3446 write(iout,*) "------- dih restrs end -------"
3449 c Pseudo-energy and gradient for theta angle restraints from
3450 c homology templates
3451 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3455 c For constr_homology reference structures (FP)
3457 c Uconst_back_tot=0.0d0
3460 c Econstr_back legacy
3463 c do i=ithet_start,ithet_end
3466 c do i=loc_start,loc_end
3469 duscdiffx(j,i)=0.0d0
3475 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3476 c write (iout,*) "waga_theta",waga_theta
3477 if (waga_theta.gt.0.0d0) then
3479 write (iout,*) "usampl",usampl
3480 write(iout,*) "------- theta restrs start -------"
3481 c do i=ithet_start,ithet_end
3482 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3485 c write (iout,*) "maxres",maxres,"nres",nres
3487 do i=ithet_start,ithet_end
3490 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3492 c Deviation of theta angles wrt constr_homology ref structures
3494 utheta_i=0.0d0 ! argument of Gaussian for single k
3495 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3496 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3497 c over residues in a fragment
3498 c write (iout,*) "theta(",i,")=",theta(i)
3499 do k=1,constr_homology
3501 c dtheta_i=theta(j)-thetaref(j,iref)
3502 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3503 theta_diff(k)=thetatpl(k,i)-theta(i)
3505 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3506 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3507 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3508 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3509 c Gradient for single Gaussian restraint in subr Econstr_back
3510 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3513 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3514 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3518 c Gradient for multiple Gaussian restraint
3519 sum_gtheta=gutheta_i
3521 do k=1,constr_homology
3522 c New generalized expr for multiple Gaussian from Econstr_back
3523 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3525 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3526 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3529 c Final value of gradient using same var as in Econstr_back
3530 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3531 & *waga_homology(iset)
3532 c dutheta(i)=sum_sgtheta/sum_gtheta
3534 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3536 Eval=Eval-dLOG(gutheta_i/constr_homology)
3537 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3538 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3539 c Uconst_back=Uconst_back+utheta(i)
3540 enddo ! (i-loop for theta)
3542 write(iout,*) "------- theta restrs end -------"
3546 c Deviation of local SC geometry
3548 c Separation of two i-loops (instructed by AL - 11/3/2014)
3550 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3551 c write (iout,*) "waga_d",waga_d
3554 write(iout,*) "------- SC restrs start -------"
3555 write (iout,*) "Initial duscdiff,duscdiffx"
3556 do i=loc_start,loc_end
3557 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3558 & (duscdiffx(jik,i),jik=1,3)
3561 do i=loc_start,loc_end
3562 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3563 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3564 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3565 c write(iout,*) "xxtab, yytab, zztab"
3566 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3567 do k=1,constr_homology
3569 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3570 c Original sign inverted for calc of gradients (s. Econstr_back)
3571 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3572 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3573 c write(iout,*) "dxx, dyy, dzz"
3574 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3576 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3577 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3578 c uscdiffk(k)=usc_diff(i)
3579 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3580 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3581 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3582 c & xxref(j),yyref(j),zzref(j)
3587 c Generalized expression for multiple Gaussian acc to that for a single
3588 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3590 c Original implementation
3591 c sum_guscdiff=guscdiff(i)
3593 c sum_sguscdiff=0.0d0
3594 c do k=1,constr_homology
3595 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3596 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3597 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3600 c Implementation of new expressions for gradient (Jan. 2015)
3602 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3604 do k=1,constr_homology
3606 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3607 c before. Now the drivatives should be correct
3609 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3610 c Original sign inverted for calc of gradients (s. Econstr_back)
3611 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3612 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3614 c New implementation
3616 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3617 & sigma_d(k,i) ! for the grad wrt r'
3618 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3621 c New implementation
3622 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3624 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3625 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3626 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3627 duscdiff(jik,i)=duscdiff(jik,i)+
3628 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3629 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3630 duscdiffx(jik,i)=duscdiffx(jik,i)+
3631 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3632 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3635 write(iout,*) "jik",jik,"i",i
3636 write(iout,*) "dxx, dyy, dzz"
3637 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3638 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3639 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3640 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3641 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3642 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3643 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3644 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3645 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3646 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3647 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3648 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3649 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3650 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3651 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3658 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3659 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3661 c write (iout,*) i," uscdiff",uscdiff(i)
3663 c Put together deviations from local geometry
3665 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3666 c & wfrag_back(3,i,iset)*uscdiff(i)
3667 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3668 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3669 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3670 c Uconst_back=Uconst_back+usc_diff(i)
3672 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3674 c New implment: multiplied by sum_sguscdiff
3677 enddo ! (i-loop for dscdiff)
3682 write(iout,*) "------- SC restrs end -------"
3683 write (iout,*) "------ After SC loop in e_modeller ------"
3684 do i=loc_start,loc_end
3685 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3686 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3688 if (waga_theta.eq.1.0d0) then
3689 write (iout,*) "in e_modeller after SC restr end: dutheta"
3690 do i=ithet_start,ithet_end
3691 write (iout,*) i,dutheta(i)
3694 if (waga_d.eq.1.0d0) then
3695 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3697 write (iout,*) i,(duscdiff(j,i),j=1,3)
3698 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3703 c Total energy from homology restraints
3705 write (iout,*) "odleg",odleg," kat",kat
3706 write (iout,*) "odleg",odleg," kat",kat
3707 write (iout,*) "Eval",Eval," Erot",Erot
3708 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3709 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3710 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3713 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3715 c ehomology_constr=odleg+kat
3717 c For Lorentzian-type Urestr
3720 if (waga_dist.ge.0.0d0) then
3722 c For Gaussian-type Urestr
3724 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3725 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3726 ehomology_constr=waga_dist*odleg+waga_angle*kat+
3727 & waga_theta*Eval+waga_d*Erot
3728 c write (iout,*) "ehomology_constr=",ehomology_constr
3731 c For Lorentzian-type Urestr
3733 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3734 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3735 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
3736 & waga_theta*Eval+waga_d*Erot
3737 c write (iout,*) "ehomology_constr=",ehomology_constr
3740 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3741 & "Eval",waga_theta,eval,
3742 & "Erot",waga_d,Erot
3743 write (iout,*) "ehomology_constr",ehomology_constr
3747 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3748 747 format(a12,i4,i4,i4,f8.3,f8.3)
3749 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3750 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3751 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3752 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3754 c-----------------------------------------------------------------------
3755 subroutine ebond(estr)
3757 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3759 implicit real*8 (a-h,o-z)
3760 include 'DIMENSIONS'
3761 include 'DIMENSIONS.ZSCOPT'
3762 include 'DIMENSIONS.FREE'
3763 include 'COMMON.LOCAL'
3764 include 'COMMON.GEO'
3765 include 'COMMON.INTERACT'
3766 include 'COMMON.DERIV'
3767 include 'COMMON.VAR'
3768 include 'COMMON.CHAIN'
3769 include 'COMMON.IOUNITS'
3770 include 'COMMON.NAMES'
3771 include 'COMMON.FFIELD'
3772 include 'COMMON.CONTROL'
3773 double precision u(3),ud(3)
3774 logical :: lprn=.false.
3777 diff = vbld(i)-vbldp0
3778 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3781 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3786 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3793 diff=vbld(i+nres)-vbldsc0(1,iti)
3795 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3796 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3797 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3799 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3803 diff=vbld(i+nres)-vbldsc0(j,iti)
3804 ud(j)=aksc(j,iti)*diff
3805 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3819 uprod2=uprod2*u(k)*u(k)
3823 usumsqder=usumsqder+ud(j)*uprod2
3826 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3827 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3828 estr=estr+uprod/usum
3830 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3838 C--------------------------------------------------------------------------
3839 subroutine ebend(etheta)
3841 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3842 C angles gamma and its derivatives in consecutive thetas and gammas.
3844 implicit real*8 (a-h,o-z)
3845 include 'DIMENSIONS'
3846 include 'DIMENSIONS.ZSCOPT'
3847 include 'COMMON.LOCAL'
3848 include 'COMMON.GEO'
3849 include 'COMMON.INTERACT'
3850 include 'COMMON.DERIV'
3851 include 'COMMON.VAR'
3852 include 'COMMON.CHAIN'
3853 include 'COMMON.IOUNITS'
3854 include 'COMMON.NAMES'
3855 include 'COMMON.FFIELD'
3856 common /calcthet/ term1,term2,termm,diffak,ratak,
3857 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3858 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3859 double precision y(2),z(2)
3861 time11=dexp(-2*time)
3864 c write (iout,*) "nres",nres
3865 c write (*,'(a,i2)') 'EBEND ICG=',icg
3866 c write (iout,*) ithet_start,ithet_end
3867 do i=ithet_start,ithet_end
3868 C Zero the energy function and its derivative at 0 or pi.
3869 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3871 c if (i.gt.ithet_start .and.
3872 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3873 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3881 c if (i.lt.nres .and. itel(i).ne.0) then
3893 call proc_proc(phii,icrc)
3894 if (icrc.eq.1) phii=150.0
3908 call proc_proc(phii1,icrc)
3909 if (icrc.eq.1) phii1=150.0
3921 C Calculate the "mean" value of theta from the part of the distribution
3922 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3923 C In following comments this theta will be referred to as t_c.
3924 thet_pred_mean=0.0d0
3928 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3930 c write (iout,*) "thet_pred_mean",thet_pred_mean
3931 dthett=thet_pred_mean*ssd
3932 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3933 c write (iout,*) "thet_pred_mean",thet_pred_mean
3934 C Derivatives of the "mean" values in gamma1 and gamma2.
3935 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3936 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3937 if (theta(i).gt.pi-delta) then
3938 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3940 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3941 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3942 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3944 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3946 else if (theta(i).lt.delta) then
3947 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3948 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3949 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3951 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3952 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3955 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3958 etheta=etheta+ethetai
3959 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3960 c & rad2deg*phii,rad2deg*phii1,ethetai
3961 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3962 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3963 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3966 C Ufff.... We've done all this!!!
3969 C---------------------------------------------------------------------------
3970 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3972 implicit real*8 (a-h,o-z)
3973 include 'DIMENSIONS'
3974 include 'COMMON.LOCAL'
3975 include 'COMMON.IOUNITS'
3976 common /calcthet/ term1,term2,termm,diffak,ratak,
3977 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3978 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3979 C Calculate the contributions to both Gaussian lobes.
3980 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3981 C The "polynomial part" of the "standard deviation" of this part of
3985 sig=sig*thet_pred_mean+polthet(j,it)
3987 C Derivative of the "interior part" of the "standard deviation of the"
3988 C gamma-dependent Gaussian lobe in t_c.
3989 sigtc=3*polthet(3,it)
3991 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3994 C Set the parameters of both Gaussian lobes of the distribution.
3995 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3996 fac=sig*sig+sigc0(it)
3999 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4000 sigsqtc=-4.0D0*sigcsq*sigtc
4001 c print *,i,sig,sigtc,sigsqtc
4002 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4003 sigtc=-sigtc/(fac*fac)
4004 C Following variable is sigma(t_c)**(-2)
4005 sigcsq=sigcsq*sigcsq
4007 sig0inv=1.0D0/sig0i**2
4008 delthec=thetai-thet_pred_mean
4009 delthe0=thetai-theta0i
4010 term1=-0.5D0*sigcsq*delthec*delthec
4011 term2=-0.5D0*sig0inv*delthe0*delthe0
4012 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4013 C NaNs in taking the logarithm. We extract the largest exponent which is added
4014 C to the energy (this being the log of the distribution) at the end of energy
4015 C term evaluation for this virtual-bond angle.
4016 if (term1.gt.term2) then
4018 term2=dexp(term2-termm)
4022 term1=dexp(term1-termm)
4025 C The ratio between the gamma-independent and gamma-dependent lobes of
4026 C the distribution is a Gaussian function of thet_pred_mean too.
4027 diffak=gthet(2,it)-thet_pred_mean
4028 ratak=diffak/gthet(3,it)**2
4029 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4030 C Let's differentiate it in thet_pred_mean NOW.
4032 C Now put together the distribution terms to make complete distribution.
4033 termexp=term1+ak*term2
4034 termpre=sigc+ak*sig0i
4035 C Contribution of the bending energy from this theta is just the -log of
4036 C the sum of the contributions from the two lobes and the pre-exponential
4037 C factor. Simple enough, isn't it?
4038 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4039 C NOW the derivatives!!!
4040 C 6/6/97 Take into account the deformation.
4041 E_theta=(delthec*sigcsq*term1
4042 & +ak*delthe0*sig0inv*term2)/termexp
4043 E_tc=((sigtc+aktc*sig0i)/termpre
4044 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4045 & aktc*term2)/termexp)
4048 c-----------------------------------------------------------------------------
4049 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4050 implicit real*8 (a-h,o-z)
4051 include 'DIMENSIONS'
4052 include 'COMMON.LOCAL'
4053 include 'COMMON.IOUNITS'
4054 common /calcthet/ term1,term2,termm,diffak,ratak,
4055 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4056 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4057 delthec=thetai-thet_pred_mean
4058 delthe0=thetai-theta0i
4059 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4060 t3 = thetai-thet_pred_mean
4064 t14 = t12+t6*sigsqtc
4066 t21 = thetai-theta0i
4072 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4073 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4074 & *(-t12*t9-ak*sig0inv*t27)
4078 C--------------------------------------------------------------------------
4079 subroutine ebend(etheta)
4081 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4082 C angles gamma and its derivatives in consecutive thetas and gammas.
4083 C ab initio-derived potentials from
4084 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4086 implicit real*8 (a-h,o-z)
4087 include 'DIMENSIONS'
4088 include 'DIMENSIONS.ZSCOPT'
4089 include 'DIMENSIONS.FREE'
4090 include 'COMMON.LOCAL'
4091 include 'COMMON.GEO'
4092 include 'COMMON.INTERACT'
4093 include 'COMMON.DERIV'
4094 include 'COMMON.VAR'
4095 include 'COMMON.CHAIN'
4096 include 'COMMON.IOUNITS'
4097 include 'COMMON.NAMES'
4098 include 'COMMON.FFIELD'
4099 include 'COMMON.CONTROL'
4100 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4101 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4102 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4103 & sinph1ph2(maxdouble,maxdouble)
4104 logical lprn /.false./, lprn1 /.false./
4106 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4107 do i=ithet_start,ithet_end
4108 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4109 & (itype(i).eq.ntyp1)) cycle
4113 theti2=0.5d0*theta(i)
4114 ityp2=ithetyp(itype(i-1))
4116 coskt(k)=dcos(k*theti2)
4117 sinkt(k)=dsin(k*theti2)
4119 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4122 if (phii.ne.phii) phii=150.0
4126 ityp1=ithetyp(itype(i-2))
4128 cosph1(k)=dcos(k*phii)
4129 sinph1(k)=dsin(k*phii)
4133 ityp1=ithetyp(itype(i-2))
4139 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4142 if (phii1.ne.phii1) phii1=150.0
4147 ityp3=ithetyp(itype(i))
4149 cosph2(k)=dcos(k*phii1)
4150 sinph2(k)=dsin(k*phii1)
4155 ityp3=ithetyp(itype(i))
4161 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4162 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4164 ethetai=aa0thet(ityp1,ityp2,ityp3)
4167 ccl=cosph1(l)*cosph2(k-l)
4168 ssl=sinph1(l)*sinph2(k-l)
4169 scl=sinph1(l)*cosph2(k-l)
4170 csl=cosph1(l)*sinph2(k-l)
4171 cosph1ph2(l,k)=ccl-ssl
4172 cosph1ph2(k,l)=ccl+ssl
4173 sinph1ph2(l,k)=scl+csl
4174 sinph1ph2(k,l)=scl-csl
4178 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4179 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4180 write (iout,*) "coskt and sinkt"
4182 write (iout,*) k,coskt(k),sinkt(k)
4186 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4187 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4190 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4191 & " ethetai",ethetai
4194 write (iout,*) "cosph and sinph"
4196 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4198 write (iout,*) "cosph1ph2 and sinph2ph2"
4201 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4202 & sinph1ph2(l,k),sinph1ph2(k,l)
4205 write(iout,*) "ethetai",ethetai
4209 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4210 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4211 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4212 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4213 ethetai=ethetai+sinkt(m)*aux
4214 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4215 dephii=dephii+k*sinkt(m)*(
4216 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4217 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4218 dephii1=dephii1+k*sinkt(m)*(
4219 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4220 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4222 & write (iout,*) "m",m," k",k," bbthet",
4223 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4224 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4225 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4226 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4230 & write(iout,*) "ethetai",ethetai
4234 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4235 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4236 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4237 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4238 ethetai=ethetai+sinkt(m)*aux
4239 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4240 dephii=dephii+l*sinkt(m)*(
4241 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4242 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4243 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4244 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4245 dephii1=dephii1+(k-l)*sinkt(m)*(
4246 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4247 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4248 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4249 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4251 write (iout,*) "m",m," k",k," l",l," ffthet",
4252 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4253 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4254 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4255 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4256 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4257 & cosph1ph2(k,l)*sinkt(m),
4258 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4265 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4266 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4267 & phii1*rad2deg,ethetai
4269 etheta=etheta+ethetai
4271 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4272 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4273 gloc(nphi+i-2,icg)=wang*dethetai
4279 c-----------------------------------------------------------------------------
4280 subroutine esc(escloc)
4281 C Calculate the local energy of a side chain and its derivatives in the
4282 C corresponding virtual-bond valence angles THETA and the spherical angles
4284 implicit real*8 (a-h,o-z)
4285 include 'DIMENSIONS'
4286 include 'DIMENSIONS.ZSCOPT'
4287 include 'COMMON.GEO'
4288 include 'COMMON.LOCAL'
4289 include 'COMMON.VAR'
4290 include 'COMMON.INTERACT'
4291 include 'COMMON.DERIV'
4292 include 'COMMON.CHAIN'
4293 include 'COMMON.IOUNITS'
4294 include 'COMMON.NAMES'
4295 include 'COMMON.FFIELD'
4296 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4297 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4298 common /sccalc/ time11,time12,time112,theti,it,nlobit
4301 c write (iout,'(a)') 'ESC'
4302 do i=loc_start,loc_end
4304 if (it.eq.10) goto 1
4306 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4307 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4308 theti=theta(i+1)-pipol
4312 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4314 if (x(2).gt.pi-delta) then
4318 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4320 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4321 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4323 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4324 & ddersc0(1),dersc(1))
4325 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4326 & ddersc0(3),dersc(3))
4328 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4330 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4331 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4332 & dersc0(2),esclocbi,dersc02)
4333 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4335 call splinthet(x(2),0.5d0*delta,ss,ssd)
4340 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4342 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4343 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4345 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4347 c write (iout,*) escloci
4348 else if (x(2).lt.delta) then
4352 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4354 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4355 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4357 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4358 & ddersc0(1),dersc(1))
4359 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4360 & ddersc0(3),dersc(3))
4362 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4364 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4365 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4366 & dersc0(2),esclocbi,dersc02)
4367 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4372 call splinthet(x(2),0.5d0*delta,ss,ssd)
4374 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4376 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4377 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4379 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4380 c write (iout,*) escloci
4382 call enesc(x,escloci,dersc,ddummy,.false.)
4385 escloc=escloc+escloci
4386 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4388 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4390 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4391 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4396 C---------------------------------------------------------------------------
4397 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.GEO'
4401 include 'COMMON.LOCAL'
4402 include 'COMMON.IOUNITS'
4403 common /sccalc/ time11,time12,time112,theti,it,nlobit
4404 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4405 double precision contr(maxlob,-1:1)
4407 c write (iout,*) 'it=',it,' nlobit=',nlobit
4411 if (mixed) ddersc(j)=0.0d0
4415 C Because of periodicity of the dependence of the SC energy in omega we have
4416 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4417 C To avoid underflows, first compute & store the exponents.
4425 z(k)=x(k)-censc(k,j,it)
4430 Axk=Axk+gaussc(l,k,j,it)*z(l)
4436 expfac=expfac+Ax(k,j,iii)*z(k)
4444 C As in the case of ebend, we want to avoid underflows in exponentiation and
4445 C subsequent NaNs and INFs in energy calculation.
4446 C Find the largest exponent
4450 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4454 cd print *,'it=',it,' emin=',emin
4456 C Compute the contribution to SC energy and derivatives
4460 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4461 cd print *,'j=',j,' expfac=',expfac
4462 escloc_i=escloc_i+expfac
4464 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4468 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4469 & +gaussc(k,2,j,it))*expfac
4476 dersc(1)=dersc(1)/cos(theti)**2
4477 ddersc(1)=ddersc(1)/cos(theti)**2
4480 escloci=-(dlog(escloc_i)-emin)
4482 dersc(j)=dersc(j)/escloc_i
4486 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4491 C------------------------------------------------------------------------------
4492 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4493 implicit real*8 (a-h,o-z)
4494 include 'DIMENSIONS'
4495 include 'COMMON.GEO'
4496 include 'COMMON.LOCAL'
4497 include 'COMMON.IOUNITS'
4498 common /sccalc/ time11,time12,time112,theti,it,nlobit
4499 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4500 double precision contr(maxlob)
4511 z(k)=x(k)-censc(k,j,it)
4517 Axk=Axk+gaussc(l,k,j,it)*z(l)
4523 expfac=expfac+Ax(k,j)*z(k)
4528 C As in the case of ebend, we want to avoid underflows in exponentiation and
4529 C subsequent NaNs and INFs in energy calculation.
4530 C Find the largest exponent
4533 if (emin.gt.contr(j)) emin=contr(j)
4537 C Compute the contribution to SC energy and derivatives
4541 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4542 escloc_i=escloc_i+expfac
4544 dersc(k)=dersc(k)+Ax(k,j)*expfac
4546 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4547 & +gaussc(1,2,j,it))*expfac
4551 dersc(1)=dersc(1)/cos(theti)**2
4552 dersc12=dersc12/cos(theti)**2
4553 escloci=-(dlog(escloc_i)-emin)
4555 dersc(j)=dersc(j)/escloc_i
4557 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4561 c----------------------------------------------------------------------------------
4562 subroutine esc(escloc)
4563 C Calculate the local energy of a side chain and its derivatives in the
4564 C corresponding virtual-bond valence angles THETA and the spherical angles
4565 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4566 C added by Urszula Kozlowska. 07/11/2007
4568 implicit real*8 (a-h,o-z)
4569 include 'DIMENSIONS'
4570 include 'DIMENSIONS.ZSCOPT'
4571 include 'DIMENSIONS.FREE'
4572 include 'COMMON.GEO'
4573 include 'COMMON.LOCAL'
4574 include 'COMMON.VAR'
4575 include 'COMMON.SCROT'
4576 include 'COMMON.INTERACT'
4577 include 'COMMON.DERIV'
4578 include 'COMMON.CHAIN'
4579 include 'COMMON.IOUNITS'
4580 include 'COMMON.NAMES'
4581 include 'COMMON.FFIELD'
4582 include 'COMMON.CONTROL'
4583 include 'COMMON.VECTORS'
4584 double precision x_prime(3),y_prime(3),z_prime(3)
4585 & , sumene,dsc_i,dp2_i,x(65),
4586 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4587 & de_dxx,de_dyy,de_dzz,de_dt
4588 double precision s1_t,s1_6_t,s2_t,s2_6_t
4590 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4591 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4592 & dt_dCi(3),dt_dCi1(3)
4593 common /sccalc/ time11,time12,time112,theti,it,nlobit
4596 do i=loc_start,loc_end
4597 costtab(i+1) =dcos(theta(i+1))
4598 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4599 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4600 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4601 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4602 cosfac=dsqrt(cosfac2)
4603 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4604 sinfac=dsqrt(sinfac2)
4606 if (it.eq.10) goto 1
4608 C Compute the axes of tghe local cartesian coordinates system; store in
4609 c x_prime, y_prime and z_prime
4616 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4617 C & dc_norm(3,i+nres)
4619 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4620 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4623 z_prime(j) = -uz(j,i-1)
4626 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4627 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4628 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4629 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4630 c & " xy",scalar(x_prime(1),y_prime(1)),
4631 c & " xz",scalar(x_prime(1),z_prime(1)),
4632 c & " yy",scalar(y_prime(1),y_prime(1)),
4633 c & " yz",scalar(y_prime(1),z_prime(1)),
4634 c & " zz",scalar(z_prime(1),z_prime(1))
4636 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4637 C to local coordinate system. Store in xx, yy, zz.
4643 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4644 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4645 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4652 C Compute the energy of the ith side cbain
4654 c write (2,*) "xx",xx," yy",yy," zz",zz
4657 x(j) = sc_parmin(j,it)
4660 Cc diagnostics - remove later
4662 yy1 = dsin(alph(2))*dcos(omeg(2))
4663 zz1 = -dsin(alph(2))*dsin(omeg(2))
4664 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4665 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4667 C," --- ", xx_w,yy_w,zz_w
4670 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4671 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4673 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4674 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4676 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4677 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4678 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4679 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4680 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4682 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4683 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4684 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4685 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4686 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4688 dsc_i = 0.743d0+x(61)
4690 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4691 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4692 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4693 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4694 s1=(1+x(63))/(0.1d0 + dscp1)
4695 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4696 s2=(1+x(65))/(0.1d0 + dscp2)
4697 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4698 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4699 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4700 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4702 c & dscp1,dscp2,sumene
4703 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4704 escloc = escloc + sumene
4705 c write (2,*) "escloc",escloc
4706 if (.not. calc_grad) goto 1
4710 C This section to check the numerical derivatives of the energy of ith side
4711 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4712 C #define DEBUG in the code to turn it on.
4714 write (2,*) "sumene =",sumene
4718 write (2,*) xx,yy,zz
4719 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4720 de_dxx_num=(sumenep-sumene)/aincr
4722 write (2,*) "xx+ sumene from enesc=",sumenep
4725 write (2,*) xx,yy,zz
4726 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4727 de_dyy_num=(sumenep-sumene)/aincr
4729 write (2,*) "yy+ sumene from enesc=",sumenep
4732 write (2,*) xx,yy,zz
4733 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4734 de_dzz_num=(sumenep-sumene)/aincr
4736 write (2,*) "zz+ sumene from enesc=",sumenep
4737 costsave=cost2tab(i+1)
4738 sintsave=sint2tab(i+1)
4739 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4740 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4741 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4742 de_dt_num=(sumenep-sumene)/aincr
4743 write (2,*) " t+ sumene from enesc=",sumenep
4744 cost2tab(i+1)=costsave
4745 sint2tab(i+1)=sintsave
4746 C End of diagnostics section.
4749 C Compute the gradient of esc
4751 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4752 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4753 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4754 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4755 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4756 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4757 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4758 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4759 pom1=(sumene3*sint2tab(i+1)+sumene1)
4760 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4761 pom2=(sumene4*cost2tab(i+1)+sumene2)
4762 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4763 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4764 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4765 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4767 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4768 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4769 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4771 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4772 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4773 & +(pom1+pom2)*pom_dx
4775 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4778 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4779 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4780 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4782 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4783 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4784 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4785 & +x(59)*zz**2 +x(60)*xx*zz
4786 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4787 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4788 & +(pom1-pom2)*pom_dy
4790 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4793 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4794 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4795 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4796 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4797 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4798 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4799 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4800 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4802 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4805 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4806 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4807 & +pom1*pom_dt1+pom2*pom_dt2
4809 write(2,*), "de_dt = ", de_dt,de_dt_num
4813 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4814 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4815 cosfac2xx=cosfac2*xx
4816 sinfac2yy=sinfac2*yy
4818 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4820 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4822 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4823 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4824 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4825 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4826 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4827 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4828 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4829 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4830 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4831 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4835 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4836 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4839 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4840 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4841 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4843 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4844 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4848 dXX_Ctab(k,i)=dXX_Ci(k)
4849 dXX_C1tab(k,i)=dXX_Ci1(k)
4850 dYY_Ctab(k,i)=dYY_Ci(k)
4851 dYY_C1tab(k,i)=dYY_Ci1(k)
4852 dZZ_Ctab(k,i)=dZZ_Ci(k)
4853 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4854 dXX_XYZtab(k,i)=dXX_XYZ(k)
4855 dYY_XYZtab(k,i)=dYY_XYZ(k)
4856 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4860 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4861 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4862 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4863 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4864 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4866 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4867 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4868 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4869 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4870 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4871 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4872 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4873 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4875 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4876 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4878 C to check gradient call subroutine check_grad
4885 c------------------------------------------------------------------------------
4886 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4888 C This procedure calculates two-body contact function g(rij) and its derivative:
4891 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4894 C where x=(rij-r0ij)/delta
4896 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4899 double precision rij,r0ij,eps0ij,fcont,fprimcont
4900 double precision x,x2,x4,delta
4904 if (x.lt.-1.0D0) then
4907 else if (x.le.1.0D0) then
4910 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4911 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4918 c------------------------------------------------------------------------------
4919 subroutine splinthet(theti,delta,ss,ssder)
4920 implicit real*8 (a-h,o-z)
4921 include 'DIMENSIONS'
4922 include 'DIMENSIONS.ZSCOPT'
4923 include 'COMMON.VAR'
4924 include 'COMMON.GEO'
4927 if (theti.gt.pipol) then
4928 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4930 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4935 c------------------------------------------------------------------------------
4936 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4938 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4939 double precision ksi,ksi2,ksi3,a1,a2,a3
4940 a1=fprim0*delta/(f1-f0)
4946 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4947 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4950 c------------------------------------------------------------------------------
4951 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4953 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4954 double precision ksi,ksi2,ksi3,a1,a2,a3
4959 a2=3*(f1x-f0x)-2*fprim0x*delta
4960 a3=fprim0x*delta-2*(f1x-f0x)
4961 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4964 C-----------------------------------------------------------------------------
4966 C-----------------------------------------------------------------------------
4967 subroutine etor(etors,edihcnstr,fact)
4968 implicit real*8 (a-h,o-z)
4969 include 'DIMENSIONS'
4970 include 'DIMENSIONS.ZSCOPT'
4971 include 'COMMON.VAR'
4972 include 'COMMON.GEO'
4973 include 'COMMON.LOCAL'
4974 include 'COMMON.TORSION'
4975 include 'COMMON.INTERACT'
4976 include 'COMMON.DERIV'
4977 include 'COMMON.CHAIN'
4978 include 'COMMON.NAMES'
4979 include 'COMMON.IOUNITS'
4980 include 'COMMON.FFIELD'
4981 include 'COMMON.TORCNSTR'
4983 C Set lprn=.true. for debugging
4987 do i=iphi_start,iphi_end
4988 itori=itortyp(itype(i-2))
4989 itori1=itortyp(itype(i-1))
4992 C Proline-Proline pair is a special case...
4993 if (itori.eq.3 .and. itori1.eq.3) then
4994 if (phii.gt.-dwapi3) then
4996 fac=1.0D0/(1.0D0-cosphi)
4997 etorsi=v1(1,3,3)*fac
4998 etorsi=etorsi+etorsi
4999 etors=etors+etorsi-v1(1,3,3)
5000 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5003 v1ij=v1(j+1,itori,itori1)
5004 v2ij=v2(j+1,itori,itori1)
5007 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5008 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5012 v1ij=v1(j,itori,itori1)
5013 v2ij=v2(j,itori,itori1)
5016 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5017 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5021 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5022 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5023 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5024 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5025 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5027 ! 6/20/98 - dihedral angle constraints
5030 itori=idih_constr(i)
5033 if (difi.gt.drange(i)) then
5035 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5036 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5037 else if (difi.lt.-drange(i)) then
5039 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5040 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5042 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5043 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5045 ! write (iout,*) 'edihcnstr',edihcnstr
5048 c------------------------------------------------------------------------------
5050 subroutine etor(etors,edihcnstr,fact)
5051 implicit real*8 (a-h,o-z)
5052 include 'DIMENSIONS'
5053 include 'DIMENSIONS.ZSCOPT'
5054 include 'COMMON.VAR'
5055 include 'COMMON.GEO'
5056 include 'COMMON.LOCAL'
5057 include 'COMMON.TORSION'
5058 include 'COMMON.INTERACT'
5059 include 'COMMON.DERIV'
5060 include 'COMMON.CHAIN'
5061 include 'COMMON.NAMES'
5062 include 'COMMON.IOUNITS'
5063 include 'COMMON.FFIELD'
5064 include 'COMMON.TORCNSTR'
5066 C Set lprn=.true. for debugging
5070 do i=iphi_start,iphi_end
5071 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5072 itori=itortyp(itype(i-2))
5073 itori1=itortyp(itype(i-1))
5076 C Regular cosine and sine terms
5077 do j=1,nterm(itori,itori1)
5078 v1ij=v1(j,itori,itori1)
5079 v2ij=v2(j,itori,itori1)
5082 etors=etors+v1ij*cosphi+v2ij*sinphi
5083 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5087 C E = SUM ----------------------------------- - v1
5088 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5090 cosphi=dcos(0.5d0*phii)
5091 sinphi=dsin(0.5d0*phii)
5092 do j=1,nlor(itori,itori1)
5093 vl1ij=vlor1(j,itori,itori1)
5094 vl2ij=vlor2(j,itori,itori1)
5095 vl3ij=vlor3(j,itori,itori1)
5096 pom=vl2ij*cosphi+vl3ij*sinphi
5097 pom1=1.0d0/(pom*pom+1.0d0)
5098 etors=etors+vl1ij*pom1
5100 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5102 C Subtract the constant term
5103 etors=etors-v0(itori,itori1)
5105 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5106 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5107 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5108 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5109 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5112 ! 6/20/98 - dihedral angle constraints
5115 itori=idih_constr(i)
5117 difi=pinorm(phii-phi0(i))
5119 if (difi.gt.drange(i)) then
5121 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5122 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5123 edihi=0.25d0*ftors*difi**4
5124 else if (difi.lt.-drange(i)) then
5126 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5127 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5128 edihi=0.25d0*ftors*difi**4
5132 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5134 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5135 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5137 ! write (iout,*) 'edihcnstr',edihcnstr
5140 c----------------------------------------------------------------------------
5141 subroutine etor_d(etors_d,fact2)
5142 C 6/23/01 Compute double torsional energy
5143 implicit real*8 (a-h,o-z)
5144 include 'DIMENSIONS'
5145 include 'DIMENSIONS.ZSCOPT'
5146 include 'COMMON.VAR'
5147 include 'COMMON.GEO'
5148 include 'COMMON.LOCAL'
5149 include 'COMMON.TORSION'
5150 include 'COMMON.INTERACT'
5151 include 'COMMON.DERIV'
5152 include 'COMMON.CHAIN'
5153 include 'COMMON.NAMES'
5154 include 'COMMON.IOUNITS'
5155 include 'COMMON.FFIELD'
5156 include 'COMMON.TORCNSTR'
5158 C Set lprn=.true. for debugging
5162 do i=iphi_start,iphi_end-1
5163 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5165 itori=itortyp(itype(i-2))
5166 itori1=itortyp(itype(i-1))
5167 itori2=itortyp(itype(i))
5172 C Regular cosine and sine terms
5173 do j=1,ntermd_1(itori,itori1,itori2)
5174 v1cij=v1c(1,j,itori,itori1,itori2)
5175 v1sij=v1s(1,j,itori,itori1,itori2)
5176 v2cij=v1c(2,j,itori,itori1,itori2)
5177 v2sij=v1s(2,j,itori,itori1,itori2)
5178 cosphi1=dcos(j*phii)
5179 sinphi1=dsin(j*phii)
5180 cosphi2=dcos(j*phii1)
5181 sinphi2=dsin(j*phii1)
5182 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5183 & v2cij*cosphi2+v2sij*sinphi2
5184 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5185 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5187 do k=2,ntermd_2(itori,itori1,itori2)
5189 v1cdij = v2c(k,l,itori,itori1,itori2)
5190 v2cdij = v2c(l,k,itori,itori1,itori2)
5191 v1sdij = v2s(k,l,itori,itori1,itori2)
5192 v2sdij = v2s(l,k,itori,itori1,itori2)
5193 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5194 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5195 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5196 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5197 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5198 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5199 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5200 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5201 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5202 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5205 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5206 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5212 c------------------------------------------------------------------------------
5213 subroutine eback_sc_corr(esccor)
5214 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5215 c conformational states; temporarily implemented as differences
5216 c between UNRES torsional potentials (dependent on three types of
5217 c residues) and the torsional potentials dependent on all 20 types
5218 c of residues computed from AM1 energy surfaces of terminally-blocked
5219 c amino-acid residues.
5220 implicit real*8 (a-h,o-z)
5221 include 'DIMENSIONS'
5222 include 'DIMENSIONS.ZSCOPT'
5223 include 'DIMENSIONS.FREE'
5224 include 'COMMON.VAR'
5225 include 'COMMON.GEO'
5226 include 'COMMON.LOCAL'
5227 include 'COMMON.TORSION'
5228 include 'COMMON.SCCOR'
5229 include 'COMMON.INTERACT'
5230 include 'COMMON.DERIV'
5231 include 'COMMON.CHAIN'
5232 include 'COMMON.NAMES'
5233 include 'COMMON.IOUNITS'
5234 include 'COMMON.FFIELD'
5235 include 'COMMON.CONTROL'
5237 C Set lprn=.true. for debugging
5240 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5242 do i=itau_start,itau_end
5244 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5245 isccori=isccortyp(itype(i-2))
5246 isccori1=isccortyp(itype(i-1))
5248 cccc Added 9 May 2012
5249 cc Tauangle is torsional engle depending on the value of first digit
5250 c(see comment below)
5251 cc Omicron is flat angle depending on the value of first digit
5252 c(see comment below)
5255 do intertyp=1,3 !intertyp
5256 cc Added 09 May 2012 (Adasko)
5257 cc Intertyp means interaction type of backbone mainchain correlation:
5258 c 1 = SC...Ca...Ca...Ca
5259 c 2 = Ca...Ca...Ca...SC
5260 c 3 = SC...Ca...Ca...SCi
5262 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5263 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5264 & (itype(i-1).eq.21)))
5265 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5266 & .or.(itype(i-2).eq.21)))
5267 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5268 & (itype(i-1).eq.21)))) cycle
5269 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5270 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5272 do j=1,nterm_sccor(isccori,isccori1)
5273 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5274 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5275 cosphi=dcos(j*tauangle(intertyp,i))
5276 sinphi=dsin(j*tauangle(intertyp,i))
5277 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5279 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5281 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5283 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5284 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5285 c &gloc_sc(intertyp,i-3,icg)
5287 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5288 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5289 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5290 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5291 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5294 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5298 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5302 c------------------------------------------------------------------------------
5303 subroutine multibody(ecorr)
5304 C This subroutine calculates multi-body contributions to energy following
5305 C the idea of Skolnick et al. If side chains I and J make a contact and
5306 C at the same time side chains I+1 and J+1 make a contact, an extra
5307 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5308 implicit real*8 (a-h,o-z)
5309 include 'DIMENSIONS'
5310 include 'COMMON.IOUNITS'
5311 include 'COMMON.DERIV'
5312 include 'COMMON.INTERACT'
5313 include 'COMMON.CONTACTS'
5314 double precision gx(3),gx1(3)
5317 C Set lprn=.true. for debugging
5321 write (iout,'(a)') 'Contact function values:'
5323 write (iout,'(i2,20(1x,i2,f10.5))')
5324 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5339 num_conti=num_cont(i)
5340 num_conti1=num_cont(i1)
5345 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5346 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5347 cd & ' ishift=',ishift
5348 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5349 C The system gains extra energy.
5350 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5351 endif ! j1==j+-ishift
5360 c------------------------------------------------------------------------------
5361 double precision function esccorr(i,j,k,l,jj,kk)
5362 implicit real*8 (a-h,o-z)
5363 include 'DIMENSIONS'
5364 include 'COMMON.IOUNITS'
5365 include 'COMMON.DERIV'
5366 include 'COMMON.INTERACT'
5367 include 'COMMON.CONTACTS'
5368 double precision gx(3),gx1(3)
5373 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5374 C Calculate the multi-body contribution to energy.
5375 C Calculate multi-body contributions to the gradient.
5376 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5377 cd & k,l,(gacont(m,kk,k),m=1,3)
5379 gx(m) =ekl*gacont(m,jj,i)
5380 gx1(m)=eij*gacont(m,kk,k)
5381 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5382 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5383 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5384 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5388 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5393 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5399 c------------------------------------------------------------------------------
5401 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5402 implicit real*8 (a-h,o-z)
5403 include 'DIMENSIONS'
5404 integer dimen1,dimen2,atom,indx
5405 double precision buffer(dimen1,dimen2)
5406 double precision zapas
5407 common /contacts_hb/ zapas(3,20,maxres,7),
5408 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5409 & num_cont_hb(maxres),jcont_hb(20,maxres)
5410 num_kont=num_cont_hb(atom)
5414 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5417 buffer(i,indx+22)=facont_hb(i,atom)
5418 buffer(i,indx+23)=ees0p(i,atom)
5419 buffer(i,indx+24)=ees0m(i,atom)
5420 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5422 buffer(1,indx+26)=dfloat(num_kont)
5425 c------------------------------------------------------------------------------
5426 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5427 implicit real*8 (a-h,o-z)
5428 include 'DIMENSIONS'
5429 integer dimen1,dimen2,atom,indx
5430 double precision buffer(dimen1,dimen2)
5431 double precision zapas
5432 common /contacts_hb/ zapas(3,20,maxres,7),
5433 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5434 & num_cont_hb(maxres),jcont_hb(20,maxres)
5435 num_kont=buffer(1,indx+26)
5436 num_kont_old=num_cont_hb(atom)
5437 num_cont_hb(atom)=num_kont+num_kont_old
5442 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5445 facont_hb(ii,atom)=buffer(i,indx+22)
5446 ees0p(ii,atom)=buffer(i,indx+23)
5447 ees0m(ii,atom)=buffer(i,indx+24)
5448 jcont_hb(ii,atom)=buffer(i,indx+25)
5452 c------------------------------------------------------------------------------
5454 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5455 C This subroutine calculates multi-body contributions to hydrogen-bonding
5456 implicit real*8 (a-h,o-z)
5457 include 'DIMENSIONS'
5458 include 'DIMENSIONS.ZSCOPT'
5459 include 'COMMON.IOUNITS'
5461 include 'COMMON.INFO'
5463 include 'COMMON.FFIELD'
5464 include 'COMMON.DERIV'
5465 include 'COMMON.INTERACT'
5466 include 'COMMON.CONTACTS'
5468 parameter (max_cont=maxconts)
5469 parameter (max_dim=2*(8*3+2))
5470 parameter (msglen1=max_cont*max_dim*4)
5471 parameter (msglen2=2*msglen1)
5472 integer source,CorrelType,CorrelID,Error
5473 double precision buffer(max_cont,max_dim)
5475 double precision gx(3),gx1(3)
5478 C Set lprn=.true. for debugging
5483 if (fgProcs.le.1) goto 30
5485 write (iout,'(a)') 'Contact function values:'
5487 write (iout,'(2i3,50(1x,i2,f5.2))')
5488 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5489 & j=1,num_cont_hb(i))
5492 C Caution! Following code assumes that electrostatic interactions concerning
5493 C a given atom are split among at most two processors!
5503 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5506 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5507 if (MyRank.gt.0) then
5508 C Send correlation contributions to the preceding processor
5510 nn=num_cont_hb(iatel_s)
5511 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5512 cd write (iout,*) 'The BUFFER array:'
5514 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5516 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5518 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5519 C Clear the contacts of the atom passed to the neighboring processor
5520 nn=num_cont_hb(iatel_s+1)
5522 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5524 num_cont_hb(iatel_s)=0
5526 cd write (iout,*) 'Processor ',MyID,MyRank,
5527 cd & ' is sending correlation contribution to processor',MyID-1,
5528 cd & ' msglen=',msglen
5529 cd write (*,*) 'Processor ',MyID,MyRank,
5530 cd & ' is sending correlation contribution to processor',MyID-1,
5531 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5532 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5533 cd write (iout,*) 'Processor ',MyID,
5534 cd & ' has sent correlation contribution to processor',MyID-1,
5535 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5536 cd write (*,*) 'Processor ',MyID,
5537 cd & ' has sent correlation contribution to processor',MyID-1,
5538 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5540 endif ! (MyRank.gt.0)
5544 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5545 if (MyRank.lt.fgProcs-1) then
5546 C Receive correlation contributions from the next processor
5548 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5549 cd write (iout,*) 'Processor',MyID,
5550 cd & ' is receiving correlation contribution from processor',MyID+1,
5551 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5552 cd write (*,*) 'Processor',MyID,
5553 cd & ' is receiving correlation contribution from processor',MyID+1,
5554 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5556 do while (nbytes.le.0)
5557 call mp_probe(MyID+1,CorrelType,nbytes)
5559 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5560 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5561 cd write (iout,*) 'Processor',MyID,
5562 cd & ' has received correlation contribution from processor',MyID+1,
5563 cd & ' msglen=',msglen,' nbytes=',nbytes
5564 cd write (iout,*) 'The received BUFFER array:'
5566 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5568 if (msglen.eq.msglen1) then
5569 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5570 else if (msglen.eq.msglen2) then
5571 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5572 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5575 & 'ERROR!!!! message length changed while processing correlations.'
5577 & 'ERROR!!!! message length changed while processing correlations.'
5578 call mp_stopall(Error)
5579 endif ! msglen.eq.msglen1
5580 endif ! MyRank.lt.fgProcs-1
5587 write (iout,'(a)') 'Contact function values:'
5589 write (iout,'(2i3,50(1x,i2,f5.2))')
5590 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5591 & j=1,num_cont_hb(i))
5595 C Remove the loop below after debugging !!!
5602 C Calculate the local-electrostatic correlation terms
5603 do i=iatel_s,iatel_e+1
5605 num_conti=num_cont_hb(i)
5606 num_conti1=num_cont_hb(i+1)
5611 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5612 c & ' jj=',jj,' kk=',kk
5613 if (j1.eq.j+1 .or. j1.eq.j-1) then
5614 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5615 C The system gains extra energy.
5616 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5618 write (iout,*) "ecorr",i,j,i+1,j1,
5619 & ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5622 else if (j1.eq.j) then
5623 C Contacts I-J and I-(J+1) occur simultaneously.
5624 C The system loses extra energy.
5625 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5630 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5631 c & ' jj=',jj,' kk=',kk
5633 C Contacts I-J and (I+1)-J occur simultaneously.
5634 C The system loses extra energy.
5635 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5642 c------------------------------------------------------------------------------
5643 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5645 C This subroutine calculates multi-body contributions to hydrogen-bonding
5646 implicit real*8 (a-h,o-z)
5647 include 'DIMENSIONS'
5648 include 'DIMENSIONS.ZSCOPT'
5649 include 'COMMON.IOUNITS'
5651 include 'COMMON.INFO'
5653 include 'COMMON.FFIELD'
5654 include 'COMMON.DERIV'
5655 include 'COMMON.INTERACT'
5656 include 'COMMON.CONTACTS'
5658 parameter (max_cont=maxconts)
5659 parameter (max_dim=2*(8*3+2))
5660 parameter (msglen1=max_cont*max_dim*4)
5661 parameter (msglen2=2*msglen1)
5662 integer source,CorrelType,CorrelID,Error
5663 double precision buffer(max_cont,max_dim)
5665 double precision gx(3),gx1(3)
5668 C Set lprn=.true. for debugging
5674 if (fgProcs.le.1) goto 30
5676 write (iout,'(a)') 'Contact function values:'
5678 write (iout,'(2i3,50(1x,i2,f5.2))')
5679 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5680 & j=1,num_cont_hb(i))
5683 C Caution! Following code assumes that electrostatic interactions concerning
5684 C a given atom are split among at most two processors!
5694 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5697 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5698 if (MyRank.gt.0) then
5699 C Send correlation contributions to the preceding processor
5701 nn=num_cont_hb(iatel_s)
5702 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5703 cd write (iout,*) 'The BUFFER array:'
5705 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5707 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5709 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5710 C Clear the contacts of the atom passed to the neighboring processor
5711 nn=num_cont_hb(iatel_s+1)
5713 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5715 num_cont_hb(iatel_s)=0
5717 cd write (iout,*) 'Processor ',MyID,MyRank,
5718 cd & ' is sending correlation contribution to processor',MyID-1,
5719 cd & ' msglen=',msglen
5720 cd write (*,*) 'Processor ',MyID,MyRank,
5721 cd & ' is sending correlation contribution to processor',MyID-1,
5722 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5723 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5724 cd write (iout,*) 'Processor ',MyID,
5725 cd & ' has sent correlation contribution to processor',MyID-1,
5726 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5727 cd write (*,*) 'Processor ',MyID,
5728 cd & ' has sent correlation contribution to processor',MyID-1,
5729 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5731 endif ! (MyRank.gt.0)
5735 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5736 if (MyRank.lt.fgProcs-1) then
5737 C Receive correlation contributions from the next processor
5739 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5740 cd write (iout,*) 'Processor',MyID,
5741 cd & ' is receiving correlation contribution from processor',MyID+1,
5742 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5743 cd write (*,*) 'Processor',MyID,
5744 cd & ' is receiving correlation contribution from processor',MyID+1,
5745 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5747 do while (nbytes.le.0)
5748 call mp_probe(MyID+1,CorrelType,nbytes)
5750 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5751 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5752 cd write (iout,*) 'Processor',MyID,
5753 cd & ' has received correlation contribution from processor',MyID+1,
5754 cd & ' msglen=',msglen,' nbytes=',nbytes
5755 cd write (iout,*) 'The received BUFFER array:'
5757 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5759 if (msglen.eq.msglen1) then
5760 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5761 else if (msglen.eq.msglen2) then
5762 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5763 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5766 & 'ERROR!!!! message length changed while processing correlations.'
5768 & 'ERROR!!!! message length changed while processing correlations.'
5769 call mp_stopall(Error)
5770 endif ! msglen.eq.msglen1
5771 endif ! MyRank.lt.fgProcs-1
5778 write (iout,'(a)') 'Contact function values:'
5780 write (iout,'(2i3,50(1x,i2,f5.2))')
5781 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5782 & j=1,num_cont_hb(i))
5788 C Remove the loop below after debugging !!!
5795 C Calculate the dipole-dipole interaction energies
5796 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5797 do i=iatel_s,iatel_e+1
5798 num_conti=num_cont_hb(i)
5805 C Calculate the local-electrostatic correlation terms
5806 do i=iatel_s,iatel_e+1
5808 num_conti=num_cont_hb(i)
5809 num_conti1=num_cont_hb(i+1)
5814 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5815 c & ' jj=',jj,' kk=',kk
5816 if (j1.eq.j+1 .or. j1.eq.j-1) then
5817 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5818 C The system gains extra energy.
5820 sqd1=dsqrt(d_cont(jj,i))
5821 sqd2=dsqrt(d_cont(kk,i1))
5822 sred_geom = sqd1*sqd2
5823 IF (sred_geom.lt.cutoff_corr) THEN
5824 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5826 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5827 c & ' jj=',jj,' kk=',kk
5828 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5829 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5831 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5832 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5835 cd write (iout,*) 'sred_geom=',sred_geom,
5836 cd & ' ekont=',ekont,' fprim=',fprimcont
5837 call calc_eello(i,j,i+1,j1,jj,kk)
5838 if (wcorr4.gt.0.0d0)
5839 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5840 if (wcorr5.gt.0.0d0)
5841 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5842 c print *,"wcorr5",ecorr5
5843 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5844 cd write(2,*)'ijkl',i,j,i+1,j1
5845 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5846 & .or. wturn6.eq.0.0d0))then
5847 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5848 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5849 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5850 cd & 'ecorr6=',ecorr6
5851 cd write (iout,'(4e15.5)') sred_geom,
5852 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5853 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5854 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5855 else if (wturn6.gt.0.0d0
5856 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5857 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5858 eturn6=eturn6+eello_turn6(i,jj,kk)
5859 cd write (2,*) 'multibody_eello:eturn6',eturn6
5863 else if (j1.eq.j) then
5864 C Contacts I-J and I-(J+1) occur simultaneously.
5865 C The system loses extra energy.
5866 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5871 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5872 c & ' jj=',jj,' kk=',kk
5874 C Contacts I-J and (I+1)-J occur simultaneously.
5875 C The system loses extra energy.
5876 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5883 c------------------------------------------------------------------------------
5884 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5885 implicit real*8 (a-h,o-z)
5886 include 'DIMENSIONS'
5887 include 'COMMON.IOUNITS'
5888 include 'COMMON.DERIV'
5889 include 'COMMON.INTERACT'
5890 include 'COMMON.CONTACTS'
5891 double precision gx(3),gx1(3)
5901 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5902 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5903 C Following 4 lines for diagnostics.
5908 cd write (iout,*)'Contacts have occurred for peptide groups',i,j,
5910 cd write (iout,*)'Contacts have occurred for peptide groups',
5911 cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5912 cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5913 C Calculate the multi-body contribution to energy.
5914 ecorr=ecorr+ekont*ees
5916 C Calculate multi-body contributions to the gradient.
5918 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5919 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5920 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5921 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5922 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5923 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5924 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5925 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5926 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5927 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5928 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5929 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5930 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5931 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5935 gradcorr(ll,m)=gradcorr(ll,m)+
5936 & ees*ekl*gacont_hbr(ll,jj,i)-
5937 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5938 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5943 gradcorr(ll,m)=gradcorr(ll,m)+
5944 & ees*eij*gacont_hbr(ll,kk,k)-
5945 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5946 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5953 C---------------------------------------------------------------------------
5954 subroutine dipole(i,j,jj)
5955 implicit real*8 (a-h,o-z)
5956 include 'DIMENSIONS'
5957 include 'DIMENSIONS.ZSCOPT'
5958 include 'COMMON.IOUNITS'
5959 include 'COMMON.CHAIN'
5960 include 'COMMON.FFIELD'
5961 include 'COMMON.DERIV'
5962 include 'COMMON.INTERACT'
5963 include 'COMMON.CONTACTS'
5964 include 'COMMON.TORSION'
5965 include 'COMMON.VAR'
5966 include 'COMMON.GEO'
5967 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5969 iti1 = itortyp(itype(i+1))
5970 if (j.lt.nres-1) then
5971 itj1 = itortyp(itype(j+1))
5976 dipi(iii,1)=Ub2(iii,i)
5977 dipderi(iii)=Ub2der(iii,i)
5978 dipi(iii,2)=b1(iii,iti1)
5979 dipj(iii,1)=Ub2(iii,j)
5980 dipderj(iii)=Ub2der(iii,j)
5981 dipj(iii,2)=b1(iii,itj1)
5985 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5988 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5991 if (.not.calc_grad) return
5996 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6000 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6005 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6006 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6008 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6010 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6012 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6016 C---------------------------------------------------------------------------
6017 subroutine calc_eello(i,j,k,l,jj,kk)
6019 C This subroutine computes matrices and vectors needed to calculate
6020 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6022 implicit real*8 (a-h,o-z)
6023 include 'DIMENSIONS'
6024 include 'DIMENSIONS.ZSCOPT'
6025 include 'COMMON.IOUNITS'
6026 include 'COMMON.CHAIN'
6027 include 'COMMON.DERIV'
6028 include 'COMMON.INTERACT'
6029 include 'COMMON.CONTACTS'
6030 include 'COMMON.TORSION'
6031 include 'COMMON.VAR'
6032 include 'COMMON.GEO'
6033 include 'COMMON.FFIELD'
6034 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6035 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6038 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6039 cd & ' jj=',jj,' kk=',kk
6040 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6043 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6044 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6047 call transpose2(aa1(1,1),aa1t(1,1))
6048 call transpose2(aa2(1,1),aa2t(1,1))
6051 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6052 & aa1tder(1,1,lll,kkk))
6053 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6054 & aa2tder(1,1,lll,kkk))
6058 C parallel orientation of the two CA-CA-CA frames.
6060 iti=itortyp(itype(i))
6064 itk1=itortyp(itype(k+1))
6065 itj=itortyp(itype(j))
6066 if (l.lt.nres-1) then
6067 itl1=itortyp(itype(l+1))
6071 C A1 kernel(j+1) A2T
6073 cd write (iout,'(3f10.5,5x,3f10.5)')
6074 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6076 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6077 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6078 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6079 C Following matrices are needed only for 6-th order cumulants
6080 IF (wcorr6.gt.0.0d0) THEN
6081 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6082 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6083 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6084 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6085 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6086 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6087 & ADtEAderx(1,1,1,1,1,1))
6089 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6090 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6091 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6092 & ADtEA1derx(1,1,1,1,1,1))
6094 C End 6-th order cumulants
6097 cd write (2,*) 'In calc_eello6'
6099 cd write (2,*) 'iii=',iii
6101 cd write (2,*) 'kkk=',kkk
6103 cd write (2,'(3(2f10.5),5x)')
6104 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6109 call transpose2(EUgder(1,1,k),auxmat(1,1))
6110 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6111 call transpose2(EUg(1,1,k),auxmat(1,1))
6112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6113 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6117 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6118 & EAEAderx(1,1,lll,kkk,iii,1))
6122 C A1T kernel(i+1) A2
6123 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6124 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6125 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6126 C Following matrices are needed only for 6-th order cumulants
6127 IF (wcorr6.gt.0.0d0) THEN
6128 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6129 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6130 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6131 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6132 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6133 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6134 & ADtEAderx(1,1,1,1,1,2))
6135 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6136 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6137 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6138 & ADtEA1derx(1,1,1,1,1,2))
6140 C End 6-th order cumulants
6141 call transpose2(EUgder(1,1,l),auxmat(1,1))
6142 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6143 call transpose2(EUg(1,1,l),auxmat(1,1))
6144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6145 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6150 & EAEAderx(1,1,lll,kkk,iii,2))
6155 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6156 C They are needed only when the fifth- or the sixth-order cumulants are
6158 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6159 call transpose2(AEA(1,1,1),auxmat(1,1))
6160 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6161 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6162 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6163 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6164 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6165 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6166 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6167 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6168 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6169 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6170 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6171 call transpose2(AEA(1,1,2),auxmat(1,1))
6172 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6173 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6174 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6175 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6176 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6177 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6178 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6179 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6180 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6181 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6182 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6183 C Calculate the Cartesian derivatives of the vectors.
6187 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6188 call matvec2(auxmat(1,1),b1(1,iti),
6189 & AEAb1derx(1,lll,kkk,iii,1,1))
6190 call matvec2(auxmat(1,1),Ub2(1,i),
6191 & AEAb2derx(1,lll,kkk,iii,1,1))
6192 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6193 & AEAb1derx(1,lll,kkk,iii,2,1))
6194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6195 & AEAb2derx(1,lll,kkk,iii,2,1))
6196 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6197 call matvec2(auxmat(1,1),b1(1,itj),
6198 & AEAb1derx(1,lll,kkk,iii,1,2))
6199 call matvec2(auxmat(1,1),Ub2(1,j),
6200 & AEAb2derx(1,lll,kkk,iii,1,2))
6201 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6202 & AEAb1derx(1,lll,kkk,iii,2,2))
6203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6204 & AEAb2derx(1,lll,kkk,iii,2,2))
6211 C Antiparallel orientation of the two CA-CA-CA frames.
6213 iti=itortyp(itype(i))
6217 itk1=itortyp(itype(k+1))
6218 itl=itortyp(itype(l))
6219 itj=itortyp(itype(j))
6220 if (j.lt.nres-1) then
6221 itj1=itortyp(itype(j+1))
6225 C A2 kernel(j-1)T A1T
6226 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6227 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6228 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6229 C Following matrices are needed only for 6-th order cumulants
6230 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6231 & j.eq.i+4 .and. l.eq.i+3)) THEN
6232 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6233 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6234 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6235 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6236 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6237 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6238 & ADtEAderx(1,1,1,1,1,1))
6239 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6240 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6241 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6242 & ADtEA1derx(1,1,1,1,1,1))
6244 C End 6-th order cumulants
6245 call transpose2(EUgder(1,1,k),auxmat(1,1))
6246 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6247 call transpose2(EUg(1,1,k),auxmat(1,1))
6248 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6249 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6253 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6254 & EAEAderx(1,1,lll,kkk,iii,1))
6258 C A2T kernel(i+1)T A1
6259 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6260 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6261 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6262 C Following matrices are needed only for 6-th order cumulants
6263 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6264 & j.eq.i+4 .and. l.eq.i+3)) THEN
6265 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6266 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6267 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6268 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6269 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6270 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6271 & ADtEAderx(1,1,1,1,1,2))
6272 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6273 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6274 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6275 & ADtEA1derx(1,1,1,1,1,2))
6277 C End 6-th order cumulants
6278 call transpose2(EUgder(1,1,j),auxmat(1,1))
6279 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6280 call transpose2(EUg(1,1,j),auxmat(1,1))
6281 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6282 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6286 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6287 & EAEAderx(1,1,lll,kkk,iii,2))
6292 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6293 C They are needed only when the fifth- or the sixth-order cumulants are
6295 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6296 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6297 call transpose2(AEA(1,1,1),auxmat(1,1))
6298 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6299 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6300 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6301 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6302 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6303 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6304 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6305 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6306 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6307 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6308 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6309 call transpose2(AEA(1,1,2),auxmat(1,1))
6310 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6311 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6312 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6313 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6314 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6315 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6316 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6317 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6318 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6319 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6320 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6321 C Calculate the Cartesian derivatives of the vectors.
6325 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6326 call matvec2(auxmat(1,1),b1(1,iti),
6327 & AEAb1derx(1,lll,kkk,iii,1,1))
6328 call matvec2(auxmat(1,1),Ub2(1,i),
6329 & AEAb2derx(1,lll,kkk,iii,1,1))
6330 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6331 & AEAb1derx(1,lll,kkk,iii,2,1))
6332 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6333 & AEAb2derx(1,lll,kkk,iii,2,1))
6334 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6335 call matvec2(auxmat(1,1),b1(1,itl),
6336 & AEAb1derx(1,lll,kkk,iii,1,2))
6337 call matvec2(auxmat(1,1),Ub2(1,l),
6338 & AEAb2derx(1,lll,kkk,iii,1,2))
6339 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6340 & AEAb1derx(1,lll,kkk,iii,2,2))
6341 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6342 & AEAb2derx(1,lll,kkk,iii,2,2))
6351 C---------------------------------------------------------------------------
6352 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6353 & KK,KKderg,AKA,AKAderg,AKAderx)
6357 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6358 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6359 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6364 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6366 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6369 cd if (lprn) write (2,*) 'In kernel'
6371 cd if (lprn) write (2,*) 'kkk=',kkk
6373 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6374 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6376 cd write (2,*) 'lll=',lll
6377 cd write (2,*) 'iii=1'
6379 cd write (2,'(3(2f10.5),5x)')
6380 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6383 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6384 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6386 cd write (2,*) 'lll=',lll
6387 cd write (2,*) 'iii=2'
6389 cd write (2,'(3(2f10.5),5x)')
6390 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6397 C---------------------------------------------------------------------------
6398 double precision function eello4(i,j,k,l,jj,kk)
6399 implicit real*8 (a-h,o-z)
6400 include 'DIMENSIONS'
6401 include 'DIMENSIONS.ZSCOPT'
6402 include 'COMMON.IOUNITS'
6403 include 'COMMON.CHAIN'
6404 include 'COMMON.DERIV'
6405 include 'COMMON.INTERACT'
6406 include 'COMMON.CONTACTS'
6407 include 'COMMON.TORSION'
6408 include 'COMMON.VAR'
6409 include 'COMMON.GEO'
6410 double precision pizda(2,2),ggg1(3),ggg2(3)
6411 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6415 cd print *,'eello4:',i,j,k,l,jj,kk
6416 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6417 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6418 cold eij=facont_hb(jj,i)
6419 cold ekl=facont_hb(kk,k)
6421 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6423 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6424 gcorr_loc(k-1)=gcorr_loc(k-1)
6425 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6427 gcorr_loc(l-1)=gcorr_loc(l-1)
6428 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6430 gcorr_loc(j-1)=gcorr_loc(j-1)
6431 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6436 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6437 & -EAEAderx(2,2,lll,kkk,iii,1)
6438 cd derx(lll,kkk,iii)=0.0d0
6442 cd gcorr_loc(l-1)=0.0d0
6443 cd gcorr_loc(j-1)=0.0d0
6444 cd gcorr_loc(k-1)=0.0d0
6446 cd write (iout,*)'Contacts have occurred for peptide groups',
6447 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6448 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6449 if (j.lt.nres-1) then
6456 if (l.lt.nres-1) then
6464 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6465 ggg1(ll)=eel4*g_contij(ll,1)
6466 ggg2(ll)=eel4*g_contij(ll,2)
6467 ghalf=0.5d0*ggg1(ll)
6469 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6470 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6471 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6472 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6473 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6474 ghalf=0.5d0*ggg2(ll)
6476 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6477 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6478 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6479 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6484 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6485 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6490 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6491 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6497 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6502 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6506 cd write (2,*) iii,gcorr_loc(iii)
6510 cd write (2,*) 'ekont',ekont
6511 cd write (iout,*) 'eello4',ekont*eel4
6514 C---------------------------------------------------------------------------
6515 double precision function eello5(i,j,k,l,jj,kk)
6516 implicit real*8 (a-h,o-z)
6517 include 'DIMENSIONS'
6518 include 'DIMENSIONS.ZSCOPT'
6519 include 'COMMON.IOUNITS'
6520 include 'COMMON.CHAIN'
6521 include 'COMMON.DERIV'
6522 include 'COMMON.INTERACT'
6523 include 'COMMON.CONTACTS'
6524 include 'COMMON.TORSION'
6525 include 'COMMON.VAR'
6526 include 'COMMON.GEO'
6527 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6528 double precision ggg1(3),ggg2(3)
6529 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6534 C /l\ / \ \ / \ / \ / C
6535 C / \ / \ \ / \ / \ / C
6536 C j| o |l1 | o | o| o | | o |o C
6537 C \ |/k\| |/ \| / |/ \| |/ \| C
6538 C \i/ \ / \ / / \ / \ C
6540 C (I) (II) (III) (IV) C
6542 C eello5_1 eello5_2 eello5_3 eello5_4 C
6544 C Antiparallel chains C
6547 C /j\ / \ \ / \ / \ / C
6548 C / \ / \ \ / \ / \ / C
6549 C j1| o |l | o | o| o | | o |o C
6550 C \ |/k\| |/ \| / |/ \| |/ \| C
6551 C \i/ \ / \ / / \ / \ C
6553 C (I) (II) (III) (IV) C
6555 C eello5_1 eello5_2 eello5_3 eello5_4 C
6557 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6559 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6560 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6565 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6567 itk=itortyp(itype(k))
6568 itl=itortyp(itype(l))
6569 itj=itortyp(itype(j))
6574 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6575 cd & eel5_3_num,eel5_4_num)
6579 derx(lll,kkk,iii)=0.0d0
6583 cd eij=facont_hb(jj,i)
6584 cd ekl=facont_hb(kk,k)
6586 cd write (iout,*)'Contacts have occurred for peptide groups',
6587 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6589 C Contribution from the graph I.
6590 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6591 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6592 call transpose2(EUg(1,1,k),auxmat(1,1))
6593 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6594 vv(1)=pizda(1,1)-pizda(2,2)
6595 vv(2)=pizda(1,2)+pizda(2,1)
6596 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6597 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6599 C Explicit gradient in virtual-dihedral angles.
6600 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6601 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6602 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6603 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6604 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6605 vv(1)=pizda(1,1)-pizda(2,2)
6606 vv(2)=pizda(1,2)+pizda(2,1)
6607 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6608 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6609 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6610 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6611 vv(1)=pizda(1,1)-pizda(2,2)
6612 vv(2)=pizda(1,2)+pizda(2,1)
6614 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6615 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6616 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6618 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6619 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6620 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6622 C Cartesian gradient
6626 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6628 vv(1)=pizda(1,1)-pizda(2,2)
6629 vv(2)=pizda(1,2)+pizda(2,1)
6630 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6631 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6632 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6639 C Contribution from graph II
6640 call transpose2(EE(1,1,itk),auxmat(1,1))
6641 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6642 vv(1)=pizda(1,1)+pizda(2,2)
6643 vv(2)=pizda(2,1)-pizda(1,2)
6644 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6645 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6647 C Explicit gradient in virtual-dihedral angles.
6648 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6649 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6650 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6651 vv(1)=pizda(1,1)+pizda(2,2)
6652 vv(2)=pizda(2,1)-pizda(1,2)
6654 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6655 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6656 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6658 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6659 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6660 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6662 C Cartesian gradient
6666 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6668 vv(1)=pizda(1,1)+pizda(2,2)
6669 vv(2)=pizda(2,1)-pizda(1,2)
6670 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6671 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6672 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6681 C Parallel orientation
6682 C Contribution from graph III
6683 call transpose2(EUg(1,1,l),auxmat(1,1))
6684 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6685 vv(1)=pizda(1,1)-pizda(2,2)
6686 vv(2)=pizda(1,2)+pizda(2,1)
6687 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6688 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6690 C Explicit gradient in virtual-dihedral angles.
6691 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6692 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6693 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6694 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6695 vv(1)=pizda(1,1)-pizda(2,2)
6696 vv(2)=pizda(1,2)+pizda(2,1)
6697 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6698 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6699 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6700 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6701 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6702 vv(1)=pizda(1,1)-pizda(2,2)
6703 vv(2)=pizda(1,2)+pizda(2,1)
6704 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6705 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6706 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6707 C Cartesian gradient
6711 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6713 vv(1)=pizda(1,1)-pizda(2,2)
6714 vv(2)=pizda(1,2)+pizda(2,1)
6715 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6716 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6717 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6723 C Contribution from graph IV
6725 call transpose2(EE(1,1,itl),auxmat(1,1))
6726 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6727 vv(1)=pizda(1,1)+pizda(2,2)
6728 vv(2)=pizda(2,1)-pizda(1,2)
6729 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6730 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6732 C Explicit gradient in virtual-dihedral angles.
6733 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6734 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6735 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6736 vv(1)=pizda(1,1)+pizda(2,2)
6737 vv(2)=pizda(2,1)-pizda(1,2)
6738 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6739 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6740 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6741 C Cartesian gradient
6745 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6747 vv(1)=pizda(1,1)+pizda(2,2)
6748 vv(2)=pizda(2,1)-pizda(1,2)
6749 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6750 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6751 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6757 C Antiparallel orientation
6758 C Contribution from graph III
6760 call transpose2(EUg(1,1,j),auxmat(1,1))
6761 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6762 vv(1)=pizda(1,1)-pizda(2,2)
6763 vv(2)=pizda(1,2)+pizda(2,1)
6764 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6765 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6767 C Explicit gradient in virtual-dihedral angles.
6768 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6769 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6770 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6771 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6772 vv(1)=pizda(1,1)-pizda(2,2)
6773 vv(2)=pizda(1,2)+pizda(2,1)
6774 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6775 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6776 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6777 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6778 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6779 vv(1)=pizda(1,1)-pizda(2,2)
6780 vv(2)=pizda(1,2)+pizda(2,1)
6781 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6782 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6783 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6784 C Cartesian gradient
6788 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6790 vv(1)=pizda(1,1)-pizda(2,2)
6791 vv(2)=pizda(1,2)+pizda(2,1)
6792 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6793 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6794 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6800 C Contribution from graph IV
6802 call transpose2(EE(1,1,itj),auxmat(1,1))
6803 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6804 vv(1)=pizda(1,1)+pizda(2,2)
6805 vv(2)=pizda(2,1)-pizda(1,2)
6806 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6807 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6809 C Explicit gradient in virtual-dihedral angles.
6810 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6811 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6812 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6813 vv(1)=pizda(1,1)+pizda(2,2)
6814 vv(2)=pizda(2,1)-pizda(1,2)
6815 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6816 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6817 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6818 C Cartesian gradient
6822 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6824 vv(1)=pizda(1,1)+pizda(2,2)
6825 vv(2)=pizda(2,1)-pizda(1,2)
6826 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6827 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6828 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6835 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6836 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6837 cd write (2,*) 'ijkl',i,j,k,l
6838 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6839 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6841 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6842 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6843 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6844 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6846 if (j.lt.nres-1) then
6853 if (l.lt.nres-1) then
6863 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6865 ggg1(ll)=eel5*g_contij(ll,1)
6866 ggg2(ll)=eel5*g_contij(ll,2)
6867 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6868 ghalf=0.5d0*ggg1(ll)
6870 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6871 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6872 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6873 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6874 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6875 ghalf=0.5d0*ggg2(ll)
6877 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6878 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6879 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6880 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6885 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6886 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6891 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6892 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6898 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6903 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6907 cd write (2,*) iii,g_corr5_loc(iii)
6911 cd write (2,*) 'ekont',ekont
6912 cd write (iout,*) 'eello5',ekont*eel5
6915 c--------------------------------------------------------------------------
6916 double precision function eello6(i,j,k,l,jj,kk)
6917 implicit real*8 (a-h,o-z)
6918 include 'DIMENSIONS'
6919 include 'DIMENSIONS.ZSCOPT'
6920 include 'COMMON.IOUNITS'
6921 include 'COMMON.CHAIN'
6922 include 'COMMON.DERIV'
6923 include 'COMMON.INTERACT'
6924 include 'COMMON.CONTACTS'
6925 include 'COMMON.TORSION'
6926 include 'COMMON.VAR'
6927 include 'COMMON.GEO'
6928 include 'COMMON.FFIELD'
6929 double precision ggg1(3),ggg2(3)
6930 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6935 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6943 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6944 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6948 derx(lll,kkk,iii)=0.0d0
6952 cd eij=facont_hb(jj,i)
6953 cd ekl=facont_hb(kk,k)
6959 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6960 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6961 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6962 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6963 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6964 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6966 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6967 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6968 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6969 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6970 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6971 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6975 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6977 C If turn contributions are considered, they will be handled separately.
6978 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6979 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6980 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6981 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6982 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6983 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6984 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6987 if (j.lt.nres-1) then
6994 if (l.lt.nres-1) then
7002 ggg1(ll)=eel6*g_contij(ll,1)
7003 ggg2(ll)=eel6*g_contij(ll,2)
7004 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7005 ghalf=0.5d0*ggg1(ll)
7007 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7008 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7009 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7010 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7011 ghalf=0.5d0*ggg2(ll)
7012 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7014 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7015 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7016 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7017 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7022 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7023 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7028 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7029 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7035 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7040 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7044 cd write (2,*) iii,g_corr6_loc(iii)
7048 cd write (2,*) 'ekont',ekont
7049 cd write (iout,*) 'eello6',ekont*eel6
7052 c--------------------------------------------------------------------------
7053 double precision function eello6_graph1(i,j,k,l,imat,swap)
7054 implicit real*8 (a-h,o-z)
7055 include 'DIMENSIONS'
7056 include 'DIMENSIONS.ZSCOPT'
7057 include 'COMMON.IOUNITS'
7058 include 'COMMON.CHAIN'
7059 include 'COMMON.DERIV'
7060 include 'COMMON.INTERACT'
7061 include 'COMMON.CONTACTS'
7062 include 'COMMON.TORSION'
7063 include 'COMMON.VAR'
7064 include 'COMMON.GEO'
7065 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7069 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7071 C Parallel Antiparallel C
7077 C \ j|/k\| / \ |/k\|l / C
7082 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7083 itk=itortyp(itype(k))
7084 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7085 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7086 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7087 call transpose2(EUgC(1,1,k),auxmat(1,1))
7088 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7089 vv1(1)=pizda1(1,1)-pizda1(2,2)
7090 vv1(2)=pizda1(1,2)+pizda1(2,1)
7091 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7092 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7093 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7094 s5=scalar2(vv(1),Dtobr2(1,i))
7095 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7096 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7097 if (.not. calc_grad) return
7098 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7099 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7100 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7101 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7102 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7103 & +scalar2(vv(1),Dtobr2der(1,i)))
7104 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7105 vv1(1)=pizda1(1,1)-pizda1(2,2)
7106 vv1(2)=pizda1(1,2)+pizda1(2,1)
7107 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7108 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7110 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7111 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7112 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7113 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7114 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7116 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7117 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7118 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7119 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7120 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7122 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7123 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7124 vv1(1)=pizda1(1,1)-pizda1(2,2)
7125 vv1(2)=pizda1(1,2)+pizda1(2,1)
7126 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7127 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7128 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7129 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7138 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7139 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7140 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7141 call transpose2(EUgC(1,1,k),auxmat(1,1))
7142 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7144 vv1(1)=pizda1(1,1)-pizda1(2,2)
7145 vv1(2)=pizda1(1,2)+pizda1(2,1)
7146 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7147 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7148 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7149 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7150 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7151 s5=scalar2(vv(1),Dtobr2(1,i))
7152 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7158 c----------------------------------------------------------------------------
7159 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7160 implicit real*8 (a-h,o-z)
7161 include 'DIMENSIONS'
7162 include 'DIMENSIONS.ZSCOPT'
7163 include 'COMMON.IOUNITS'
7164 include 'COMMON.CHAIN'
7165 include 'COMMON.DERIV'
7166 include 'COMMON.INTERACT'
7167 include 'COMMON.CONTACTS'
7168 include 'COMMON.TORSION'
7169 include 'COMMON.VAR'
7170 include 'COMMON.GEO'
7172 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7173 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7176 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7178 C Parallel Antiparallel C
7184 C \ j|/k\| \ |/k\|l C
7189 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7190 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7191 C AL 7/4/01 s1 would occur in the sixth-order moment,
7192 C but not in a cluster cumulant
7194 s1=dip(1,jj,i)*dip(1,kk,k)
7196 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7197 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7198 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7199 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7200 call transpose2(EUg(1,1,k),auxmat(1,1))
7201 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7202 vv(1)=pizda(1,1)-pizda(2,2)
7203 vv(2)=pizda(1,2)+pizda(2,1)
7204 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7205 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7207 eello6_graph2=-(s1+s2+s3+s4)
7209 eello6_graph2=-(s2+s3+s4)
7212 if (.not. calc_grad) return
7213 C Derivatives in gamma(i-1)
7216 s1=dipderg(1,jj,i)*dip(1,kk,k)
7218 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7219 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7220 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7221 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7223 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7225 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7227 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7229 C Derivatives in gamma(k-1)
7231 s1=dip(1,jj,i)*dipderg(1,kk,k)
7233 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7234 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7235 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7236 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7237 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7238 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7239 vv(1)=pizda(1,1)-pizda(2,2)
7240 vv(2)=pizda(1,2)+pizda(2,1)
7241 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7243 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7245 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7247 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7248 C Derivatives in gamma(j-1) or gamma(l-1)
7251 s1=dipderg(3,jj,i)*dip(1,kk,k)
7253 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7254 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7255 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7256 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7257 vv(1)=pizda(1,1)-pizda(2,2)
7258 vv(2)=pizda(1,2)+pizda(2,1)
7259 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7262 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7264 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7267 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7268 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7270 C Derivatives in gamma(l-1) or gamma(j-1)
7273 s1=dip(1,jj,i)*dipderg(3,kk,k)
7275 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7276 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7277 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7278 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7279 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7280 vv(1)=pizda(1,1)-pizda(2,2)
7281 vv(2)=pizda(1,2)+pizda(2,1)
7282 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7285 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7287 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7290 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7291 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7293 C Cartesian derivatives.
7295 write (2,*) 'In eello6_graph2'
7297 write (2,*) 'iii=',iii
7299 write (2,*) 'kkk=',kkk
7301 write (2,'(3(2f10.5),5x)')
7302 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7312 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7314 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7317 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7319 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7320 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7322 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7323 call transpose2(EUg(1,1,k),auxmat(1,1))
7324 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7326 vv(1)=pizda(1,1)-pizda(2,2)
7327 vv(2)=pizda(1,2)+pizda(2,1)
7328 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7329 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7331 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7333 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7336 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7338 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7345 c----------------------------------------------------------------------------
7346 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7347 implicit real*8 (a-h,o-z)
7348 include 'DIMENSIONS'
7349 include 'DIMENSIONS.ZSCOPT'
7350 include 'COMMON.IOUNITS'
7351 include 'COMMON.CHAIN'
7352 include 'COMMON.DERIV'
7353 include 'COMMON.INTERACT'
7354 include 'COMMON.CONTACTS'
7355 include 'COMMON.TORSION'
7356 include 'COMMON.VAR'
7357 include 'COMMON.GEO'
7358 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7360 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7362 C Parallel Antiparallel C
7368 C j|/k\| / |/k\|l / C
7373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7375 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7376 C energy moment and not to the cluster cumulant.
7377 iti=itortyp(itype(i))
7378 if (j.lt.nres-1) then
7379 itj1=itortyp(itype(j+1))
7383 itk=itortyp(itype(k))
7384 itk1=itortyp(itype(k+1))
7385 if (l.lt.nres-1) then
7386 itl1=itortyp(itype(l+1))
7391 s1=dip(4,jj,i)*dip(4,kk,k)
7393 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7394 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7395 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7396 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7397 call transpose2(EE(1,1,itk),auxmat(1,1))
7398 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7399 vv(1)=pizda(1,1)+pizda(2,2)
7400 vv(2)=pizda(2,1)-pizda(1,2)
7401 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7402 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7404 eello6_graph3=-(s1+s2+s3+s4)
7406 eello6_graph3=-(s2+s3+s4)
7409 if (.not. calc_grad) return
7410 C Derivatives in gamma(k-1)
7411 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7412 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7413 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7414 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7415 C Derivatives in gamma(l-1)
7416 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7417 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7418 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7419 vv(1)=pizda(1,1)+pizda(2,2)
7420 vv(2)=pizda(2,1)-pizda(1,2)
7421 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7422 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7423 C Cartesian derivatives.
7429 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7431 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7434 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7436 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7437 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7439 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7440 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7442 vv(1)=pizda(1,1)+pizda(2,2)
7443 vv(2)=pizda(2,1)-pizda(1,2)
7444 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7446 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7448 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7451 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7453 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7455 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7461 c----------------------------------------------------------------------------
7462 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7463 implicit real*8 (a-h,o-z)
7464 include 'DIMENSIONS'
7465 include 'DIMENSIONS.ZSCOPT'
7466 include 'COMMON.IOUNITS'
7467 include 'COMMON.CHAIN'
7468 include 'COMMON.DERIV'
7469 include 'COMMON.INTERACT'
7470 include 'COMMON.CONTACTS'
7471 include 'COMMON.TORSION'
7472 include 'COMMON.VAR'
7473 include 'COMMON.GEO'
7474 include 'COMMON.FFIELD'
7475 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7476 & auxvec1(2),auxmat1(2,2)
7478 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7480 C Parallel Antiparallel C
7486 C \ j|/k\| \ |/k\|l C
7491 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7493 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7494 C energy moment and not to the cluster cumulant.
7495 cd write (2,*) 'eello_graph4: wturn6',wturn6
7496 iti=itortyp(itype(i))
7497 itj=itortyp(itype(j))
7498 if (j.lt.nres-1) then
7499 itj1=itortyp(itype(j+1))
7503 itk=itortyp(itype(k))
7504 if (k.lt.nres-1) then
7505 itk1=itortyp(itype(k+1))
7509 itl=itortyp(itype(l))
7510 if (l.lt.nres-1) then
7511 itl1=itortyp(itype(l+1))
7515 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7516 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7517 cd & ' itl',itl,' itl1',itl1
7520 s1=dip(3,jj,i)*dip(3,kk,k)
7522 s1=dip(2,jj,j)*dip(2,kk,l)
7525 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7526 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7528 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7529 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7531 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7532 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7534 call transpose2(EUg(1,1,k),auxmat(1,1))
7535 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7536 vv(1)=pizda(1,1)-pizda(2,2)
7537 vv(2)=pizda(2,1)+pizda(1,2)
7538 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7539 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7541 eello6_graph4=-(s1+s2+s3+s4)
7543 eello6_graph4=-(s2+s3+s4)
7545 if (.not. calc_grad) return
7546 C Derivatives in gamma(i-1)
7550 s1=dipderg(2,jj,i)*dip(3,kk,k)
7552 s1=dipderg(4,jj,j)*dip(2,kk,l)
7555 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7557 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7558 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7560 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7561 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7563 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7564 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7565 cd write (2,*) 'turn6 derivatives'
7567 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7569 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7573 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7575 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7579 C Derivatives in gamma(k-1)
7582 s1=dip(3,jj,i)*dipderg(2,kk,k)
7584 s1=dip(2,jj,j)*dipderg(4,kk,l)
7587 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7588 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7590 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7591 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7593 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7594 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7596 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7597 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(2,1)+pizda(1,2)
7600 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7601 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7603 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7605 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7609 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7611 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7614 C Derivatives in gamma(j-1) or gamma(l-1)
7615 if (l.eq.j+1 .and. l.gt.1) then
7616 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7617 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7618 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7619 vv(1)=pizda(1,1)-pizda(2,2)
7620 vv(2)=pizda(2,1)+pizda(1,2)
7621 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7622 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7623 else if (j.gt.1) then
7624 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7625 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7626 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(2,1)+pizda(1,2)
7629 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7630 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7631 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7633 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7636 C Cartesian derivatives.
7643 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7645 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7649 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7651 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7655 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7657 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7659 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7660 & b1(1,itj1),auxvec(1))
7661 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7663 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7664 & b1(1,itl1),auxvec(1))
7665 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7667 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7669 vv(1)=pizda(1,1)-pizda(2,2)
7670 vv(2)=pizda(2,1)+pizda(1,2)
7671 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7673 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7675 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7678 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7681 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7684 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7686 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7688 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7694 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7697 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7699 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7707 c----------------------------------------------------------------------------
7708 double precision function eello_turn6(i,jj,kk)
7709 implicit real*8 (a-h,o-z)
7710 include 'DIMENSIONS'
7711 include 'DIMENSIONS.ZSCOPT'
7712 include 'COMMON.IOUNITS'
7713 include 'COMMON.CHAIN'
7714 include 'COMMON.DERIV'
7715 include 'COMMON.INTERACT'
7716 include 'COMMON.CONTACTS'
7717 include 'COMMON.TORSION'
7718 include 'COMMON.VAR'
7719 include 'COMMON.GEO'
7720 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7721 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7723 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7724 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7725 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7726 C the respective energy moment and not to the cluster cumulant.
7731 iti=itortyp(itype(i))
7732 itk=itortyp(itype(k))
7733 itk1=itortyp(itype(k+1))
7734 itl=itortyp(itype(l))
7735 itj=itortyp(itype(j))
7736 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7737 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7738 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7743 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7745 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7749 derx_turn(lll,kkk,iii)=0.0d0
7756 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7758 cd write (2,*) 'eello6_5',eello6_5
7760 call transpose2(AEA(1,1,1),auxmat(1,1))
7761 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7762 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7763 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7767 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7768 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7769 s2 = scalar2(b1(1,itk),vtemp1(1))
7771 call transpose2(AEA(1,1,2),atemp(1,1))
7772 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7773 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7774 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7778 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7779 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7780 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7782 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7783 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7784 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7785 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7786 ss13 = scalar2(b1(1,itk),vtemp4(1))
7787 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7791 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7797 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7799 C Derivatives in gamma(i+2)
7801 call transpose2(AEA(1,1,1),auxmatd(1,1))
7802 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7803 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7804 call transpose2(AEAderg(1,1,2),atempd(1,1))
7805 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7806 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7810 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7811 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7812 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7818 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7819 C Derivatives in gamma(i+3)
7821 call transpose2(AEA(1,1,1),auxmatd(1,1))
7822 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7823 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7824 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7828 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7829 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7830 s2d = scalar2(b1(1,itk),vtemp1d(1))
7832 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7833 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7835 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7837 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7838 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7839 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7849 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7850 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7852 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7853 & -0.5d0*ekont*(s2d+s12d)
7855 C Derivatives in gamma(i+4)
7856 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7857 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7858 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7860 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7861 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7862 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7872 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7874 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7876 C Derivatives in gamma(i+5)
7878 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7879 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7880 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7884 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7885 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7886 s2d = scalar2(b1(1,itk),vtemp1d(1))
7888 call transpose2(AEA(1,1,2),atempd(1,1))
7889 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7890 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7894 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7895 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7897 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7898 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7899 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7909 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7910 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7912 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7913 & -0.5d0*ekont*(s2d+s12d)
7915 C Cartesian derivatives
7920 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7921 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7922 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7926 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7927 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7929 s2d = scalar2(b1(1,itk),vtemp1d(1))
7931 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7932 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7933 s8d = -(atempd(1,1)+atempd(2,2))*
7934 & scalar2(cc(1,1,itl),vtemp2(1))
7938 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7940 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7941 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7948 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7951 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7955 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7956 & - 0.5d0*(s8d+s12d)
7958 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7967 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7969 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7970 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7971 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7972 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7973 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7975 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7976 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7977 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7981 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7982 cd & 16*eel_turn6_num
7984 if (j.lt.nres-1) then
7991 if (l.lt.nres-1) then
7999 ggg1(ll)=eel_turn6*g_contij(ll,1)
8000 ggg2(ll)=eel_turn6*g_contij(ll,2)
8001 ghalf=0.5d0*ggg1(ll)
8003 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8004 & +ekont*derx_turn(ll,2,1)
8005 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8006 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8007 & +ekont*derx_turn(ll,4,1)
8008 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8009 ghalf=0.5d0*ggg2(ll)
8011 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8012 & +ekont*derx_turn(ll,2,2)
8013 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8014 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8015 & +ekont*derx_turn(ll,4,2)
8016 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8021 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8026 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8032 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8037 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8041 cd write (2,*) iii,g_corr6_loc(iii)
8044 eello_turn6=ekont*eel_turn6
8045 cd write (2,*) 'ekont',ekont
8046 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8049 crc-------------------------------------------------
8050 SUBROUTINE MATVEC2(A1,V1,V2)
8051 implicit real*8 (a-h,o-z)
8052 include 'DIMENSIONS'
8053 DIMENSION A1(2,2),V1(2),V2(2)
8057 c 3 VI=VI+A1(I,K)*V1(K)
8061 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8062 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8067 C---------------------------------------
8068 SUBROUTINE MATMAT2(A1,A2,A3)
8069 implicit real*8 (a-h,o-z)
8070 include 'DIMENSIONS'
8071 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8072 c DIMENSION AI3(2,2)
8076 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8082 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8083 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8084 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8085 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8093 c-------------------------------------------------------------------------
8094 double precision function scalar2(u,v)
8096 double precision u(2),v(2)
8099 scalar2=u(1)*v(1)+u(2)*v(2)
8103 C-----------------------------------------------------------------------------
8105 subroutine transpose2(a,at)
8107 double precision a(2,2),at(2,2)
8114 c--------------------------------------------------------------------------
8115 subroutine transpose(n,a,at)
8118 double precision a(n,n),at(n,n)
8126 C---------------------------------------------------------------------------
8127 subroutine prodmat3(a1,a2,kk,transp,prod)
8130 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8132 crc double precision auxmat(2,2),prod_(2,2)
8135 crc call transpose2(kk(1,1),auxmat(1,1))
8136 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8137 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8139 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8140 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8141 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8142 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8143 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8144 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8145 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8146 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8149 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8150 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8152 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8153 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8154 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8155 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8156 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8157 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8158 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8159 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8162 c call transpose2(a2(1,1),a2t(1,1))
8165 crc print *,((prod_(i,j),i=1,2),j=1,2)
8166 crc print *,((prod(i,j),i=1,2),j=1,2)
8170 C-----------------------------------------------------------------------------
8171 double precision function scalar(u,v)
8173 double precision u(3),v(3)