1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
11 cMS$ATTRIBUTES C :: proc_proc
14 include 'COMMON.IOUNITS'
15 double precision energia(0:max_ene),energia1(0:max_ene+1)
21 include 'COMMON.FFIELD'
22 include 'COMMON.DERIV'
23 include 'COMMON.INTERACT'
24 include 'COMMON.SBRIDGE'
25 include 'COMMON.CHAIN'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
64 C Calculate the disulfide-bridge and other energy and the contributions
65 C from other distance constraints.
66 cd print *,'Calling EHPB'
68 cd print *,'EHPB exitted succesfully.'
70 C Calculate the virtual-bond-angle energy.
73 cd print *,'Bend energy finished.'
75 C Calculate the SC local energy.
78 cd print *,'SCLOC energy finished.'
80 C Calculate the virtual-bond torsional energy.
82 cd print *,'nterm=',nterm
83 call etor(etors,edihcnstr,fact(1))
85 C 6/23/01 Calculate double-torsional energy
87 call etor_d(etors_d,fact(2))
89 C 21/5/07 Calculate local sicdechain correlation energy
91 call eback_sc_corr(esccor)
93 C 12/1/95 Multi-body terms
97 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
98 & .or. wturn6.gt.0.0d0) then
99 c print *,"calling multibody_eello"
100 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
101 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
102 c print *,ecorr,ecorr5,ecorr6,eturn6
104 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
105 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
109 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
110 if (constr_homology.ge.1) then
111 call e_modeller(ehomology_constr)
113 ehomology_constr=0.0d0
116 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
118 C BARTEK for dfa test!
119 if (wdfa_dist.gt.0) call edfad(edfadis)
120 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
121 if (wdfa_tor.gt.0) call edfat(edfator)
122 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
123 if (wdfa_nei.gt.0) call edfan(edfanei)
124 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
125 if (wdfa_beta.gt.0) call edfab(edfabet)
126 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
128 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
130 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
132 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
133 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
134 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
135 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
136 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
137 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
138 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
141 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
142 & +welec*fact(1)*(ees+evdw1)
143 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
144 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
145 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
146 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
147 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
148 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
149 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
155 energia(2)=evdw2-evdw2_14
172 energia(8)=eello_turn3
173 energia(9)=eello_turn4
182 energia(20)=edihcnstr
184 energia(22)=ehomology_constr
189 c if (dyn_ss) call dyn_set_nss
193 if (isnan(etot).ne.0) energia(0)=1.0d+99
195 if (isnan(etot)) energia(0)=1.0d+99
200 idumm=proc_proc(etot,i)
202 call proc_proc(etot,i)
204 if(i.eq.1)energia(0)=1.0d+99
211 C Sum up the components of the Cartesian gradient.
216 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
217 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
219 & wstrain*ghpbc(j,i)+
220 & wcorr*fact(3)*gradcorr(j,i)+
221 & wel_loc*fact(2)*gel_loc(j,i)+
222 & wturn3*fact(2)*gcorr3_turn(j,i)+
223 & wturn4*fact(3)*gcorr4_turn(j,i)+
224 & wcorr5*fact(4)*gradcorr5(j,i)+
225 & wcorr6*fact(5)*gradcorr6(j,i)+
226 & wturn6*fact(5)*gcorr6_turn(j,i)+
227 & wsccor*fact(2)*gsccorc(j,i)+
228 & wdfa_dist*gdfad(j,i)+
229 & wdfa_tor*gdfat(j,i)+
230 & wdfa_nei*gdfan(j,i)+
231 & wdfa_beta*gdfab(j,i)
232 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
234 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
235 & wsccor*fact(2)*gsccorx(j,i)
240 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
241 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
243 & wcorr*fact(3)*gradcorr(j,i)+
244 & wel_loc*fact(2)*gel_loc(j,i)+
245 & wturn3*fact(2)*gcorr3_turn(j,i)+
246 & wturn4*fact(3)*gcorr4_turn(j,i)+
247 & wcorr5*fact(4)*gradcorr5(j,i)+
248 & wcorr6*fact(5)*gradcorr6(j,i)+
249 & wturn6*fact(5)*gcorr6_turn(j,i)+
250 & wsccor*fact(2)*gsccorc(j,i)+
251 & wdfa_dist*gdfad(j,i)+
252 & wdfa_tor*gdfat(j,i)+
253 & wdfa_nei*gdfan(j,i)+
254 & wdfa_beta*gdfab(j,i)
255 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
257 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
258 & wsccor*fact(1)*gsccorx(j,i)
265 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
266 & +wcorr5*fact(4)*g_corr5_loc(i)
267 & +wcorr6*fact(5)*g_corr6_loc(i)
268 & +wturn4*fact(3)*gel_loc_turn4(i)
269 & +wturn3*fact(2)*gel_loc_turn3(i)
270 & +wturn6*fact(5)*gel_loc_turn6(i)
271 & +wel_loc*fact(2)*gel_loc_loc(i)
272 & +wsccor*fact(1)*gsccor_loc(i)
277 C------------------------------------------------------------------------
278 subroutine enerprint(energia,fact)
279 implicit real*8 (a-h,o-z)
281 include 'DIMENSIONS.ZSCOPT'
282 include 'COMMON.IOUNITS'
283 include 'COMMON.FFIELD'
284 include 'COMMON.SBRIDGE'
285 double precision energia(0:max_ene),fact(6)
287 evdw=energia(1)+fact(6)*energia(21)
289 evdw2=energia(2)+energia(17)
301 eello_turn3=energia(8)
302 eello_turn4=energia(9)
303 eello_turn6=energia(10)
310 edihcnstr=energia(20)
312 ehomology_constr=energia(22)
318 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
320 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
321 & etors_d,wtor_d*fact(2),ehpb,wstrain,
322 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
323 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
324 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
325 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
326 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
328 10 format (/'Virtual-chain energies:'//
329 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
330 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
331 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
332 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
333 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
334 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
335 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
336 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
337 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
338 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
339 & ' (SS bridges & dist. cnstr.)'/
340 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
341 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
342 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
343 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
344 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
345 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
346 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
347 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
348 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
349 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
350 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
351 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
352 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
353 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
354 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
355 & 'ETOT= ',1pE16.6,' (total)')
357 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
358 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
359 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
360 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
361 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
362 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
363 & edihcnstr,ehomology_constr,ebr*nss,
364 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
366 10 format (/'Virtual-chain energies:'//
367 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
368 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
369 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
370 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
371 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
372 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
373 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
374 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
375 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
376 & ' (SS bridges & dist. cnstr.)'/
377 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
378 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
379 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
380 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
381 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
382 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
383 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
384 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
385 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
386 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
387 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
388 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
389 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
390 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
391 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
392 & 'ETOT= ',1pE16.6,' (total)')
396 C-----------------------------------------------------------------------
397 subroutine elj(evdw,evdw_t)
399 C This subroutine calculates the interaction energy of nonbonded side chains
400 C assuming the LJ potential of interaction.
402 implicit real*8 (a-h,o-z)
404 include 'DIMENSIONS.ZSCOPT'
405 include "DIMENSIONS.COMPAR"
406 parameter (accur=1.0d-10)
409 include 'COMMON.LOCAL'
410 include 'COMMON.CHAIN'
411 include 'COMMON.DERIV'
412 include 'COMMON.INTERACT'
413 include 'COMMON.TORSION'
414 include 'COMMON.ENEPS'
415 include 'COMMON.SBRIDGE'
416 include 'COMMON.NAMES'
417 include 'COMMON.IOUNITS'
418 include 'COMMON.CONTACTS'
422 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
425 eneps_temp(j,i)=0.0d0
439 C Calculate SC interaction energy.
442 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
443 cd & 'iend=',iend(i,iint)
444 do j=istart(i,iint),iend(i,iint)
449 C Change 12/1/95 to calculate four-body interactions
450 rij=xj*xj+yj*yj+zj*zj
452 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
453 eps0ij=eps(itypi,itypj)
455 e1=fac*fac*aa(itypi,itypj)
456 e2=fac*bb(itypi,itypj)
458 ij=icant(itypi,itypj)
459 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
460 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
461 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
462 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
463 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
464 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
465 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
466 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
467 if (bb(itypi,itypj).gt.0.0d0) then
474 C Calculate the components of the gradient in DC and X
476 fac=-rrij*(e1+evdwij)
481 gvdwx(k,i)=gvdwx(k,i)-gg(k)
482 gvdwx(k,j)=gvdwx(k,j)+gg(k)
486 gvdwc(l,k)=gvdwc(l,k)+gg(l)
491 C 12/1/95, revised on 5/20/97
493 C Calculate the contact function. The ith column of the array JCONT will
494 C contain the numbers of atoms that make contacts with the atom I (of numbers
495 C greater than I). The arrays FACONT and GACONT will contain the values of
496 C the contact function and its derivative.
498 C Uncomment next line, if the correlation interactions include EVDW explicitly.
499 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
500 C Uncomment next line, if the correlation interactions are contact function only
501 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
503 sigij=sigma(itypi,itypj)
504 r0ij=rs0(itypi,itypj)
506 C Check whether the SC's are not too far to make a contact.
509 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
510 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
512 if (fcont.gt.0.0D0) then
513 C If the SC-SC distance if close to sigma, apply spline.
514 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
515 cAdam & fcont1,fprimcont1)
516 cAdam fcont1=1.0d0-fcont1
517 cAdam if (fcont1.gt.0.0d0) then
518 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
519 cAdam fcont=fcont*fcont1
521 C Uncomment following 4 lines to have the geometric average of the epsilon0's
522 cga eps0ij=1.0d0/dsqrt(eps0ij)
524 cga gg(k)=gg(k)*eps0ij
526 cga eps0ij=-evdwij*eps0ij
527 C Uncomment for AL's type of SC correlation interactions.
529 num_conti=num_conti+1
531 facont(num_conti,i)=fcont*eps0ij
532 fprimcont=eps0ij*fprimcont/rij
534 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
535 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
536 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
537 C Uncomment following 3 lines for Skolnick's type of SC correlation.
538 gacont(1,num_conti,i)=-fprimcont*xj
539 gacont(2,num_conti,i)=-fprimcont*yj
540 gacont(3,num_conti,i)=-fprimcont*zj
541 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
542 cd write (iout,'(2i3,3f10.5)')
543 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
549 num_cont(i)=num_conti
554 gvdwc(j,i)=expon*gvdwc(j,i)
555 gvdwx(j,i)=expon*gvdwx(j,i)
559 C******************************************************************************
563 C To save time, the factor of EXPON has been extracted from ALL components
564 C of GVDWC and GRADX. Remember to multiply them by this factor before further
567 C******************************************************************************
570 C-----------------------------------------------------------------------------
571 subroutine eljk(evdw,evdw_t)
573 C This subroutine calculates the interaction energy of nonbonded side chains
574 C assuming the LJK potential of interaction.
576 implicit real*8 (a-h,o-z)
578 include 'DIMENSIONS.ZSCOPT'
579 include "DIMENSIONS.COMPAR"
582 include 'COMMON.LOCAL'
583 include 'COMMON.CHAIN'
584 include 'COMMON.DERIV'
585 include 'COMMON.INTERACT'
586 include 'COMMON.ENEPS'
587 include 'COMMON.IOUNITS'
588 include 'COMMON.NAMES'
593 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
596 eneps_temp(j,i)=0.0d0
608 C Calculate SC interaction energy.
611 do j=istart(i,iint),iend(i,iint)
616 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
618 e_augm=augm(itypi,itypj)*fac_augm
621 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
622 fac=r_shift_inv**expon
623 e1=fac*fac*aa(itypi,itypj)
624 e2=fac*bb(itypi,itypj)
626 ij=icant(itypi,itypj)
627 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
628 & /dabs(eps(itypi,itypj))
629 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
630 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
631 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
632 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
633 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
634 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
635 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
636 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
637 if (bb(itypi,itypj).gt.0.0d0) then
644 C Calculate the components of the gradient in DC and X
646 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
651 gvdwx(k,i)=gvdwx(k,i)-gg(k)
652 gvdwx(k,j)=gvdwx(k,j)+gg(k)
656 gvdwc(l,k)=gvdwc(l,k)+gg(l)
666 gvdwc(j,i)=expon*gvdwc(j,i)
667 gvdwx(j,i)=expon*gvdwx(j,i)
673 C-----------------------------------------------------------------------------
674 subroutine ebp(evdw,evdw_t)
676 C This subroutine calculates the interaction energy of nonbonded side chains
677 C assuming the Berne-Pechukas potential of interaction.
679 implicit real*8 (a-h,o-z)
681 include 'DIMENSIONS.ZSCOPT'
682 include "DIMENSIONS.COMPAR"
685 include 'COMMON.LOCAL'
686 include 'COMMON.CHAIN'
687 include 'COMMON.DERIV'
688 include 'COMMON.NAMES'
689 include 'COMMON.INTERACT'
690 include 'COMMON.ENEPS'
691 include 'COMMON.IOUNITS'
692 include 'COMMON.CALC'
694 c double precision rrsave(maxdim)
700 eneps_temp(j,i)=0.0d0
705 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
706 c if (icall.eq.0) then
718 dxi=dc_norm(1,nres+i)
719 dyi=dc_norm(2,nres+i)
720 dzi=dc_norm(3,nres+i)
721 dsci_inv=vbld_inv(i+nres)
723 C Calculate SC interaction energy.
726 do j=istart(i,iint),iend(i,iint)
729 dscj_inv=vbld_inv(j+nres)
730 chi1=chi(itypi,itypj)
731 chi2=chi(itypj,itypi)
738 alf12=0.5D0*(alf1+alf2)
739 C For diagnostics only!!!
752 dxj=dc_norm(1,nres+j)
753 dyj=dc_norm(2,nres+j)
754 dzj=dc_norm(3,nres+j)
755 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
756 cd if (icall.eq.0) then
762 C Calculate the angle-dependent terms of energy & contributions to derivatives.
764 C Calculate whole angle-dependent part of epsilon and contributions
766 fac=(rrij*sigsq)**expon2
767 e1=fac*fac*aa(itypi,itypj)
768 e2=fac*bb(itypi,itypj)
769 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
770 eps2der=evdwij*eps3rt
771 eps3der=evdwij*eps2rt
772 evdwij=evdwij*eps2rt*eps3rt
773 ij=icant(itypi,itypj)
774 aux=eps1*eps2rt**2*eps3rt**2
775 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
776 & /dabs(eps(itypi,itypj))
777 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
778 if (bb(itypi,itypj).gt.0.0d0) then
785 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
786 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
787 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
788 cd & restyp(itypi),i,restyp(itypj),j,
789 cd & epsi,sigm,chi1,chi2,chip1,chip2,
790 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
791 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
794 C Calculate gradient components.
795 e1=e1*eps1*eps2rt**2*eps3rt**2
796 fac=-expon*(e1+evdwij)
799 C Calculate radial part of the gradient
803 C Calculate the angular part of the gradient and sum add the contributions
804 C to the appropriate components of the Cartesian gradient.
813 C-----------------------------------------------------------------------------
814 subroutine egb(evdw,evdw_t)
816 C This subroutine calculates the interaction energy of nonbonded side chains
817 C assuming the Gay-Berne potential of interaction.
819 implicit real*8 (a-h,o-z)
821 include 'DIMENSIONS.ZSCOPT'
822 include "DIMENSIONS.COMPAR"
825 include 'COMMON.LOCAL'
826 include 'COMMON.CHAIN'
827 include 'COMMON.DERIV'
828 include 'COMMON.NAMES'
829 include 'COMMON.INTERACT'
830 include 'COMMON.ENEPS'
831 include 'COMMON.IOUNITS'
832 include 'COMMON.CALC'
833 include 'COMMON.SBRIDGE'
840 eneps_temp(j,i)=0.0d0
843 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
847 c if (icall.gt.0) lprn=.true.
855 dxi=dc_norm(1,nres+i)
856 dyi=dc_norm(2,nres+i)
857 dzi=dc_norm(3,nres+i)
858 dsci_inv=vbld_inv(i+nres)
860 C Calculate SC interaction energy.
863 do j=istart(i,iint),iend(i,iint)
864 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
865 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
866 C formation no electrostatic interactions should be calculated. If it
867 C would be allowed NaN would appear
868 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
869 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
870 C residue can or cannot form disulfide bond. There is still bug allowing
871 C Cys...Cys...Cys bond formation
872 call dyn_ssbond_ene(i,j,evdwij)
873 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
876 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
877 c & 'evdw',i,j,evdwij,' ss'
881 dscj_inv=vbld_inv(j+nres)
882 sig0ij=sigma(itypi,itypj)
883 chi1=chi(itypi,itypj)
884 chi2=chi(itypj,itypi)
891 alf12=0.5D0*(alf1+alf2)
892 C For diagnostics only!!!
905 dxj=dc_norm(1,nres+j)
906 dyj=dc_norm(2,nres+j)
907 dzj=dc_norm(3,nres+j)
908 c write (iout,*) i,j,xj,yj,zj
909 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
911 C Calculate angle-dependent terms of energy and contributions to their
915 sig=sig0ij*dsqrt(sigsq)
916 rij_shift=1.0D0/rij-sig+sig0ij
917 C I hate to put IF's in the loops, but here don't have another choice!!!!
918 if (rij_shift.le.0.0D0) then
923 c---------------------------------------------------------------
924 rij_shift=1.0D0/rij_shift
926 e1=fac*fac*aa(itypi,itypj)
927 e2=fac*bb(itypi,itypj)
928 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
929 eps2der=evdwij*eps3rt
930 eps3der=evdwij*eps2rt
931 evdwij=evdwij*eps2rt*eps3rt
932 if (bb(itypi,itypj).gt.0) then
937 ij=icant(itypi,itypj)
938 aux=eps1*eps2rt**2*eps3rt**2
939 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
940 & /dabs(eps(itypi,itypj))
941 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
942 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
943 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
944 c & aux*e2/eps(itypi,itypj)
945 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
947 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
948 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
949 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
950 & restyp(itypi),i,restyp(itypj),j,
951 & epsi,sigm,chi1,chi2,chip1,chip2,
952 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
953 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
957 C Calculate gradient components.
958 e1=e1*eps1*eps2rt**2*eps3rt**2
959 fac=-expon*(e1+evdwij)*rij_shift
962 C Calculate the radial part of the gradient
966 C Calculate angular part of the gradient.
975 C-----------------------------------------------------------------------------
976 subroutine egbv(evdw,evdw_t)
978 C This subroutine calculates the interaction energy of nonbonded side chains
979 C assuming the Gay-Berne-Vorobjev potential of interaction.
981 implicit real*8 (a-h,o-z)
983 include 'DIMENSIONS.ZSCOPT'
984 include "DIMENSIONS.COMPAR"
987 include 'COMMON.LOCAL'
988 include 'COMMON.CHAIN'
989 include 'COMMON.DERIV'
990 include 'COMMON.NAMES'
991 include 'COMMON.INTERACT'
992 include 'COMMON.ENEPS'
993 include 'COMMON.IOUNITS'
994 include 'COMMON.CALC'
1001 eneps_temp(j,i)=0.0d0
1006 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1009 c if (icall.gt.0) lprn=.true.
1011 do i=iatsc_s,iatsc_e
1017 dxi=dc_norm(1,nres+i)
1018 dyi=dc_norm(2,nres+i)
1019 dzi=dc_norm(3,nres+i)
1020 dsci_inv=vbld_inv(i+nres)
1022 C Calculate SC interaction energy.
1024 do iint=1,nint_gr(i)
1025 do j=istart(i,iint),iend(i,iint)
1028 dscj_inv=vbld_inv(j+nres)
1029 sig0ij=sigma(itypi,itypj)
1030 r0ij=r0(itypi,itypj)
1031 chi1=chi(itypi,itypj)
1032 chi2=chi(itypj,itypi)
1039 alf12=0.5D0*(alf1+alf2)
1040 C For diagnostics only!!!
1053 dxj=dc_norm(1,nres+j)
1054 dyj=dc_norm(2,nres+j)
1055 dzj=dc_norm(3,nres+j)
1056 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1058 C Calculate angle-dependent terms of energy and contributions to their
1062 sig=sig0ij*dsqrt(sigsq)
1063 rij_shift=1.0D0/rij-sig+r0ij
1064 C I hate to put IF's in the loops, but here don't have another choice!!!!
1065 if (rij_shift.le.0.0D0) then
1070 c---------------------------------------------------------------
1071 rij_shift=1.0D0/rij_shift
1072 fac=rij_shift**expon
1073 e1=fac*fac*aa(itypi,itypj)
1074 e2=fac*bb(itypi,itypj)
1075 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1076 eps2der=evdwij*eps3rt
1077 eps3der=evdwij*eps2rt
1078 fac_augm=rrij**expon
1079 e_augm=augm(itypi,itypj)*fac_augm
1080 evdwij=evdwij*eps2rt*eps3rt
1081 if (bb(itypi,itypj).gt.0.0d0) then
1082 evdw=evdw+evdwij+e_augm
1084 evdw_t=evdw_t+evdwij+e_augm
1086 ij=icant(itypi,itypj)
1087 aux=eps1*eps2rt**2*eps3rt**2
1088 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1089 & /dabs(eps(itypi,itypj))
1090 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1091 c eneps_temp(ij)=eneps_temp(ij)
1092 c & +(evdwij+e_augm)/eps(itypi,itypj)
1094 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1097 c & restyp(itypi),i,restyp(itypj),j,
1098 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1099 c & chi1,chi2,chip1,chip2,
1100 c & eps1,eps2rt**2,eps3rt**2,
1101 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1105 C Calculate gradient components.
1106 e1=e1*eps1*eps2rt**2*eps3rt**2
1107 fac=-expon*(e1+evdwij)*rij_shift
1109 fac=rij*fac-2*expon*rrij*e_augm
1110 C Calculate the radial part of the gradient
1114 C Calculate angular part of the gradient.
1122 C-----------------------------------------------------------------------------
1123 subroutine sc_angular
1124 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1125 C om12. Called by ebp, egb, and egbv.
1127 include 'COMMON.CALC'
1131 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1132 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1133 om12=dxi*dxj+dyi*dyj+dzi*dzj
1135 C Calculate eps1(om12) and its derivative in om12
1136 faceps1=1.0D0-om12*chiom12
1137 faceps1_inv=1.0D0/faceps1
1138 eps1=dsqrt(faceps1_inv)
1139 C Following variable is eps1*deps1/dom12
1140 eps1_om12=faceps1_inv*chiom12
1141 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1146 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1147 sigsq=1.0D0-facsig*faceps1_inv
1148 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1149 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1150 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1151 C Calculate eps2 and its derivatives in om1, om2, and om12.
1154 chipom12=chip12*om12
1155 facp=1.0D0-om12*chipom12
1157 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1158 C Following variable is the square root of eps2
1159 eps2rt=1.0D0-facp1*facp_inv
1160 C Following three variables are the derivatives of the square root of eps
1161 C in om1, om2, and om12.
1162 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1163 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1164 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1165 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1166 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1167 C Calculate whole angle-dependent part of epsilon and contributions
1168 C to its derivatives
1171 C----------------------------------------------------------------------------
1173 implicit real*8 (a-h,o-z)
1174 include 'DIMENSIONS'
1175 include 'DIMENSIONS.ZSCOPT'
1176 include 'COMMON.CHAIN'
1177 include 'COMMON.DERIV'
1178 include 'COMMON.CALC'
1179 double precision dcosom1(3),dcosom2(3)
1180 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1181 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1182 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1183 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1185 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1186 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1189 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1193 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1194 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1195 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1196 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1197 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1200 C Calculate the components of the gradient in DC and X
1204 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1209 c------------------------------------------------------------------------------
1210 subroutine vec_and_deriv
1211 implicit real*8 (a-h,o-z)
1212 include 'DIMENSIONS'
1213 include 'DIMENSIONS.ZSCOPT'
1214 include 'COMMON.IOUNITS'
1215 include 'COMMON.GEO'
1216 include 'COMMON.VAR'
1217 include 'COMMON.LOCAL'
1218 include 'COMMON.CHAIN'
1219 include 'COMMON.VECTORS'
1220 include 'COMMON.DERIV'
1221 include 'COMMON.INTERACT'
1222 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1223 C Compute the local reference systems. For reference system (i), the
1224 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1225 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1227 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1228 if (i.eq.nres-1) then
1229 C Case of the last full residue
1230 C Compute the Z-axis
1231 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1232 costh=dcos(pi-theta(nres))
1233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1238 C Compute the derivatives of uz
1240 uzder(2,1,1)=-dc_norm(3,i-1)
1241 uzder(3,1,1)= dc_norm(2,i-1)
1242 uzder(1,2,1)= dc_norm(3,i-1)
1244 uzder(3,2,1)=-dc_norm(1,i-1)
1245 uzder(1,3,1)=-dc_norm(2,i-1)
1246 uzder(2,3,1)= dc_norm(1,i-1)
1249 uzder(2,1,2)= dc_norm(3,i)
1250 uzder(3,1,2)=-dc_norm(2,i)
1251 uzder(1,2,2)=-dc_norm(3,i)
1253 uzder(3,2,2)= dc_norm(1,i)
1254 uzder(1,3,2)= dc_norm(2,i)
1255 uzder(2,3,2)=-dc_norm(1,i)
1258 C Compute the Y-axis
1261 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1264 C Compute the derivatives of uy
1267 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1268 & -dc_norm(k,i)*dc_norm(j,i-1)
1269 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1271 uyder(j,j,1)=uyder(j,j,1)-costh
1272 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1277 uygrad(l,k,j,i)=uyder(l,k,j)
1278 uzgrad(l,k,j,i)=uzder(l,k,j)
1282 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1283 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1284 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1285 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1289 C Compute the Z-axis
1290 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1291 costh=dcos(pi-theta(i+2))
1292 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1297 C Compute the derivatives of uz
1299 uzder(2,1,1)=-dc_norm(3,i+1)
1300 uzder(3,1,1)= dc_norm(2,i+1)
1301 uzder(1,2,1)= dc_norm(3,i+1)
1303 uzder(3,2,1)=-dc_norm(1,i+1)
1304 uzder(1,3,1)=-dc_norm(2,i+1)
1305 uzder(2,3,1)= dc_norm(1,i+1)
1308 uzder(2,1,2)= dc_norm(3,i)
1309 uzder(3,1,2)=-dc_norm(2,i)
1310 uzder(1,2,2)=-dc_norm(3,i)
1312 uzder(3,2,2)= dc_norm(1,i)
1313 uzder(1,3,2)= dc_norm(2,i)
1314 uzder(2,3,2)=-dc_norm(1,i)
1317 C Compute the Y-axis
1320 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1323 C Compute the derivatives of uy
1326 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1327 & -dc_norm(k,i)*dc_norm(j,i+1)
1328 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1330 uyder(j,j,1)=uyder(j,j,1)-costh
1331 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1336 uygrad(l,k,j,i)=uyder(l,k,j)
1337 uzgrad(l,k,j,i)=uzder(l,k,j)
1341 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1342 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1343 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1344 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1350 vbld_inv_temp(1)=vbld_inv(i+1)
1351 if (i.lt.nres-1) then
1352 vbld_inv_temp(2)=vbld_inv(i+2)
1354 vbld_inv_temp(2)=vbld_inv(i)
1359 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1360 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1368 C-----------------------------------------------------------------------------
1369 subroutine vec_and_deriv_test
1370 implicit real*8 (a-h,o-z)
1371 include 'DIMENSIONS'
1372 include 'DIMENSIONS.ZSCOPT'
1373 include 'COMMON.IOUNITS'
1374 include 'COMMON.GEO'
1375 include 'COMMON.VAR'
1376 include 'COMMON.LOCAL'
1377 include 'COMMON.CHAIN'
1378 include 'COMMON.VECTORS'
1379 dimension uyder(3,3,2),uzder(3,3,2)
1380 C Compute the local reference systems. For reference system (i), the
1381 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1382 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1384 if (i.eq.nres-1) then
1385 C Case of the last full residue
1386 C Compute the Z-axis
1387 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1388 costh=dcos(pi-theta(nres))
1389 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1390 c write (iout,*) 'fac',fac,
1391 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1392 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1396 C Compute the derivatives of uz
1398 uzder(2,1,1)=-dc_norm(3,i-1)
1399 uzder(3,1,1)= dc_norm(2,i-1)
1400 uzder(1,2,1)= dc_norm(3,i-1)
1402 uzder(3,2,1)=-dc_norm(1,i-1)
1403 uzder(1,3,1)=-dc_norm(2,i-1)
1404 uzder(2,3,1)= dc_norm(1,i-1)
1407 uzder(2,1,2)= dc_norm(3,i)
1408 uzder(3,1,2)=-dc_norm(2,i)
1409 uzder(1,2,2)=-dc_norm(3,i)
1411 uzder(3,2,2)= dc_norm(1,i)
1412 uzder(1,3,2)= dc_norm(2,i)
1413 uzder(2,3,2)=-dc_norm(1,i)
1415 C Compute the Y-axis
1417 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1420 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1421 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1422 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1424 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1427 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1428 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1431 c write (iout,*) 'facy',facy,
1432 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1433 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1435 uy(k,i)=facy*uy(k,i)
1437 C Compute the derivatives of uy
1440 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1441 & -dc_norm(k,i)*dc_norm(j,i-1)
1442 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1444 c uyder(j,j,1)=uyder(j,j,1)-costh
1445 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1446 uyder(j,j,1)=uyder(j,j,1)
1447 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1448 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1454 uygrad(l,k,j,i)=uyder(l,k,j)
1455 uzgrad(l,k,j,i)=uzder(l,k,j)
1459 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1460 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1461 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1462 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1465 C Compute the Z-axis
1466 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1467 costh=dcos(pi-theta(i+2))
1468 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1469 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1473 C Compute the derivatives of uz
1475 uzder(2,1,1)=-dc_norm(3,i+1)
1476 uzder(3,1,1)= dc_norm(2,i+1)
1477 uzder(1,2,1)= dc_norm(3,i+1)
1479 uzder(3,2,1)=-dc_norm(1,i+1)
1480 uzder(1,3,1)=-dc_norm(2,i+1)
1481 uzder(2,3,1)= dc_norm(1,i+1)
1484 uzder(2,1,2)= dc_norm(3,i)
1485 uzder(3,1,2)=-dc_norm(2,i)
1486 uzder(1,2,2)=-dc_norm(3,i)
1488 uzder(3,2,2)= dc_norm(1,i)
1489 uzder(1,3,2)= dc_norm(2,i)
1490 uzder(2,3,2)=-dc_norm(1,i)
1492 C Compute the Y-axis
1494 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1495 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1496 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1498 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1501 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1502 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1505 c write (iout,*) 'facy',facy,
1506 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1507 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1509 uy(k,i)=facy*uy(k,i)
1511 C Compute the derivatives of uy
1514 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1515 & -dc_norm(k,i)*dc_norm(j,i+1)
1516 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1518 c uyder(j,j,1)=uyder(j,j,1)-costh
1519 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1520 uyder(j,j,1)=uyder(j,j,1)
1521 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1522 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1528 uygrad(l,k,j,i)=uyder(l,k,j)
1529 uzgrad(l,k,j,i)=uzder(l,k,j)
1533 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1534 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1535 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1536 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1543 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1544 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1551 C-----------------------------------------------------------------------------
1552 subroutine check_vecgrad
1553 implicit real*8 (a-h,o-z)
1554 include 'DIMENSIONS'
1555 include 'DIMENSIONS.ZSCOPT'
1556 include 'COMMON.IOUNITS'
1557 include 'COMMON.GEO'
1558 include 'COMMON.VAR'
1559 include 'COMMON.LOCAL'
1560 include 'COMMON.CHAIN'
1561 include 'COMMON.VECTORS'
1562 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1563 dimension uyt(3,maxres),uzt(3,maxres)
1564 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1565 double precision delta /1.0d-7/
1568 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1569 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1570 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1571 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1572 cd & (dc_norm(if90,i),if90=1,3)
1573 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1574 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1575 cd write(iout,'(a)')
1581 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1582 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1595 cd write (iout,*) 'i=',i
1597 erij(k)=dc_norm(k,i)
1601 dc_norm(k,i)=erij(k)
1603 dc_norm(j,i)=dc_norm(j,i)+delta
1604 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1606 c dc_norm(k,i)=dc_norm(k,i)/fac
1608 c write (iout,*) (dc_norm(k,i),k=1,3)
1609 c write (iout,*) (erij(k),k=1,3)
1612 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1613 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1614 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1615 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1617 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1618 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1619 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1622 dc_norm(k,i)=erij(k)
1625 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1626 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1627 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1628 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1629 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1630 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1631 cd write (iout,'(a)')
1636 C--------------------------------------------------------------------------
1637 subroutine set_matrices
1638 implicit real*8 (a-h,o-z)
1639 include 'DIMENSIONS'
1640 include 'DIMENSIONS.ZSCOPT'
1641 include 'COMMON.IOUNITS'
1642 include 'COMMON.GEO'
1643 include 'COMMON.VAR'
1644 include 'COMMON.LOCAL'
1645 include 'COMMON.CHAIN'
1646 include 'COMMON.DERIV'
1647 include 'COMMON.INTERACT'
1648 include 'COMMON.CONTACTS'
1649 include 'COMMON.TORSION'
1650 include 'COMMON.VECTORS'
1651 include 'COMMON.FFIELD'
1652 double precision auxvec(2),auxmat(2,2)
1654 C Compute the virtual-bond-torsional-angle dependent quantities needed
1655 C to calculate the el-loc multibody terms of various order.
1658 if (i .lt. nres+1) then
1695 if (i .gt. 3 .and. i .lt. nres+1) then
1696 obrot_der(1,i-2)=-sin1
1697 obrot_der(2,i-2)= cos1
1698 Ugder(1,1,i-2)= sin1
1699 Ugder(1,2,i-2)=-cos1
1700 Ugder(2,1,i-2)=-cos1
1701 Ugder(2,2,i-2)=-sin1
1704 obrot2_der(1,i-2)=-dwasin2
1705 obrot2_der(2,i-2)= dwacos2
1706 Ug2der(1,1,i-2)= dwasin2
1707 Ug2der(1,2,i-2)=-dwacos2
1708 Ug2der(2,1,i-2)=-dwacos2
1709 Ug2der(2,2,i-2)=-dwasin2
1711 obrot_der(1,i-2)=0.0d0
1712 obrot_der(2,i-2)=0.0d0
1713 Ugder(1,1,i-2)=0.0d0
1714 Ugder(1,2,i-2)=0.0d0
1715 Ugder(2,1,i-2)=0.0d0
1716 Ugder(2,2,i-2)=0.0d0
1717 obrot2_der(1,i-2)=0.0d0
1718 obrot2_der(2,i-2)=0.0d0
1719 Ug2der(1,1,i-2)=0.0d0
1720 Ug2der(1,2,i-2)=0.0d0
1721 Ug2der(2,1,i-2)=0.0d0
1722 Ug2der(2,2,i-2)=0.0d0
1724 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1725 iti = itortyp(itype(i-2))
1729 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1730 iti1 = itortyp(itype(i-1))
1734 cd write (iout,*) '*******i',i,' iti1',iti
1735 cd write (iout,*) 'b1',b1(:,iti)
1736 cd write (iout,*) 'b2',b2(:,iti)
1737 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1738 if (i .gt. iatel_s+2) then
1739 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1740 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1741 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1742 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1743 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1744 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1745 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1755 DtUg2(l,k,i-2)=0.0d0
1759 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1760 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1761 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1762 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1763 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1764 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1765 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1767 muder(k,i-2)=Ub2der(k,i-2)
1769 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1770 iti1 = itortyp(itype(i-1))
1775 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1777 C Vectors and matrices dependent on a single virtual-bond dihedral.
1778 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1779 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1780 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1781 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1782 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1783 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1784 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1785 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1786 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1787 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1788 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1790 C Matrices dependent on two consecutive virtual-bond dihedrals.
1791 C The order of matrices is from left to right.
1793 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1794 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1795 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1796 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1797 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1798 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1799 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1800 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1803 cd iti = itortyp(itype(i))
1806 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1807 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1812 C--------------------------------------------------------------------------
1813 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1815 C This subroutine calculates the average interaction energy and its gradient
1816 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1817 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1818 C The potential depends both on the distance of peptide-group centers and on
1819 C the orientation of the CA-CA virtual bonds.
1821 implicit real*8 (a-h,o-z)
1822 include 'DIMENSIONS'
1823 include 'DIMENSIONS.ZSCOPT'
1824 include 'DIMENSIONS.FREE'
1825 include 'COMMON.CONTROL'
1826 include 'COMMON.IOUNITS'
1827 include 'COMMON.GEO'
1828 include 'COMMON.VAR'
1829 include 'COMMON.LOCAL'
1830 include 'COMMON.CHAIN'
1831 include 'COMMON.DERIV'
1832 include 'COMMON.INTERACT'
1833 include 'COMMON.CONTACTS'
1834 include 'COMMON.TORSION'
1835 include 'COMMON.VECTORS'
1836 include 'COMMON.FFIELD'
1837 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1838 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1839 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1840 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1841 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1842 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1843 double precision scal_el /0.5d0/
1845 C 13-go grudnia roku pamietnego...
1846 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1847 & 0.0d0,1.0d0,0.0d0,
1848 & 0.0d0,0.0d0,1.0d0/
1849 cd write(iout,*) 'In EELEC'
1851 cd write(iout,*) 'Type',i
1852 cd write(iout,*) 'B1',B1(:,i)
1853 cd write(iout,*) 'B2',B2(:,i)
1854 cd write(iout,*) 'CC',CC(:,:,i)
1855 cd write(iout,*) 'DD',DD(:,:,i)
1856 cd write(iout,*) 'EE',EE(:,:,i)
1858 cd call check_vecgrad
1860 if (icheckgrad.eq.1) then
1862 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1864 dc_norm(k,i)=dc(k,i)*fac
1866 c write (iout,*) 'i',i,' fac',fac
1869 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1870 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1871 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1872 cd if (wel_loc.gt.0.0d0) then
1873 if (icheckgrad.eq.1) then
1874 call vec_and_deriv_test
1881 cd write (iout,*) 'i=',i
1883 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1886 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1887 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1900 cd print '(a)','Enter EELEC'
1901 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1903 gel_loc_loc(i)=0.0d0
1906 do i=iatel_s,iatel_e
1907 if (itel(i).eq.0) goto 1215
1911 dx_normi=dc_norm(1,i)
1912 dy_normi=dc_norm(2,i)
1913 dz_normi=dc_norm(3,i)
1914 xmedi=c(1,i)+0.5d0*dxi
1915 ymedi=c(2,i)+0.5d0*dyi
1916 zmedi=c(3,i)+0.5d0*dzi
1918 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1919 do j=ielstart(i),ielend(i)
1920 if (itel(j).eq.0) goto 1216
1924 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1925 aaa=app(iteli,itelj)
1926 bbb=bpp(iteli,itelj)
1927 C Diagnostics only!!!
1933 ael6i=ael6(iteli,itelj)
1934 ael3i=ael3(iteli,itelj)
1938 dx_normj=dc_norm(1,j)
1939 dy_normj=dc_norm(2,j)
1940 dz_normj=dc_norm(3,j)
1941 xj=c(1,j)+0.5D0*dxj-xmedi
1942 yj=c(2,j)+0.5D0*dyj-ymedi
1943 zj=c(3,j)+0.5D0*dzj-zmedi
1944 rij=xj*xj+yj*yj+zj*zj
1950 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1951 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1952 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1953 fac=cosa-3.0D0*cosb*cosg
1955 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1956 if (j.eq.i+2) ev1=scal_el*ev1
1961 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1964 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1965 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1966 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1969 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1970 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1971 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1972 cd & xmedi,ymedi,zmedi,xj,yj,zj
1974 C Calculate contributions to the Cartesian gradient.
1977 facvdw=-6*rrmij*(ev1+evdwij)
1978 facel=-3*rrmij*(el1+eesij)
1985 * Radial derivatives. First process both termini of the fragment (i,j)
1992 gelc(k,i)=gelc(k,i)+ghalf
1993 gelc(k,j)=gelc(k,j)+ghalf
1996 * Loop over residues i+1 thru j-1.
2000 gelc(l,k)=gelc(l,k)+ggg(l)
2008 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2009 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2012 * Loop over residues i+1 thru j-1.
2016 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2023 fac=-3*rrmij*(facvdw+facvdw+facel)
2029 * Radial derivatives. First process both termini of the fragment (i,j)
2036 gelc(k,i)=gelc(k,i)+ghalf
2037 gelc(k,j)=gelc(k,j)+ghalf
2040 * Loop over residues i+1 thru j-1.
2044 gelc(l,k)=gelc(l,k)+ggg(l)
2051 ecosa=2.0D0*fac3*fac1+fac4
2054 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2055 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2057 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2058 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2060 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2061 cd & (dcosg(k),k=1,3)
2063 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2067 gelc(k,i)=gelc(k,i)+ghalf
2068 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2069 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2070 gelc(k,j)=gelc(k,j)+ghalf
2071 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2072 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2076 gelc(l,k)=gelc(l,k)+ggg(l)
2081 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2082 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2083 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2085 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2086 C energy of a peptide unit is assumed in the form of a second-order
2087 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2088 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2089 C are computed for EVERY pair of non-contiguous peptide groups.
2091 if (j.lt.nres-1) then
2102 muij(kkk)=mu(k,i)*mu(l,j)
2105 cd write (iout,*) 'EELEC: i',i,' j',j
2106 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2107 cd write(iout,*) 'muij',muij
2108 ury=scalar(uy(1,i),erij)
2109 urz=scalar(uz(1,i),erij)
2110 vry=scalar(uy(1,j),erij)
2111 vrz=scalar(uz(1,j),erij)
2112 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2113 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2114 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2115 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2116 C For diagnostics only
2121 fac=dsqrt(-ael6i)*r3ij
2122 cd write (2,*) 'fac=',fac
2123 C For diagnostics only
2129 cd write (iout,'(4i5,4f10.5)')
2130 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2131 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2132 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2133 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2134 cd write (iout,'(4f10.5)')
2135 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2136 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2137 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2138 cd write (iout,'(2i3,9f10.5/)') i,j,
2139 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2141 C Derivatives of the elements of A in virtual-bond vectors
2142 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2149 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2150 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2151 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2152 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2153 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2154 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2155 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2156 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2157 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2158 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2159 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2160 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2170 C Compute radial contributions to the gradient
2192 C Add the contributions coming from er
2195 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2196 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2197 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2198 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2201 C Derivatives in DC(i)
2202 ghalf1=0.5d0*agg(k,1)
2203 ghalf2=0.5d0*agg(k,2)
2204 ghalf3=0.5d0*agg(k,3)
2205 ghalf4=0.5d0*agg(k,4)
2206 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2207 & -3.0d0*uryg(k,2)*vry)+ghalf1
2208 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2209 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2210 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2211 & -3.0d0*urzg(k,2)*vry)+ghalf3
2212 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2213 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2214 C Derivatives in DC(i+1)
2215 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2216 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2217 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2218 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2219 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2220 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2221 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2222 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2223 C Derivatives in DC(j)
2224 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2225 & -3.0d0*vryg(k,2)*ury)+ghalf1
2226 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2227 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2228 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2229 & -3.0d0*vryg(k,2)*urz)+ghalf3
2230 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2231 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2232 C Derivatives in DC(j+1) or DC(nres-1)
2233 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2234 & -3.0d0*vryg(k,3)*ury)
2235 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2236 & -3.0d0*vrzg(k,3)*ury)
2237 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2238 & -3.0d0*vryg(k,3)*urz)
2239 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2240 & -3.0d0*vrzg(k,3)*urz)
2245 C Derivatives in DC(i+1)
2246 cd aggi1(k,1)=agg(k,1)
2247 cd aggi1(k,2)=agg(k,2)
2248 cd aggi1(k,3)=agg(k,3)
2249 cd aggi1(k,4)=agg(k,4)
2250 C Derivatives in DC(j)
2255 C Derivatives in DC(j+1)
2260 if (j.eq.nres-1 .and. i.lt.j-2) then
2262 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2263 cd aggj1(k,l)=agg(k,l)
2269 C Check the loc-el terms by numerical integration
2279 aggi(k,l)=-aggi(k,l)
2280 aggi1(k,l)=-aggi1(k,l)
2281 aggj(k,l)=-aggj(k,l)
2282 aggj1(k,l)=-aggj1(k,l)
2285 if (j.lt.nres-1) then
2291 aggi(k,l)=-aggi(k,l)
2292 aggi1(k,l)=-aggi1(k,l)
2293 aggj(k,l)=-aggj(k,l)
2294 aggj1(k,l)=-aggj1(k,l)
2305 aggi(k,l)=-aggi(k,l)
2306 aggi1(k,l)=-aggi1(k,l)
2307 aggj(k,l)=-aggj(k,l)
2308 aggj1(k,l)=-aggj1(k,l)
2314 IF (wel_loc.gt.0.0d0) THEN
2315 C Contribution to the local-electrostatic energy coming from the i-j pair
2316 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2318 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2319 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2320 eel_loc=eel_loc+eel_loc_ij
2321 C Partial derivatives in virtual-bond dihedral angles gamma
2324 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2325 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2326 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2327 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2328 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2329 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2330 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2331 cd write(iout,*) 'agg ',agg
2332 cd write(iout,*) 'aggi ',aggi
2333 cd write(iout,*) 'aggi1',aggi1
2334 cd write(iout,*) 'aggj ',aggj
2335 cd write(iout,*) 'aggj1',aggj1
2337 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2339 ggg(l)=agg(l,1)*muij(1)+
2340 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2344 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2347 C Remaining derivatives of eello
2349 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2350 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2351 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2352 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2353 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2354 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2355 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2356 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2360 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2361 C Contributions from turns
2366 call eturn34(i,j,eello_turn3,eello_turn4)
2368 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2369 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2371 C Calculate the contact function. The ith column of the array JCONT will
2372 C contain the numbers of atoms that make contacts with the atom I (of numbers
2373 C greater than I). The arrays FACONT and GACONT will contain the values of
2374 C the contact function and its derivative.
2375 c r0ij=1.02D0*rpp(iteli,itelj)
2376 c r0ij=1.11D0*rpp(iteli,itelj)
2377 r0ij=2.20D0*rpp(iteli,itelj)
2378 c r0ij=1.55D0*rpp(iteli,itelj)
2379 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2380 if (fcont.gt.0.0D0) then
2381 num_conti=num_conti+1
2382 if (num_conti.gt.maxconts) then
2383 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2384 & ' will skip next contacts for this conf.'
2386 jcont_hb(num_conti,i)=j
2387 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2388 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2389 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2391 d_cont(num_conti,i)=rij
2392 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2393 C --- Electrostatic-interaction matrix ---
2394 a_chuj(1,1,num_conti,i)=a22
2395 a_chuj(1,2,num_conti,i)=a23
2396 a_chuj(2,1,num_conti,i)=a32
2397 a_chuj(2,2,num_conti,i)=a33
2398 C --- Gradient of rij
2400 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2403 c a_chuj(1,1,num_conti,i)=-0.61d0
2404 c a_chuj(1,2,num_conti,i)= 0.4d0
2405 c a_chuj(2,1,num_conti,i)= 0.65d0
2406 c a_chuj(2,2,num_conti,i)= 0.50d0
2407 c else if (i.eq.2) then
2408 c a_chuj(1,1,num_conti,i)= 0.0d0
2409 c a_chuj(1,2,num_conti,i)= 0.0d0
2410 c a_chuj(2,1,num_conti,i)= 0.0d0
2411 c a_chuj(2,2,num_conti,i)= 0.0d0
2413 C --- and its gradients
2414 cd write (iout,*) 'i',i,' j',j
2416 cd write (iout,*) 'iii 1 kkk',kkk
2417 cd write (iout,*) agg(kkk,:)
2420 cd write (iout,*) 'iii 2 kkk',kkk
2421 cd write (iout,*) aggi(kkk,:)
2424 cd write (iout,*) 'iii 3 kkk',kkk
2425 cd write (iout,*) aggi1(kkk,:)
2428 cd write (iout,*) 'iii 4 kkk',kkk
2429 cd write (iout,*) aggj(kkk,:)
2432 cd write (iout,*) 'iii 5 kkk',kkk
2433 cd write (iout,*) aggj1(kkk,:)
2440 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2441 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2442 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2443 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2444 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2446 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2452 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2453 C Calculate contact energies
2455 wij=cosa-3.0D0*cosb*cosg
2458 c fac3=dsqrt(-ael6i)/r0ij**3
2459 fac3=dsqrt(-ael6i)*r3ij
2460 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2461 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2463 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2464 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2465 C Diagnostics. Comment out or remove after debugging!
2466 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2467 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2468 c ees0m(num_conti,i)=0.0D0
2470 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2471 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2472 facont_hb(num_conti,i)=fcont
2474 C Angular derivatives of the contact function
2475 ees0pij1=fac3/ees0pij
2476 ees0mij1=fac3/ees0mij
2477 fac3p=-3.0D0*fac3*rrmij
2478 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2479 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2481 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2482 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2483 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2484 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2485 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2486 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2487 ecosap=ecosa1+ecosa2
2488 ecosbp=ecosb1+ecosb2
2489 ecosgp=ecosg1+ecosg2
2490 ecosam=ecosa1-ecosa2
2491 ecosbm=ecosb1-ecosb2
2492 ecosgm=ecosg1-ecosg2
2501 fprimcont=fprimcont/rij
2502 cd facont_hb(num_conti,i)=1.0D0
2503 C Following line is for diagnostics.
2506 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2507 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2510 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2511 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2513 gggp(1)=gggp(1)+ees0pijp*xj
2514 gggp(2)=gggp(2)+ees0pijp*yj
2515 gggp(3)=gggp(3)+ees0pijp*zj
2516 gggm(1)=gggm(1)+ees0mijp*xj
2517 gggm(2)=gggm(2)+ees0mijp*yj
2518 gggm(3)=gggm(3)+ees0mijp*zj
2519 C Derivatives due to the contact function
2520 gacont_hbr(1,num_conti,i)=fprimcont*xj
2521 gacont_hbr(2,num_conti,i)=fprimcont*yj
2522 gacont_hbr(3,num_conti,i)=fprimcont*zj
2524 ghalfp=0.5D0*gggp(k)
2525 ghalfm=0.5D0*gggm(k)
2526 gacontp_hb1(k,num_conti,i)=ghalfp
2527 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2528 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2529 gacontp_hb2(k,num_conti,i)=ghalfp
2530 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2531 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2532 gacontp_hb3(k,num_conti,i)=gggp(k)
2533 gacontm_hb1(k,num_conti,i)=ghalfm
2534 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2535 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2536 gacontm_hb2(k,num_conti,i)=ghalfm
2537 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2538 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2539 gacontm_hb3(k,num_conti,i)=gggm(k)
2542 C Diagnostics. Comment out or remove after debugging!
2544 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2545 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2546 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2547 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2548 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2549 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2552 endif ! num_conti.le.maxconts
2557 num_cont_hb(i)=num_conti
2561 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2562 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2564 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2565 ccc eel_loc=eel_loc+eello_turn3
2568 C-----------------------------------------------------------------------------
2569 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2570 C Third- and fourth-order contributions from turns
2571 implicit real*8 (a-h,o-z)
2572 include 'DIMENSIONS'
2573 include 'DIMENSIONS.ZSCOPT'
2574 include 'COMMON.IOUNITS'
2575 include 'COMMON.GEO'
2576 include 'COMMON.VAR'
2577 include 'COMMON.LOCAL'
2578 include 'COMMON.CHAIN'
2579 include 'COMMON.DERIV'
2580 include 'COMMON.INTERACT'
2581 include 'COMMON.CONTACTS'
2582 include 'COMMON.TORSION'
2583 include 'COMMON.VECTORS'
2584 include 'COMMON.FFIELD'
2586 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2587 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2588 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2589 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2590 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2591 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2595 C Third-order contributions
2602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2603 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2604 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2605 call transpose2(auxmat(1,1),auxmat1(1,1))
2606 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2607 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2608 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2609 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2610 cd & ' eello_turn3_num',4*eello_turn3_num
2612 C Derivatives in gamma(i)
2613 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2614 call transpose2(auxmat2(1,1),pizda(1,1))
2615 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2616 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2617 C Derivatives in gamma(i+1)
2618 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2619 call transpose2(auxmat2(1,1),pizda(1,1))
2620 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2621 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2622 & +0.5d0*(pizda(1,1)+pizda(2,2))
2623 C Cartesian derivatives
2625 a_temp(1,1)=aggi(l,1)
2626 a_temp(1,2)=aggi(l,2)
2627 a_temp(2,1)=aggi(l,3)
2628 a_temp(2,2)=aggi(l,4)
2629 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2630 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2631 & +0.5d0*(pizda(1,1)+pizda(2,2))
2632 a_temp(1,1)=aggi1(l,1)
2633 a_temp(1,2)=aggi1(l,2)
2634 a_temp(2,1)=aggi1(l,3)
2635 a_temp(2,2)=aggi1(l,4)
2636 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2637 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2638 & +0.5d0*(pizda(1,1)+pizda(2,2))
2639 a_temp(1,1)=aggj(l,1)
2640 a_temp(1,2)=aggj(l,2)
2641 a_temp(2,1)=aggj(l,3)
2642 a_temp(2,2)=aggj(l,4)
2643 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2644 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2645 & +0.5d0*(pizda(1,1)+pizda(2,2))
2646 a_temp(1,1)=aggj1(l,1)
2647 a_temp(1,2)=aggj1(l,2)
2648 a_temp(2,1)=aggj1(l,3)
2649 a_temp(2,2)=aggj1(l,4)
2650 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2651 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2652 & +0.5d0*(pizda(1,1)+pizda(2,2))
2655 else if (j.eq.i+3) then
2656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2658 C Fourth-order contributions
2666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2667 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2668 iti1=itortyp(itype(i+1))
2669 iti2=itortyp(itype(i+2))
2670 iti3=itortyp(itype(i+3))
2671 call transpose2(EUg(1,1,i+1),e1t(1,1))
2672 call transpose2(Eug(1,1,i+2),e2t(1,1))
2673 call transpose2(Eug(1,1,i+3),e3t(1,1))
2674 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2675 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2676 s1=scalar2(b1(1,iti2),auxvec(1))
2677 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2678 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2679 s2=scalar2(b1(1,iti1),auxvec(1))
2680 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2681 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2683 eello_turn4=eello_turn4-(s1+s2+s3)
2684 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2685 cd & ' eello_turn4_num',8*eello_turn4_num
2686 C Derivatives in gamma(i)
2688 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2689 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2690 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2691 s1=scalar2(b1(1,iti2),auxvec(1))
2692 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2693 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2694 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2695 C Derivatives in gamma(i+1)
2696 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2697 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2698 s2=scalar2(b1(1,iti1),auxvec(1))
2699 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2700 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2702 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2703 C Derivatives in gamma(i+2)
2704 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2705 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2706 s1=scalar2(b1(1,iti2),auxvec(1))
2707 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2708 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2709 s2=scalar2(b1(1,iti1),auxvec(1))
2710 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2711 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2713 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2714 C Cartesian derivatives
2715 C Derivatives of this turn contributions in DC(i+2)
2716 if (j.lt.nres-1) then
2718 a_temp(1,1)=agg(l,1)
2719 a_temp(1,2)=agg(l,2)
2720 a_temp(2,1)=agg(l,3)
2721 a_temp(2,2)=agg(l,4)
2722 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2723 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2724 s1=scalar2(b1(1,iti2),auxvec(1))
2725 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2726 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2727 s2=scalar2(b1(1,iti1),auxvec(1))
2728 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2729 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2730 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2732 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2735 C Remaining derivatives of this turn contribution
2737 a_temp(1,1)=aggi(l,1)
2738 a_temp(1,2)=aggi(l,2)
2739 a_temp(2,1)=aggi(l,3)
2740 a_temp(2,2)=aggi(l,4)
2741 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2742 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2743 s1=scalar2(b1(1,iti2),auxvec(1))
2744 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2745 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2746 s2=scalar2(b1(1,iti1),auxvec(1))
2747 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2748 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2749 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2750 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2751 a_temp(1,1)=aggi1(l,1)
2752 a_temp(1,2)=aggi1(l,2)
2753 a_temp(2,1)=aggi1(l,3)
2754 a_temp(2,2)=aggi1(l,4)
2755 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2756 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2757 s1=scalar2(b1(1,iti2),auxvec(1))
2758 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2759 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2760 s2=scalar2(b1(1,iti1),auxvec(1))
2761 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2762 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2763 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2764 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2765 a_temp(1,1)=aggj(l,1)
2766 a_temp(1,2)=aggj(l,2)
2767 a_temp(2,1)=aggj(l,3)
2768 a_temp(2,2)=aggj(l,4)
2769 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2770 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2771 s1=scalar2(b1(1,iti2),auxvec(1))
2772 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2773 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2774 s2=scalar2(b1(1,iti1),auxvec(1))
2775 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2776 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2777 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2778 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2779 a_temp(1,1)=aggj1(l,1)
2780 a_temp(1,2)=aggj1(l,2)
2781 a_temp(2,1)=aggj1(l,3)
2782 a_temp(2,2)=aggj1(l,4)
2783 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2784 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2785 s1=scalar2(b1(1,iti2),auxvec(1))
2786 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2787 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2788 s2=scalar2(b1(1,iti1),auxvec(1))
2789 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2790 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2791 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2792 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2798 C-----------------------------------------------------------------------------
2799 subroutine vecpr(u,v,w)
2800 implicit real*8(a-h,o-z)
2801 dimension u(3),v(3),w(3)
2802 w(1)=u(2)*v(3)-u(3)*v(2)
2803 w(2)=-u(1)*v(3)+u(3)*v(1)
2804 w(3)=u(1)*v(2)-u(2)*v(1)
2807 C-----------------------------------------------------------------------------
2808 subroutine unormderiv(u,ugrad,unorm,ungrad)
2809 C This subroutine computes the derivatives of a normalized vector u, given
2810 C the derivatives computed without normalization conditions, ugrad. Returns
2813 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2814 double precision vec(3)
2815 double precision scalar
2817 c write (2,*) 'ugrad',ugrad
2820 vec(i)=scalar(ugrad(1,i),u(1))
2822 c write (2,*) 'vec',vec
2825 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2828 c write (2,*) 'ungrad',ungrad
2831 C-----------------------------------------------------------------------------
2832 subroutine escp(evdw2,evdw2_14)
2834 C This subroutine calculates the excluded-volume interaction energy between
2835 C peptide-group centers and side chains and its gradient in virtual-bond and
2836 C side-chain vectors.
2838 implicit real*8 (a-h,o-z)
2839 include 'DIMENSIONS'
2840 include 'DIMENSIONS.ZSCOPT'
2841 include 'COMMON.GEO'
2842 include 'COMMON.VAR'
2843 include 'COMMON.LOCAL'
2844 include 'COMMON.CHAIN'
2845 include 'COMMON.DERIV'
2846 include 'COMMON.INTERACT'
2847 include 'COMMON.FFIELD'
2848 include 'COMMON.IOUNITS'
2852 cd print '(a)','Enter ESCP'
2853 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2854 c & ' scal14',scal14
2855 do i=iatscp_s,iatscp_e
2857 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2858 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2859 if (iteli.eq.0) goto 1225
2860 xi=0.5D0*(c(1,i)+c(1,i+1))
2861 yi=0.5D0*(c(2,i)+c(2,i+1))
2862 zi=0.5D0*(c(3,i)+c(3,i+1))
2864 do iint=1,nscp_gr(i)
2866 do j=iscpstart(i,iint),iscpend(i,iint)
2868 C Uncomment following three lines for SC-p interactions
2872 C Uncomment following three lines for Ca-p interactions
2876 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2878 e1=fac*fac*aad(itypj,iteli)
2879 e2=fac*bad(itypj,iteli)
2880 if (iabs(j-i) .le. 2) then
2883 evdw2_14=evdw2_14+e1+e2
2886 c write (iout,*) i,j,evdwij
2890 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2892 fac=-(evdwij+e1)*rrij
2897 cd write (iout,*) 'j<i'
2898 C Uncomment following three lines for SC-p interactions
2900 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2903 cd write (iout,*) 'j>i'
2906 C Uncomment following line for SC-p interactions
2907 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2911 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2915 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2916 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2919 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2929 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2930 gradx_scp(j,i)=expon*gradx_scp(j,i)
2933 C******************************************************************************
2937 C To save time the factor EXPON has been extracted from ALL components
2938 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2941 C******************************************************************************
2944 C--------------------------------------------------------------------------
2945 subroutine edis(ehpb)
2947 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2949 implicit real*8 (a-h,o-z)
2950 include 'DIMENSIONS'
2951 include 'DIMENSIONS.FREE'
2952 include 'COMMON.SBRIDGE'
2953 include 'COMMON.CHAIN'
2954 include 'COMMON.DERIV'
2955 include 'COMMON.VAR'
2956 include 'COMMON.INTERACT'
2957 include 'COMMON.IOUNITS'
2958 include 'COMMON.CONTROL'
2961 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2962 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2963 if (link_end.eq.0) return
2964 do i=link_start,link_end
2965 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2966 C CA-CA distance used in regularization of structure.
2969 C iii and jjj point to the residues for which the distance is assigned.
2970 if (ii.gt.nres) then
2977 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2978 c & dhpb(i),dhpb1(i),forcon(i)
2979 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2980 C distance and angle dependent SS bond potential.
2981 if (.not.dyn_ss .and. i.le.nss) then
2982 C 15/02/13 CC dynamic SSbond - additional check
2983 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2984 call ssbond_ene(iii,jjj,eij)
2987 cd write (iout,*) "eij",eij
2988 else if (ii.gt.nres .and. jj.gt.nres) then
2989 c Restraints from contact prediction
2991 if (constr_dist.eq.11) then
2992 ehpb=ehpb+fordepth(i)**4.0d0
2993 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2994 fac=fordepth(i)**4.0d0
2995 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2997 if (dhpb1(i).gt.0.0d0) then
2998 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2999 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3000 c write (iout,*) "beta nmr",
3001 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3005 C Get the force constant corresponding to this distance.
3007 C Calculate the contribution to energy.
3008 ehpb=ehpb+waga*rdis*rdis
3009 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3011 C Evaluate gradient.
3014 endif !end dhpb1(i).gt.0
3015 endif !end const_dist=11
3017 ggg(j)=fac*(c(j,jj)-c(j,ii))
3020 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3021 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3024 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3025 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3028 C Calculate the distance between the two points and its difference from the
3031 C write(iout,*) "after",dd
3032 if (constr_dist.eq.11) then
3033 ehpb=ehpb+fordepth(i)**4.0d0
3034 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3035 fac=fordepth(i)**4.0d0
3036 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3037 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3038 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3039 C print *,ehpb,"tu?"
3040 C write(iout,*) ehpb,"btu?",
3041 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3042 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3043 C & ehpb,fordepth(i),dd
3045 if (dhpb1(i).gt.0.0d0) then
3046 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3047 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3048 c write (iout,*) "alph nmr",
3049 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3052 C Get the force constant corresponding to this distance.
3054 C Calculate the contribution to energy.
3055 ehpb=ehpb+waga*rdis*rdis
3056 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3058 C Evaluate gradient.
3063 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3064 cd & ' waga=',waga,' fac=',fac
3066 ggg(j)=fac*(c(j,jj)-c(j,ii))
3068 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3069 C If this is a SC-SC distance, we need to calculate the contributions to the
3070 C Cartesian gradient in the SC vectors (ghpbx).
3073 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3074 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3078 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3079 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3083 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3086 C--------------------------------------------------------------------------
3087 subroutine ssbond_ene(i,j,eij)
3089 C Calculate the distance and angle dependent SS-bond potential energy
3090 C using a free-energy function derived based on RHF/6-31G** ab initio
3091 C calculations of diethyl disulfide.
3093 C A. Liwo and U. Kozlowska, 11/24/03
3095 implicit real*8 (a-h,o-z)
3096 include 'DIMENSIONS'
3097 include 'DIMENSIONS.ZSCOPT'
3098 include 'COMMON.SBRIDGE'
3099 include 'COMMON.CHAIN'
3100 include 'COMMON.DERIV'
3101 include 'COMMON.LOCAL'
3102 include 'COMMON.INTERACT'
3103 include 'COMMON.VAR'
3104 include 'COMMON.IOUNITS'
3105 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3110 dxi=dc_norm(1,nres+i)
3111 dyi=dc_norm(2,nres+i)
3112 dzi=dc_norm(3,nres+i)
3113 dsci_inv=dsc_inv(itypi)
3115 dscj_inv=dsc_inv(itypj)
3119 dxj=dc_norm(1,nres+j)
3120 dyj=dc_norm(2,nres+j)
3121 dzj=dc_norm(3,nres+j)
3122 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3127 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3128 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3129 om12=dxi*dxj+dyi*dyj+dzi*dzj
3131 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3132 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3138 deltat12=om2-om1+2.0d0
3140 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3141 & +akct*deltad*deltat12+ebr
3142 c & +akct*deltad*deltat12
3143 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3144 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3145 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3146 & " deltat12",deltat12," eij",eij,"ebr",ebr
3147 ed=2*akcm*deltad+akct*deltat12
3149 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3150 eom1=-2*akth*deltat1-pom1-om2*pom2
3151 eom2= 2*akth*deltat2+pom1-om1*pom2
3154 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3157 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3158 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3159 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3160 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3163 C Calculate the components of the gradient in DC and X
3167 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3172 C--------------------------------------------------------------------------
3173 c MODELLER restraint function
3174 subroutine e_modeller(ehomology_constr)
3175 implicit real*8 (a-h,o-z)
3176 include 'DIMENSIONS'
3177 include 'DIMENSIONS.ZSCOPT'
3178 include 'DIMENSIONS.FREE'
3179 integer nnn, i, j, k, ki, irec, l
3180 integer katy, odleglosci, test7
3181 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3182 real*8 distance(max_template),distancek(max_template),
3183 & min_odl,godl(max_template),dih_diff(max_template)
3186 c FP - 30/10/2014 Temporary specifications for homology restraints
3188 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3190 double precision, dimension (maxres) :: guscdiff,usc_diff
3191 double precision, dimension (max_template) ::
3192 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3195 include 'COMMON.SBRIDGE'
3196 include 'COMMON.CHAIN'
3197 include 'COMMON.GEO'
3198 include 'COMMON.DERIV'
3199 include 'COMMON.LOCAL'
3200 include 'COMMON.INTERACT'
3201 include 'COMMON.VAR'
3202 include 'COMMON.IOUNITS'
3203 include 'COMMON.CONTROL'
3204 include 'COMMON.HOMRESTR'
3206 include 'COMMON.SETUP'
3207 include 'COMMON.NAMES'
3210 distancek(i)=9999999.9
3215 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3217 C AL 5/2/14 - Introduce list of restraints
3218 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3220 write(iout,*) "------- dist restrs start -------"
3222 do ii = link_start_homo,link_end_homo
3226 c write (iout,*) "dij(",i,j,") =",dij
3228 do k=1,constr_homology
3229 if(.not.l_homo(k,ii)) then
3233 distance(k)=odl(k,ii)-dij
3234 c write (iout,*) "distance(",k,") =",distance(k)
3236 c For Gaussian-type Urestr
3238 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3239 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3240 c write (iout,*) "distancek(",k,") =",distancek(k)
3241 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3243 c For Lorentzian-type Urestr
3245 if (waga_dist.lt.0.0d0) then
3246 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3247 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3248 & (distance(k)**2+sigma_odlir(k,ii)**2))
3252 c min_odl=minval(distancek)
3253 do kk=1,constr_homology
3254 if(l_homo(kk,ii)) then
3255 min_odl=distancek(kk)
3259 do kk=1,constr_homology
3260 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3261 & min_odl=distancek(kk)
3263 c write (iout,* )"min_odl",min_odl
3265 write (iout,*) "ij dij",i,j,dij
3266 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3267 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3268 write (iout,* )"min_odl",min_odl
3273 if (waga_dist.ge.0.0d0) then
3279 do k=1,constr_homology
3280 c Nie wiem po co to liczycie jeszcze raz!
3281 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3282 c & (2*(sigma_odl(i,j,k))**2))
3283 if(.not.l_homo(k,ii)) cycle
3284 if (waga_dist.ge.0.0d0) then
3286 c For Gaussian-type Urestr
3288 godl(k)=dexp(-distancek(k)+min_odl)
3289 odleg2=odleg2+godl(k)
3291 c For Lorentzian-type Urestr
3294 odleg2=odleg2+distancek(k)
3297 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3298 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3299 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3300 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3303 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3304 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3306 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3307 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3309 if (waga_dist.ge.0.0d0) then
3311 c For Gaussian-type Urestr
3313 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3315 c For Lorentzian-type Urestr
3318 odleg=odleg+odleg2/constr_homology
3322 c write (iout,*) "odleg",odleg ! sum of -ln-s
3325 c For Gaussian-type Urestr
3327 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3329 do k=1,constr_homology
3330 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3331 c & *waga_dist)+min_odl
3332 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3334 if(.not.l_homo(k,ii)) cycle
3335 if (waga_dist.ge.0.0d0) then
3336 c For Gaussian-type Urestr
3338 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3340 c For Lorentzian-type Urestr
3343 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3344 & sigma_odlir(k,ii)**2)**2)
3346 sum_sgodl=sum_sgodl+sgodl
3348 c sgodl2=sgodl2+sgodl
3349 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3350 c write(iout,*) "constr_homology=",constr_homology
3351 c write(iout,*) i, j, k, "TEST K"
3353 if (waga_dist.ge.0.0d0) then
3355 c For Gaussian-type Urestr
3357 grad_odl3=waga_homology(iset)*waga_dist
3358 & *sum_sgodl/(sum_godl*dij)
3360 c For Lorentzian-type Urestr
3363 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3364 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3365 grad_odl3=-waga_homology(iset)*waga_dist*
3366 & sum_sgodl/(constr_homology*dij)
3369 c grad_odl3=sum_sgodl/(sum_godl*dij)
3372 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3373 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3374 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3376 ccc write(iout,*) godl, sgodl, grad_odl3
3378 c grad_odl=grad_odl+grad_odl3
3381 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3382 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3383 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3384 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3385 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3386 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3387 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3388 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3389 c if (i.eq.25.and.j.eq.27) then
3390 c write(iout,*) "jik",jik,"i",i,"j",j
3391 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3392 c write(iout,*) "grad_odl3",grad_odl3
3393 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3394 c write(iout,*) "ggodl",ggodl
3395 c write(iout,*) "ghpbc(",jik,i,")",
3396 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3401 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3402 ccc & dLOG(odleg2),"-odleg=", -odleg
3404 enddo ! ii-loop for dist
3406 write(iout,*) "------- dist restrs end -------"
3407 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3408 c & waga_d.eq.1.0d0) call sum_gradient
3410 c Pseudo-energy and gradient from dihedral-angle restraints from
3411 c homology templates
3412 c write (iout,*) "End of distance loop"
3415 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3417 write(iout,*) "------- dih restrs start -------"
3418 do i=idihconstr_start_homo,idihconstr_end_homo
3419 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3422 do i=idihconstr_start_homo,idihconstr_end_homo
3428 c betai=beta(i,i+1,i+2,i+3)
3430 c write (iout,*) "betai =",betai
3431 do k=1,constr_homology
3432 dih_diff(k)=pinorm(dih(k,i)-betai)
3433 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3434 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3435 c & -(6.28318-dih_diff(i,k))
3436 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3437 c & 6.28318+dih_diff(i,k)
3439 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3441 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3443 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3446 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3449 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3450 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3452 write (iout,*) "i",i," betai",betai," kat2",kat2
3453 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3455 if (kat2.le.1.0d-14) cycle
3456 kat=kat-dLOG(kat2/constr_homology)
3457 c write (iout,*) "kat",kat ! sum of -ln-s
3459 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3460 ccc & dLOG(kat2), "-kat=", -kat
3463 c ----------------------------------------------------------------------
3465 c ----------------------------------------------------------------------
3469 do k=1,constr_homology
3471 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3473 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3475 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3476 sum_sgdih=sum_sgdih+sgdih
3478 c grad_dih3=sum_sgdih/sum_gdih
3479 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3481 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3482 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3483 ccc & gloc(nphi+i-3,icg)
3484 gloc(i,icg)=gloc(i,icg)+grad_dih3
3486 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3488 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3489 ccc & gloc(nphi+i-3,icg)
3491 enddo ! i-loop for dih
3493 write(iout,*) "------- dih restrs end -------"
3496 c Pseudo-energy and gradient for theta angle restraints from
3497 c homology templates
3498 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3502 c For constr_homology reference structures (FP)
3504 c Uconst_back_tot=0.0d0
3507 c Econstr_back legacy
3510 c do i=ithet_start,ithet_end
3513 c do i=loc_start,loc_end
3516 duscdiffx(j,i)=0.0d0
3522 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3523 c write (iout,*) "waga_theta",waga_theta
3524 if (waga_theta.gt.0.0d0) then
3526 write (iout,*) "usampl",usampl
3527 write(iout,*) "------- theta restrs start -------"
3528 c do i=ithet_start,ithet_end
3529 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3532 c write (iout,*) "maxres",maxres,"nres",nres
3534 do i=ithet_start,ithet_end
3537 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3539 c Deviation of theta angles wrt constr_homology ref structures
3541 utheta_i=0.0d0 ! argument of Gaussian for single k
3543 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3547 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3548 c over residues in a fragment
3549 c write (iout,*) "theta(",i,")=",theta(i)
3550 do k=1,constr_homology
3552 c dtheta_i=theta(j)-thetaref(j,iref)
3553 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3554 theta_diff(k)=thetatpl(k,i)-theta(i)
3556 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3557 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3558 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3559 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3560 c Gradient for single Gaussian restraint in subr Econstr_back
3561 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3564 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3565 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3569 c Gradient for multiple Gaussian restraint
3570 sum_gtheta=gutheta_i
3572 do k=1,constr_homology
3573 c New generalized expr for multiple Gaussian from Econstr_back
3574 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3576 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3577 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3580 c Final value of gradient using same var as in Econstr_back
3581 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3582 & *waga_homology(iset)
3583 c dutheta(i)=sum_sgtheta/sum_gtheta
3585 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3587 Eval=Eval-dLOG(gutheta_i/constr_homology)
3588 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3589 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3590 c Uconst_back=Uconst_back+utheta(i)
3591 enddo ! (i-loop for theta)
3593 write(iout,*) "------- theta restrs end -------"
3597 c Deviation of local SC geometry
3599 c Separation of two i-loops (instructed by AL - 11/3/2014)
3601 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3602 c write (iout,*) "waga_d",waga_d
3605 write(iout,*) "------- SC restrs start -------"
3606 write (iout,*) "Initial duscdiff,duscdiffx"
3607 do i=loc_start,loc_end
3608 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3609 & (duscdiffx(jik,i),jik=1,3)
3612 do i=loc_start,loc_end
3613 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3615 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3619 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3620 c write(iout,*) "xxtab, yytab, zztab"
3621 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3622 do k=1,constr_homology
3624 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3625 c Original sign inverted for calc of gradients (s. Econstr_back)
3626 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3627 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3628 c write(iout,*) "dxx, dyy, dzz"
3629 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3631 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3632 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3633 c uscdiffk(k)=usc_diff(i)
3634 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3635 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3636 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3637 c & xxref(j),yyref(j),zzref(j)
3642 c Generalized expression for multiple Gaussian acc to that for a single
3643 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3645 c Original implementation
3646 c sum_guscdiff=guscdiff(i)
3648 c sum_sguscdiff=0.0d0
3649 c do k=1,constr_homology
3650 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3651 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3652 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3655 c Implementation of new expressions for gradient (Jan. 2015)
3657 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3659 do k=1,constr_homology
3661 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3662 c before. Now the drivatives should be correct
3664 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3665 c Original sign inverted for calc of gradients (s. Econstr_back)
3666 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3667 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3669 c New implementation
3671 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3672 & sigma_d(k,i) ! for the grad wrt r'
3673 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3676 c New implementation
3677 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3679 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3680 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3681 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3682 duscdiff(jik,i)=duscdiff(jik,i)+
3683 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3684 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3685 duscdiffx(jik,i)=duscdiffx(jik,i)+
3686 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3687 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3690 write(iout,*) "jik",jik,"i",i
3691 write(iout,*) "dxx, dyy, dzz"
3692 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3693 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3694 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3695 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3696 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3697 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3698 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3699 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3700 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3701 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3702 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3703 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3704 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3705 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3706 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3713 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3714 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3716 c write (iout,*) i," uscdiff",uscdiff(i)
3718 c Put together deviations from local geometry
3720 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3721 c & wfrag_back(3,i,iset)*uscdiff(i)
3722 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3723 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3724 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3725 c Uconst_back=Uconst_back+usc_diff(i)
3727 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3729 c New implment: multiplied by sum_sguscdiff
3732 enddo ! (i-loop for dscdiff)
3737 write(iout,*) "------- SC restrs end -------"
3738 write (iout,*) "------ After SC loop in e_modeller ------"
3739 do i=loc_start,loc_end
3740 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3741 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3743 if (waga_theta.eq.1.0d0) then
3744 write (iout,*) "in e_modeller after SC restr end: dutheta"
3745 do i=ithet_start,ithet_end
3746 write (iout,*) i,dutheta(i)
3749 if (waga_d.eq.1.0d0) then
3750 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3752 write (iout,*) i,(duscdiff(j,i),j=1,3)
3753 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3758 c Total energy from homology restraints
3760 write (iout,*) "odleg",odleg," kat",kat
3761 write (iout,*) "odleg",odleg," kat",kat
3762 write (iout,*) "Eval",Eval," Erot",Erot
3763 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3764 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3765 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3768 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3770 c ehomology_constr=odleg+kat
3772 c For Lorentzian-type Urestr
3775 if (waga_dist.ge.0.0d0) then
3777 c For Gaussian-type Urestr
3779 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3780 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3781 ehomology_constr=waga_dist*odleg+waga_angle*kat+
3782 & waga_theta*Eval+waga_d*Erot
3783 c write (iout,*) "ehomology_constr=",ehomology_constr
3786 c For Lorentzian-type Urestr
3788 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3789 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3790 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
3791 & waga_theta*Eval+waga_d*Erot
3792 c write (iout,*) "ehomology_constr=",ehomology_constr
3795 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3796 & "Eval",waga_theta,eval,
3797 & "Erot",waga_d,Erot
3798 write (iout,*) "ehomology_constr",ehomology_constr
3802 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3803 747 format(a12,i4,i4,i4,f8.3,f8.3)
3804 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3805 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3806 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3807 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3809 c-----------------------------------------------------------------------
3810 subroutine ebond(estr)
3812 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3814 implicit real*8 (a-h,o-z)
3815 include 'DIMENSIONS'
3816 include 'DIMENSIONS.ZSCOPT'
3817 include 'DIMENSIONS.FREE'
3818 include 'COMMON.LOCAL'
3819 include 'COMMON.GEO'
3820 include 'COMMON.INTERACT'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.VAR'
3823 include 'COMMON.CHAIN'
3824 include 'COMMON.IOUNITS'
3825 include 'COMMON.NAMES'
3826 include 'COMMON.FFIELD'
3827 include 'COMMON.CONTROL'
3828 double precision u(3),ud(3)
3829 logical :: lprn=.false.
3832 diff = vbld(i)-vbldp0
3833 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3836 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3841 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3848 diff=vbld(i+nres)-vbldsc0(1,iti)
3850 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3851 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3852 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3854 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3858 diff=vbld(i+nres)-vbldsc0(j,iti)
3859 ud(j)=aksc(j,iti)*diff
3860 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3874 uprod2=uprod2*u(k)*u(k)
3878 usumsqder=usumsqder+ud(j)*uprod2
3881 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3882 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3883 estr=estr+uprod/usum
3885 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3893 C--------------------------------------------------------------------------
3894 subroutine ebend(etheta)
3896 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3897 C angles gamma and its derivatives in consecutive thetas and gammas.
3899 implicit real*8 (a-h,o-z)
3900 include 'DIMENSIONS'
3901 include 'DIMENSIONS.ZSCOPT'
3902 include 'COMMON.LOCAL'
3903 include 'COMMON.GEO'
3904 include 'COMMON.INTERACT'
3905 include 'COMMON.DERIV'
3906 include 'COMMON.VAR'
3907 include 'COMMON.CHAIN'
3908 include 'COMMON.IOUNITS'
3909 include 'COMMON.NAMES'
3910 include 'COMMON.FFIELD'
3911 common /calcthet/ term1,term2,termm,diffak,ratak,
3912 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3913 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3914 double precision y(2),z(2)
3916 time11=dexp(-2*time)
3919 c write (iout,*) "nres",nres
3920 c write (*,'(a,i2)') 'EBEND ICG=',icg
3921 c write (iout,*) ithet_start,ithet_end
3922 do i=ithet_start,ithet_end
3923 C Zero the energy function and its derivative at 0 or pi.
3924 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3926 c if (i.gt.ithet_start .and.
3927 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3928 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3936 c if (i.lt.nres .and. itel(i).ne.0) then
3948 call proc_proc(phii,icrc)
3949 if (icrc.eq.1) phii=150.0
3963 call proc_proc(phii1,icrc)
3964 if (icrc.eq.1) phii1=150.0
3976 C Calculate the "mean" value of theta from the part of the distribution
3977 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3978 C In following comments this theta will be referred to as t_c.
3979 thet_pred_mean=0.0d0
3983 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3985 c write (iout,*) "thet_pred_mean",thet_pred_mean
3986 dthett=thet_pred_mean*ssd
3987 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3988 c write (iout,*) "thet_pred_mean",thet_pred_mean
3989 C Derivatives of the "mean" values in gamma1 and gamma2.
3990 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3991 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3992 if (theta(i).gt.pi-delta) then
3993 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3995 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3996 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3997 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3999 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4001 else if (theta(i).lt.delta) then
4002 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4003 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4004 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4006 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4007 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4010 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4013 etheta=etheta+ethetai
4014 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4015 c & rad2deg*phii,rad2deg*phii1,ethetai
4016 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4017 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4018 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4021 C Ufff.... We've done all this!!!
4024 C---------------------------------------------------------------------------
4025 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4027 implicit real*8 (a-h,o-z)
4028 include 'DIMENSIONS'
4029 include 'COMMON.LOCAL'
4030 include 'COMMON.IOUNITS'
4031 common /calcthet/ term1,term2,termm,diffak,ratak,
4032 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4033 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4034 C Calculate the contributions to both Gaussian lobes.
4035 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4036 C The "polynomial part" of the "standard deviation" of this part of
4040 sig=sig*thet_pred_mean+polthet(j,it)
4042 C Derivative of the "interior part" of the "standard deviation of the"
4043 C gamma-dependent Gaussian lobe in t_c.
4044 sigtc=3*polthet(3,it)
4046 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4049 C Set the parameters of both Gaussian lobes of the distribution.
4050 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4051 fac=sig*sig+sigc0(it)
4054 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4055 sigsqtc=-4.0D0*sigcsq*sigtc
4056 c print *,i,sig,sigtc,sigsqtc
4057 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4058 sigtc=-sigtc/(fac*fac)
4059 C Following variable is sigma(t_c)**(-2)
4060 sigcsq=sigcsq*sigcsq
4062 sig0inv=1.0D0/sig0i**2
4063 delthec=thetai-thet_pred_mean
4064 delthe0=thetai-theta0i
4065 term1=-0.5D0*sigcsq*delthec*delthec
4066 term2=-0.5D0*sig0inv*delthe0*delthe0
4067 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4068 C NaNs in taking the logarithm. We extract the largest exponent which is added
4069 C to the energy (this being the log of the distribution) at the end of energy
4070 C term evaluation for this virtual-bond angle.
4071 if (term1.gt.term2) then
4073 term2=dexp(term2-termm)
4077 term1=dexp(term1-termm)
4080 C The ratio between the gamma-independent and gamma-dependent lobes of
4081 C the distribution is a Gaussian function of thet_pred_mean too.
4082 diffak=gthet(2,it)-thet_pred_mean
4083 ratak=diffak/gthet(3,it)**2
4084 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4085 C Let's differentiate it in thet_pred_mean NOW.
4087 C Now put together the distribution terms to make complete distribution.
4088 termexp=term1+ak*term2
4089 termpre=sigc+ak*sig0i
4090 C Contribution of the bending energy from this theta is just the -log of
4091 C the sum of the contributions from the two lobes and the pre-exponential
4092 C factor. Simple enough, isn't it?
4093 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4094 C NOW the derivatives!!!
4095 C 6/6/97 Take into account the deformation.
4096 E_theta=(delthec*sigcsq*term1
4097 & +ak*delthe0*sig0inv*term2)/termexp
4098 E_tc=((sigtc+aktc*sig0i)/termpre
4099 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4100 & aktc*term2)/termexp)
4103 c-----------------------------------------------------------------------------
4104 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4105 implicit real*8 (a-h,o-z)
4106 include 'DIMENSIONS'
4107 include 'COMMON.LOCAL'
4108 include 'COMMON.IOUNITS'
4109 common /calcthet/ term1,term2,termm,diffak,ratak,
4110 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4111 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4112 delthec=thetai-thet_pred_mean
4113 delthe0=thetai-theta0i
4114 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4115 t3 = thetai-thet_pred_mean
4119 t14 = t12+t6*sigsqtc
4121 t21 = thetai-theta0i
4127 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4128 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4129 & *(-t12*t9-ak*sig0inv*t27)
4133 C--------------------------------------------------------------------------
4134 subroutine ebend(etheta)
4136 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4137 C angles gamma and its derivatives in consecutive thetas and gammas.
4138 C ab initio-derived potentials from
4139 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4141 implicit real*8 (a-h,o-z)
4142 include 'DIMENSIONS'
4143 include 'DIMENSIONS.ZSCOPT'
4144 include 'DIMENSIONS.FREE'
4145 include 'COMMON.LOCAL'
4146 include 'COMMON.GEO'
4147 include 'COMMON.INTERACT'
4148 include 'COMMON.DERIV'
4149 include 'COMMON.VAR'
4150 include 'COMMON.CHAIN'
4151 include 'COMMON.IOUNITS'
4152 include 'COMMON.NAMES'
4153 include 'COMMON.FFIELD'
4154 include 'COMMON.CONTROL'
4155 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4156 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4157 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4158 & sinph1ph2(maxdouble,maxdouble)
4159 logical lprn /.false./, lprn1 /.false./
4161 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4162 do i=ithet_start,ithet_end
4163 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4164 & (itype(i).eq.ntyp1)) cycle
4168 theti2=0.5d0*theta(i)
4169 ityp2=ithetyp(itype(i-1))
4171 coskt(k)=dcos(k*theti2)
4172 sinkt(k)=dsin(k*theti2)
4174 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4177 if (phii.ne.phii) phii=150.0
4181 ityp1=ithetyp(itype(i-2))
4183 cosph1(k)=dcos(k*phii)
4184 sinph1(k)=dsin(k*phii)
4188 ityp1=ithetyp(itype(i-2))
4194 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4197 if (phii1.ne.phii1) phii1=150.0
4202 ityp3=ithetyp(itype(i))
4204 cosph2(k)=dcos(k*phii1)
4205 sinph2(k)=dsin(k*phii1)
4210 ityp3=ithetyp(itype(i))
4216 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4217 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4219 ethetai=aa0thet(ityp1,ityp2,ityp3)
4222 ccl=cosph1(l)*cosph2(k-l)
4223 ssl=sinph1(l)*sinph2(k-l)
4224 scl=sinph1(l)*cosph2(k-l)
4225 csl=cosph1(l)*sinph2(k-l)
4226 cosph1ph2(l,k)=ccl-ssl
4227 cosph1ph2(k,l)=ccl+ssl
4228 sinph1ph2(l,k)=scl+csl
4229 sinph1ph2(k,l)=scl-csl
4233 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4234 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4235 write (iout,*) "coskt and sinkt"
4237 write (iout,*) k,coskt(k),sinkt(k)
4241 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4242 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4245 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4246 & " ethetai",ethetai
4249 write (iout,*) "cosph and sinph"
4251 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4253 write (iout,*) "cosph1ph2 and sinph2ph2"
4256 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4257 & sinph1ph2(l,k),sinph1ph2(k,l)
4260 write(iout,*) "ethetai",ethetai
4264 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4265 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4266 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4267 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4268 ethetai=ethetai+sinkt(m)*aux
4269 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4270 dephii=dephii+k*sinkt(m)*(
4271 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4272 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4273 dephii1=dephii1+k*sinkt(m)*(
4274 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4275 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4277 & write (iout,*) "m",m," k",k," bbthet",
4278 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4279 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4280 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4281 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4285 & write(iout,*) "ethetai",ethetai
4289 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4290 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4291 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4292 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4293 ethetai=ethetai+sinkt(m)*aux
4294 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4295 dephii=dephii+l*sinkt(m)*(
4296 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4297 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4298 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4299 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4300 dephii1=dephii1+(k-l)*sinkt(m)*(
4301 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4302 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4303 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4304 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4306 write (iout,*) "m",m," k",k," l",l," ffthet",
4307 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4308 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4309 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4310 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4311 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4312 & cosph1ph2(k,l)*sinkt(m),
4313 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4320 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4321 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4322 & phii1*rad2deg,ethetai
4324 etheta=etheta+ethetai
4326 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4327 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4328 gloc(nphi+i-2,icg)=wang*dethetai
4334 c-----------------------------------------------------------------------------
4335 subroutine esc(escloc)
4336 C Calculate the local energy of a side chain and its derivatives in the
4337 C corresponding virtual-bond valence angles THETA and the spherical angles
4339 implicit real*8 (a-h,o-z)
4340 include 'DIMENSIONS'
4341 include 'DIMENSIONS.ZSCOPT'
4342 include 'COMMON.GEO'
4343 include 'COMMON.LOCAL'
4344 include 'COMMON.VAR'
4345 include 'COMMON.INTERACT'
4346 include 'COMMON.DERIV'
4347 include 'COMMON.CHAIN'
4348 include 'COMMON.IOUNITS'
4349 include 'COMMON.NAMES'
4350 include 'COMMON.FFIELD'
4351 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4352 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4353 common /sccalc/ time11,time12,time112,theti,it,nlobit
4356 c write (iout,'(a)') 'ESC'
4357 do i=loc_start,loc_end
4359 if (it.eq.10) goto 1
4361 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4362 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4363 theti=theta(i+1)-pipol
4367 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4369 if (x(2).gt.pi-delta) then
4373 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4375 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4376 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4378 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4379 & ddersc0(1),dersc(1))
4380 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4381 & ddersc0(3),dersc(3))
4383 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4385 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4386 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4387 & dersc0(2),esclocbi,dersc02)
4388 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4390 call splinthet(x(2),0.5d0*delta,ss,ssd)
4395 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4397 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4398 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4400 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4402 c write (iout,*) escloci
4403 else if (x(2).lt.delta) then
4407 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4409 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4410 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4412 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4413 & ddersc0(1),dersc(1))
4414 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4415 & ddersc0(3),dersc(3))
4417 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4419 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4420 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4421 & dersc0(2),esclocbi,dersc02)
4422 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4427 call splinthet(x(2),0.5d0*delta,ss,ssd)
4429 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4431 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4432 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4434 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4435 c write (iout,*) escloci
4437 call enesc(x,escloci,dersc,ddummy,.false.)
4440 escloc=escloc+escloci
4441 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4443 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4445 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4446 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4451 C---------------------------------------------------------------------------
4452 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4453 implicit real*8 (a-h,o-z)
4454 include 'DIMENSIONS'
4455 include 'COMMON.GEO'
4456 include 'COMMON.LOCAL'
4457 include 'COMMON.IOUNITS'
4458 common /sccalc/ time11,time12,time112,theti,it,nlobit
4459 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4460 double precision contr(maxlob,-1:1)
4462 c write (iout,*) 'it=',it,' nlobit=',nlobit
4466 if (mixed) ddersc(j)=0.0d0
4470 C Because of periodicity of the dependence of the SC energy in omega we have
4471 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4472 C To avoid underflows, first compute & store the exponents.
4480 z(k)=x(k)-censc(k,j,it)
4485 Axk=Axk+gaussc(l,k,j,it)*z(l)
4491 expfac=expfac+Ax(k,j,iii)*z(k)
4499 C As in the case of ebend, we want to avoid underflows in exponentiation and
4500 C subsequent NaNs and INFs in energy calculation.
4501 C Find the largest exponent
4505 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4509 cd print *,'it=',it,' emin=',emin
4511 C Compute the contribution to SC energy and derivatives
4515 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4516 cd print *,'j=',j,' expfac=',expfac
4517 escloc_i=escloc_i+expfac
4519 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4523 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4524 & +gaussc(k,2,j,it))*expfac
4531 dersc(1)=dersc(1)/cos(theti)**2
4532 ddersc(1)=ddersc(1)/cos(theti)**2
4535 escloci=-(dlog(escloc_i)-emin)
4537 dersc(j)=dersc(j)/escloc_i
4541 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4546 C------------------------------------------------------------------------------
4547 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4548 implicit real*8 (a-h,o-z)
4549 include 'DIMENSIONS'
4550 include 'COMMON.GEO'
4551 include 'COMMON.LOCAL'
4552 include 'COMMON.IOUNITS'
4553 common /sccalc/ time11,time12,time112,theti,it,nlobit
4554 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4555 double precision contr(maxlob)
4566 z(k)=x(k)-censc(k,j,it)
4572 Axk=Axk+gaussc(l,k,j,it)*z(l)
4578 expfac=expfac+Ax(k,j)*z(k)
4583 C As in the case of ebend, we want to avoid underflows in exponentiation and
4584 C subsequent NaNs and INFs in energy calculation.
4585 C Find the largest exponent
4588 if (emin.gt.contr(j)) emin=contr(j)
4592 C Compute the contribution to SC energy and derivatives
4596 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4597 escloc_i=escloc_i+expfac
4599 dersc(k)=dersc(k)+Ax(k,j)*expfac
4601 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4602 & +gaussc(1,2,j,it))*expfac
4606 dersc(1)=dersc(1)/cos(theti)**2
4607 dersc12=dersc12/cos(theti)**2
4608 escloci=-(dlog(escloc_i)-emin)
4610 dersc(j)=dersc(j)/escloc_i
4612 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4616 c----------------------------------------------------------------------------------
4617 subroutine esc(escloc)
4618 C Calculate the local energy of a side chain and its derivatives in the
4619 C corresponding virtual-bond valence angles THETA and the spherical angles
4620 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4621 C added by Urszula Kozlowska. 07/11/2007
4623 implicit real*8 (a-h,o-z)
4624 include 'DIMENSIONS'
4625 include 'DIMENSIONS.ZSCOPT'
4626 include 'DIMENSIONS.FREE'
4627 include 'COMMON.GEO'
4628 include 'COMMON.LOCAL'
4629 include 'COMMON.VAR'
4630 include 'COMMON.SCROT'
4631 include 'COMMON.INTERACT'
4632 include 'COMMON.DERIV'
4633 include 'COMMON.CHAIN'
4634 include 'COMMON.IOUNITS'
4635 include 'COMMON.NAMES'
4636 include 'COMMON.FFIELD'
4637 include 'COMMON.CONTROL'
4638 include 'COMMON.VECTORS'
4639 double precision x_prime(3),y_prime(3),z_prime(3)
4640 & , sumene,dsc_i,dp2_i,x(65),
4641 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4642 & de_dxx,de_dyy,de_dzz,de_dt
4643 double precision s1_t,s1_6_t,s2_t,s2_6_t
4645 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4646 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4647 & dt_dCi(3),dt_dCi1(3)
4648 common /sccalc/ time11,time12,time112,theti,it,nlobit
4651 do i=loc_start,loc_end
4652 costtab(i+1) =dcos(theta(i+1))
4653 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4654 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4655 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4656 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4657 cosfac=dsqrt(cosfac2)
4658 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4659 sinfac=dsqrt(sinfac2)
4661 if (it.eq.10) goto 1
4663 C Compute the axes of tghe local cartesian coordinates system; store in
4664 c x_prime, y_prime and z_prime
4671 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4672 C & dc_norm(3,i+nres)
4674 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4675 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4678 z_prime(j) = -uz(j,i-1)
4681 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4682 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4683 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4684 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4685 c & " xy",scalar(x_prime(1),y_prime(1)),
4686 c & " xz",scalar(x_prime(1),z_prime(1)),
4687 c & " yy",scalar(y_prime(1),y_prime(1)),
4688 c & " yz",scalar(y_prime(1),z_prime(1)),
4689 c & " zz",scalar(z_prime(1),z_prime(1))
4691 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4692 C to local coordinate system. Store in xx, yy, zz.
4698 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4699 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4700 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4707 C Compute the energy of the ith side cbain
4709 c write (2,*) "xx",xx," yy",yy," zz",zz
4712 x(j) = sc_parmin(j,it)
4715 Cc diagnostics - remove later
4717 yy1 = dsin(alph(2))*dcos(omeg(2))
4718 zz1 = -dsin(alph(2))*dsin(omeg(2))
4719 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4720 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4722 C," --- ", xx_w,yy_w,zz_w
4725 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4726 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4728 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4729 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4731 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4732 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4733 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4734 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4735 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4737 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4738 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4739 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4740 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4741 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4743 dsc_i = 0.743d0+x(61)
4745 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4746 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4747 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4748 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4749 s1=(1+x(63))/(0.1d0 + dscp1)
4750 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4751 s2=(1+x(65))/(0.1d0 + dscp2)
4752 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4753 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4754 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4755 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4757 c & dscp1,dscp2,sumene
4758 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4759 escloc = escloc + sumene
4760 c write (2,*) "escloc",escloc
4761 if (.not. calc_grad) goto 1
4765 C This section to check the numerical derivatives of the energy of ith side
4766 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4767 C #define DEBUG in the code to turn it on.
4769 write (2,*) "sumene =",sumene
4773 write (2,*) xx,yy,zz
4774 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4775 de_dxx_num=(sumenep-sumene)/aincr
4777 write (2,*) "xx+ sumene from enesc=",sumenep
4780 write (2,*) xx,yy,zz
4781 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4782 de_dyy_num=(sumenep-sumene)/aincr
4784 write (2,*) "yy+ sumene from enesc=",sumenep
4787 write (2,*) xx,yy,zz
4788 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4789 de_dzz_num=(sumenep-sumene)/aincr
4791 write (2,*) "zz+ sumene from enesc=",sumenep
4792 costsave=cost2tab(i+1)
4793 sintsave=sint2tab(i+1)
4794 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4795 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4796 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4797 de_dt_num=(sumenep-sumene)/aincr
4798 write (2,*) " t+ sumene from enesc=",sumenep
4799 cost2tab(i+1)=costsave
4800 sint2tab(i+1)=sintsave
4801 C End of diagnostics section.
4804 C Compute the gradient of esc
4806 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4807 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4808 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4809 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4810 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4811 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4812 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4813 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4814 pom1=(sumene3*sint2tab(i+1)+sumene1)
4815 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4816 pom2=(sumene4*cost2tab(i+1)+sumene2)
4817 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4818 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4819 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4820 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4822 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4823 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4824 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4826 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4827 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4828 & +(pom1+pom2)*pom_dx
4830 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4833 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4834 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4835 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4837 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4838 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4839 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4840 & +x(59)*zz**2 +x(60)*xx*zz
4841 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4842 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4843 & +(pom1-pom2)*pom_dy
4845 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4848 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4849 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4850 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4851 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4852 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4853 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4854 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4855 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4857 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4860 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4861 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4862 & +pom1*pom_dt1+pom2*pom_dt2
4864 write(2,*), "de_dt = ", de_dt,de_dt_num
4868 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4869 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4870 cosfac2xx=cosfac2*xx
4871 sinfac2yy=sinfac2*yy
4873 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4875 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4877 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4878 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4879 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4880 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4881 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4882 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4883 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4884 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4885 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4886 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4890 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4891 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4894 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4895 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4896 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4898 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4899 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4903 dXX_Ctab(k,i)=dXX_Ci(k)
4904 dXX_C1tab(k,i)=dXX_Ci1(k)
4905 dYY_Ctab(k,i)=dYY_Ci(k)
4906 dYY_C1tab(k,i)=dYY_Ci1(k)
4907 dZZ_Ctab(k,i)=dZZ_Ci(k)
4908 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4909 dXX_XYZtab(k,i)=dXX_XYZ(k)
4910 dYY_XYZtab(k,i)=dYY_XYZ(k)
4911 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4915 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4916 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4917 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4918 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4919 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4921 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4922 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4923 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4924 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4925 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4926 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4927 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4928 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4930 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4931 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4933 C to check gradient call subroutine check_grad
4940 c------------------------------------------------------------------------------
4941 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4943 C This procedure calculates two-body contact function g(rij) and its derivative:
4946 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4949 C where x=(rij-r0ij)/delta
4951 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4954 double precision rij,r0ij,eps0ij,fcont,fprimcont
4955 double precision x,x2,x4,delta
4959 if (x.lt.-1.0D0) then
4962 else if (x.le.1.0D0) then
4965 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4966 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4973 c------------------------------------------------------------------------------
4974 subroutine splinthet(theti,delta,ss,ssder)
4975 implicit real*8 (a-h,o-z)
4976 include 'DIMENSIONS'
4977 include 'DIMENSIONS.ZSCOPT'
4978 include 'COMMON.VAR'
4979 include 'COMMON.GEO'
4982 if (theti.gt.pipol) then
4983 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4985 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4990 c------------------------------------------------------------------------------
4991 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4993 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4994 double precision ksi,ksi2,ksi3,a1,a2,a3
4995 a1=fprim0*delta/(f1-f0)
5001 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5002 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5005 c------------------------------------------------------------------------------
5006 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5008 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5009 double precision ksi,ksi2,ksi3,a1,a2,a3
5014 a2=3*(f1x-f0x)-2*fprim0x*delta
5015 a3=fprim0x*delta-2*(f1x-f0x)
5016 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5019 C-----------------------------------------------------------------------------
5021 C-----------------------------------------------------------------------------
5022 subroutine etor(etors,edihcnstr,fact)
5023 implicit real*8 (a-h,o-z)
5024 include 'DIMENSIONS'
5025 include 'DIMENSIONS.ZSCOPT'
5026 include 'COMMON.VAR'
5027 include 'COMMON.GEO'
5028 include 'COMMON.LOCAL'
5029 include 'COMMON.TORSION'
5030 include 'COMMON.INTERACT'
5031 include 'COMMON.DERIV'
5032 include 'COMMON.CHAIN'
5033 include 'COMMON.NAMES'
5034 include 'COMMON.IOUNITS'
5035 include 'COMMON.FFIELD'
5036 include 'COMMON.TORCNSTR'
5038 C Set lprn=.true. for debugging
5042 do i=iphi_start,iphi_end
5043 itori=itortyp(itype(i-2))
5044 itori1=itortyp(itype(i-1))
5047 C Proline-Proline pair is a special case...
5048 if (itori.eq.3 .and. itori1.eq.3) then
5049 if (phii.gt.-dwapi3) then
5051 fac=1.0D0/(1.0D0-cosphi)
5052 etorsi=v1(1,3,3)*fac
5053 etorsi=etorsi+etorsi
5054 etors=etors+etorsi-v1(1,3,3)
5055 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5058 v1ij=v1(j+1,itori,itori1)
5059 v2ij=v2(j+1,itori,itori1)
5062 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5063 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5067 v1ij=v1(j,itori,itori1)
5068 v2ij=v2(j,itori,itori1)
5071 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5072 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5076 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5077 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5078 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5079 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5080 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5082 ! 6/20/98 - dihedral angle constraints
5085 itori=idih_constr(i)
5088 if (difi.gt.drange(i)) then
5090 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5091 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5092 else if (difi.lt.-drange(i)) then
5094 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5095 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5097 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5098 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5100 ! write (iout,*) 'edihcnstr',edihcnstr
5103 c------------------------------------------------------------------------------
5105 subroutine etor(etors,edihcnstr,fact)
5106 implicit real*8 (a-h,o-z)
5107 include 'DIMENSIONS'
5108 include 'DIMENSIONS.ZSCOPT'
5109 include 'COMMON.VAR'
5110 include 'COMMON.GEO'
5111 include 'COMMON.LOCAL'
5112 include 'COMMON.TORSION'
5113 include 'COMMON.INTERACT'
5114 include 'COMMON.DERIV'
5115 include 'COMMON.CHAIN'
5116 include 'COMMON.NAMES'
5117 include 'COMMON.IOUNITS'
5118 include 'COMMON.FFIELD'
5119 include 'COMMON.TORCNSTR'
5121 C Set lprn=.true. for debugging
5125 do i=iphi_start,iphi_end
5126 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5127 itori=itortyp(itype(i-2))
5128 itori1=itortyp(itype(i-1))
5131 C Regular cosine and sine terms
5132 do j=1,nterm(itori,itori1)
5133 v1ij=v1(j,itori,itori1)
5134 v2ij=v2(j,itori,itori1)
5137 etors=etors+v1ij*cosphi+v2ij*sinphi
5138 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5142 C E = SUM ----------------------------------- - v1
5143 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5145 cosphi=dcos(0.5d0*phii)
5146 sinphi=dsin(0.5d0*phii)
5147 do j=1,nlor(itori,itori1)
5148 vl1ij=vlor1(j,itori,itori1)
5149 vl2ij=vlor2(j,itori,itori1)
5150 vl3ij=vlor3(j,itori,itori1)
5151 pom=vl2ij*cosphi+vl3ij*sinphi
5152 pom1=1.0d0/(pom*pom+1.0d0)
5153 etors=etors+vl1ij*pom1
5155 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5157 C Subtract the constant term
5158 etors=etors-v0(itori,itori1)
5160 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5161 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5162 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5163 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5164 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5167 ! 6/20/98 - dihedral angle constraints
5170 itori=idih_constr(i)
5172 difi=pinorm(phii-phi0(i))
5174 if (difi.gt.drange(i)) then
5176 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5177 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5178 edihi=0.25d0*ftors*difi**4
5179 else if (difi.lt.-drange(i)) then
5181 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5182 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5183 edihi=0.25d0*ftors*difi**4
5187 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5189 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5190 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5192 ! write (iout,*) 'edihcnstr',edihcnstr
5195 c----------------------------------------------------------------------------
5196 subroutine etor_d(etors_d,fact2)
5197 C 6/23/01 Compute double torsional energy
5198 implicit real*8 (a-h,o-z)
5199 include 'DIMENSIONS'
5200 include 'DIMENSIONS.ZSCOPT'
5201 include 'COMMON.VAR'
5202 include 'COMMON.GEO'
5203 include 'COMMON.LOCAL'
5204 include 'COMMON.TORSION'
5205 include 'COMMON.INTERACT'
5206 include 'COMMON.DERIV'
5207 include 'COMMON.CHAIN'
5208 include 'COMMON.NAMES'
5209 include 'COMMON.IOUNITS'
5210 include 'COMMON.FFIELD'
5211 include 'COMMON.TORCNSTR'
5213 C Set lprn=.true. for debugging
5217 do i=iphi_start,iphi_end-1
5218 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5220 itori=itortyp(itype(i-2))
5221 itori1=itortyp(itype(i-1))
5222 itori2=itortyp(itype(i))
5227 C Regular cosine and sine terms
5228 do j=1,ntermd_1(itori,itori1,itori2)
5229 v1cij=v1c(1,j,itori,itori1,itori2)
5230 v1sij=v1s(1,j,itori,itori1,itori2)
5231 v2cij=v1c(2,j,itori,itori1,itori2)
5232 v2sij=v1s(2,j,itori,itori1,itori2)
5233 cosphi1=dcos(j*phii)
5234 sinphi1=dsin(j*phii)
5235 cosphi2=dcos(j*phii1)
5236 sinphi2=dsin(j*phii1)
5237 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5238 & v2cij*cosphi2+v2sij*sinphi2
5239 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5240 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5242 do k=2,ntermd_2(itori,itori1,itori2)
5244 v1cdij = v2c(k,l,itori,itori1,itori2)
5245 v2cdij = v2c(l,k,itori,itori1,itori2)
5246 v1sdij = v2s(k,l,itori,itori1,itori2)
5247 v2sdij = v2s(l,k,itori,itori1,itori2)
5248 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5249 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5250 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5251 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5252 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5253 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5254 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5255 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5256 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5257 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5260 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5261 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5267 c------------------------------------------------------------------------------
5268 subroutine eback_sc_corr(esccor)
5269 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5270 c conformational states; temporarily implemented as differences
5271 c between UNRES torsional potentials (dependent on three types of
5272 c residues) and the torsional potentials dependent on all 20 types
5273 c of residues computed from AM1 energy surfaces of terminally-blocked
5274 c amino-acid residues.
5275 implicit real*8 (a-h,o-z)
5276 include 'DIMENSIONS'
5277 include 'DIMENSIONS.ZSCOPT'
5278 include 'DIMENSIONS.FREE'
5279 include 'COMMON.VAR'
5280 include 'COMMON.GEO'
5281 include 'COMMON.LOCAL'
5282 include 'COMMON.TORSION'
5283 include 'COMMON.SCCOR'
5284 include 'COMMON.INTERACT'
5285 include 'COMMON.DERIV'
5286 include 'COMMON.CHAIN'
5287 include 'COMMON.NAMES'
5288 include 'COMMON.IOUNITS'
5289 include 'COMMON.FFIELD'
5290 include 'COMMON.CONTROL'
5292 C Set lprn=.true. for debugging
5295 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5297 do i=itau_start,itau_end
5299 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5300 isccori=isccortyp(itype(i-2))
5301 isccori1=isccortyp(itype(i-1))
5303 cccc Added 9 May 2012
5304 cc Tauangle is torsional engle depending on the value of first digit
5305 c(see comment below)
5306 cc Omicron is flat angle depending on the value of first digit
5307 c(see comment below)
5310 do intertyp=1,3 !intertyp
5311 cc Added 09 May 2012 (Adasko)
5312 cc Intertyp means interaction type of backbone mainchain correlation:
5313 c 1 = SC...Ca...Ca...Ca
5314 c 2 = Ca...Ca...Ca...SC
5315 c 3 = SC...Ca...Ca...SCi
5317 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5318 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5319 & (itype(i-1).eq.21)))
5320 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5321 & .or.(itype(i-2).eq.21)))
5322 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5323 & (itype(i-1).eq.21)))) cycle
5324 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5325 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5327 do j=1,nterm_sccor(isccori,isccori1)
5328 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5329 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5330 cosphi=dcos(j*tauangle(intertyp,i))
5331 sinphi=dsin(j*tauangle(intertyp,i))
5332 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5334 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5336 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5338 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5339 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5340 c &gloc_sc(intertyp,i-3,icg)
5342 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5343 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5344 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5345 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5346 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5349 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5353 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5357 c------------------------------------------------------------------------------
5358 subroutine multibody(ecorr)
5359 C This subroutine calculates multi-body contributions to energy following
5360 C the idea of Skolnick et al. If side chains I and J make a contact and
5361 C at the same time side chains I+1 and J+1 make a contact, an extra
5362 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5363 implicit real*8 (a-h,o-z)
5364 include 'DIMENSIONS'
5365 include 'COMMON.IOUNITS'
5366 include 'COMMON.DERIV'
5367 include 'COMMON.INTERACT'
5368 include 'COMMON.CONTACTS'
5369 double precision gx(3),gx1(3)
5372 C Set lprn=.true. for debugging
5376 write (iout,'(a)') 'Contact function values:'
5378 write (iout,'(i2,20(1x,i2,f10.5))')
5379 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5394 num_conti=num_cont(i)
5395 num_conti1=num_cont(i1)
5400 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5401 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5402 cd & ' ishift=',ishift
5403 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5404 C The system gains extra energy.
5405 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5406 endif ! j1==j+-ishift
5415 c------------------------------------------------------------------------------
5416 double precision function esccorr(i,j,k,l,jj,kk)
5417 implicit real*8 (a-h,o-z)
5418 include 'DIMENSIONS'
5419 include 'COMMON.IOUNITS'
5420 include 'COMMON.DERIV'
5421 include 'COMMON.INTERACT'
5422 include 'COMMON.CONTACTS'
5423 double precision gx(3),gx1(3)
5428 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5429 C Calculate the multi-body contribution to energy.
5430 C Calculate multi-body contributions to the gradient.
5431 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5432 cd & k,l,(gacont(m,kk,k),m=1,3)
5434 gx(m) =ekl*gacont(m,jj,i)
5435 gx1(m)=eij*gacont(m,kk,k)
5436 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5437 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5438 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5439 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5443 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5448 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5454 c------------------------------------------------------------------------------
5456 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5457 implicit real*8 (a-h,o-z)
5458 include 'DIMENSIONS'
5459 integer dimen1,dimen2,atom,indx
5460 double precision buffer(dimen1,dimen2)
5461 double precision zapas
5462 common /contacts_hb/ zapas(3,20,maxres,7),
5463 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5464 & num_cont_hb(maxres),jcont_hb(20,maxres)
5465 num_kont=num_cont_hb(atom)
5469 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5472 buffer(i,indx+22)=facont_hb(i,atom)
5473 buffer(i,indx+23)=ees0p(i,atom)
5474 buffer(i,indx+24)=ees0m(i,atom)
5475 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5477 buffer(1,indx+26)=dfloat(num_kont)
5480 c------------------------------------------------------------------------------
5481 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5482 implicit real*8 (a-h,o-z)
5483 include 'DIMENSIONS'
5484 integer dimen1,dimen2,atom,indx
5485 double precision buffer(dimen1,dimen2)
5486 double precision zapas
5487 common /contacts_hb/ zapas(3,20,maxres,7),
5488 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5489 & num_cont_hb(maxres),jcont_hb(20,maxres)
5490 num_kont=buffer(1,indx+26)
5491 num_kont_old=num_cont_hb(atom)
5492 num_cont_hb(atom)=num_kont+num_kont_old
5497 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5500 facont_hb(ii,atom)=buffer(i,indx+22)
5501 ees0p(ii,atom)=buffer(i,indx+23)
5502 ees0m(ii,atom)=buffer(i,indx+24)
5503 jcont_hb(ii,atom)=buffer(i,indx+25)
5507 c------------------------------------------------------------------------------
5509 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5510 C This subroutine calculates multi-body contributions to hydrogen-bonding
5511 implicit real*8 (a-h,o-z)
5512 include 'DIMENSIONS'
5513 include 'DIMENSIONS.ZSCOPT'
5514 include 'COMMON.IOUNITS'
5516 include 'COMMON.INFO'
5518 include 'COMMON.FFIELD'
5519 include 'COMMON.DERIV'
5520 include 'COMMON.INTERACT'
5521 include 'COMMON.CONTACTS'
5523 parameter (max_cont=maxconts)
5524 parameter (max_dim=2*(8*3+2))
5525 parameter (msglen1=max_cont*max_dim*4)
5526 parameter (msglen2=2*msglen1)
5527 integer source,CorrelType,CorrelID,Error
5528 double precision buffer(max_cont,max_dim)
5530 double precision gx(3),gx1(3)
5533 C Set lprn=.true. for debugging
5538 if (fgProcs.le.1) goto 30
5540 write (iout,'(a)') 'Contact function values:'
5542 write (iout,'(2i3,50(1x,i2,f5.2))')
5543 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5544 & j=1,num_cont_hb(i))
5547 C Caution! Following code assumes that electrostatic interactions concerning
5548 C a given atom are split among at most two processors!
5558 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5561 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5562 if (MyRank.gt.0) then
5563 C Send correlation contributions to the preceding processor
5565 nn=num_cont_hb(iatel_s)
5566 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5567 cd write (iout,*) 'The BUFFER array:'
5569 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5571 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5573 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5574 C Clear the contacts of the atom passed to the neighboring processor
5575 nn=num_cont_hb(iatel_s+1)
5577 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5579 num_cont_hb(iatel_s)=0
5581 cd write (iout,*) 'Processor ',MyID,MyRank,
5582 cd & ' is sending correlation contribution to processor',MyID-1,
5583 cd & ' msglen=',msglen
5584 cd write (*,*) 'Processor ',MyID,MyRank,
5585 cd & ' is sending correlation contribution to processor',MyID-1,
5586 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5587 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5588 cd write (iout,*) 'Processor ',MyID,
5589 cd & ' has sent correlation contribution to processor',MyID-1,
5590 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5591 cd write (*,*) 'Processor ',MyID,
5592 cd & ' has sent correlation contribution to processor',MyID-1,
5593 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5595 endif ! (MyRank.gt.0)
5599 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5600 if (MyRank.lt.fgProcs-1) then
5601 C Receive correlation contributions from the next processor
5603 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5604 cd write (iout,*) 'Processor',MyID,
5605 cd & ' is receiving correlation contribution from processor',MyID+1,
5606 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5607 cd write (*,*) 'Processor',MyID,
5608 cd & ' is receiving correlation contribution from processor',MyID+1,
5609 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5611 do while (nbytes.le.0)
5612 call mp_probe(MyID+1,CorrelType,nbytes)
5614 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5615 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5616 cd write (iout,*) 'Processor',MyID,
5617 cd & ' has received correlation contribution from processor',MyID+1,
5618 cd & ' msglen=',msglen,' nbytes=',nbytes
5619 cd write (iout,*) 'The received BUFFER array:'
5621 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5623 if (msglen.eq.msglen1) then
5624 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5625 else if (msglen.eq.msglen2) then
5626 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5627 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5630 & 'ERROR!!!! message length changed while processing correlations.'
5632 & 'ERROR!!!! message length changed while processing correlations.'
5633 call mp_stopall(Error)
5634 endif ! msglen.eq.msglen1
5635 endif ! MyRank.lt.fgProcs-1
5642 write (iout,'(a)') 'Contact function values:'
5644 write (iout,'(2i3,50(1x,i2,f5.2))')
5645 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5646 & j=1,num_cont_hb(i))
5650 C Remove the loop below after debugging !!!
5657 C Calculate the local-electrostatic correlation terms
5658 do i=iatel_s,iatel_e+1
5660 num_conti=num_cont_hb(i)
5661 num_conti1=num_cont_hb(i+1)
5666 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5667 c & ' jj=',jj,' kk=',kk
5668 if (j1.eq.j+1 .or. j1.eq.j-1) then
5669 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5670 C The system gains extra energy.
5671 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5673 write (iout,*) "ecorr",i,j,i+1,j1,
5674 & ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5677 else if (j1.eq.j) then
5678 C Contacts I-J and I-(J+1) occur simultaneously.
5679 C The system loses extra energy.
5680 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5685 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5686 c & ' jj=',jj,' kk=',kk
5688 C Contacts I-J and (I+1)-J occur simultaneously.
5689 C The system loses extra energy.
5690 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5697 c------------------------------------------------------------------------------
5698 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5700 C This subroutine calculates multi-body contributions to hydrogen-bonding
5701 implicit real*8 (a-h,o-z)
5702 include 'DIMENSIONS'
5703 include 'DIMENSIONS.ZSCOPT'
5704 include 'COMMON.IOUNITS'
5706 include 'COMMON.INFO'
5708 include 'COMMON.FFIELD'
5709 include 'COMMON.DERIV'
5710 include 'COMMON.INTERACT'
5711 include 'COMMON.CONTACTS'
5713 parameter (max_cont=maxconts)
5714 parameter (max_dim=2*(8*3+2))
5715 parameter (msglen1=max_cont*max_dim*4)
5716 parameter (msglen2=2*msglen1)
5717 integer source,CorrelType,CorrelID,Error
5718 double precision buffer(max_cont,max_dim)
5720 double precision gx(3),gx1(3)
5723 C Set lprn=.true. for debugging
5729 if (fgProcs.le.1) goto 30
5731 write (iout,'(a)') 'Contact function values:'
5733 write (iout,'(2i3,50(1x,i2,f5.2))')
5734 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5735 & j=1,num_cont_hb(i))
5738 C Caution! Following code assumes that electrostatic interactions concerning
5739 C a given atom are split among at most two processors!
5749 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5752 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5753 if (MyRank.gt.0) then
5754 C Send correlation contributions to the preceding processor
5756 nn=num_cont_hb(iatel_s)
5757 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5758 cd write (iout,*) 'The BUFFER array:'
5760 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5762 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5764 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5765 C Clear the contacts of the atom passed to the neighboring processor
5766 nn=num_cont_hb(iatel_s+1)
5768 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5770 num_cont_hb(iatel_s)=0
5772 cd write (iout,*) 'Processor ',MyID,MyRank,
5773 cd & ' is sending correlation contribution to processor',MyID-1,
5774 cd & ' msglen=',msglen
5775 cd write (*,*) 'Processor ',MyID,MyRank,
5776 cd & ' is sending correlation contribution to processor',MyID-1,
5777 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5778 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5779 cd write (iout,*) 'Processor ',MyID,
5780 cd & ' has sent correlation contribution to processor',MyID-1,
5781 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5782 cd write (*,*) 'Processor ',MyID,
5783 cd & ' has sent correlation contribution to processor',MyID-1,
5784 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5786 endif ! (MyRank.gt.0)
5790 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5791 if (MyRank.lt.fgProcs-1) then
5792 C Receive correlation contributions from the next processor
5794 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5795 cd write (iout,*) 'Processor',MyID,
5796 cd & ' is receiving correlation contribution from processor',MyID+1,
5797 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5798 cd write (*,*) 'Processor',MyID,
5799 cd & ' is receiving correlation contribution from processor',MyID+1,
5800 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5802 do while (nbytes.le.0)
5803 call mp_probe(MyID+1,CorrelType,nbytes)
5805 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5806 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5807 cd write (iout,*) 'Processor',MyID,
5808 cd & ' has received correlation contribution from processor',MyID+1,
5809 cd & ' msglen=',msglen,' nbytes=',nbytes
5810 cd write (iout,*) 'The received BUFFER array:'
5812 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5814 if (msglen.eq.msglen1) then
5815 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5816 else if (msglen.eq.msglen2) then
5817 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5818 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5821 & 'ERROR!!!! message length changed while processing correlations.'
5823 & 'ERROR!!!! message length changed while processing correlations.'
5824 call mp_stopall(Error)
5825 endif ! msglen.eq.msglen1
5826 endif ! MyRank.lt.fgProcs-1
5833 write (iout,'(a)') 'Contact function values:'
5835 write (iout,'(2i3,50(1x,i2,f5.2))')
5836 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5837 & j=1,num_cont_hb(i))
5843 C Remove the loop below after debugging !!!
5850 C Calculate the dipole-dipole interaction energies
5851 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5852 do i=iatel_s,iatel_e+1
5853 num_conti=num_cont_hb(i)
5860 C Calculate the local-electrostatic correlation terms
5861 do i=iatel_s,iatel_e+1
5863 num_conti=num_cont_hb(i)
5864 num_conti1=num_cont_hb(i+1)
5869 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5870 c & ' jj=',jj,' kk=',kk
5871 if (j1.eq.j+1 .or. j1.eq.j-1) then
5872 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5873 C The system gains extra energy.
5875 sqd1=dsqrt(d_cont(jj,i))
5876 sqd2=dsqrt(d_cont(kk,i1))
5877 sred_geom = sqd1*sqd2
5878 IF (sred_geom.lt.cutoff_corr) THEN
5879 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5881 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5882 c & ' jj=',jj,' kk=',kk
5883 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5884 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5886 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5887 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5890 cd write (iout,*) 'sred_geom=',sred_geom,
5891 cd & ' ekont=',ekont,' fprim=',fprimcont
5892 call calc_eello(i,j,i+1,j1,jj,kk)
5893 if (wcorr4.gt.0.0d0)
5894 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5895 if (wcorr5.gt.0.0d0)
5896 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5897 c print *,"wcorr5",ecorr5
5898 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5899 cd write(2,*)'ijkl',i,j,i+1,j1
5900 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5901 & .or. wturn6.eq.0.0d0))then
5902 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5903 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5904 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5905 cd & 'ecorr6=',ecorr6
5906 cd write (iout,'(4e15.5)') sred_geom,
5907 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5908 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5909 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5910 else if (wturn6.gt.0.0d0
5911 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5912 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5913 eturn6=eturn6+eello_turn6(i,jj,kk)
5914 cd write (2,*) 'multibody_eello:eturn6',eturn6
5918 else if (j1.eq.j) then
5919 C Contacts I-J and I-(J+1) occur simultaneously.
5920 C The system loses extra energy.
5921 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5926 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5927 c & ' jj=',jj,' kk=',kk
5929 C Contacts I-J and (I+1)-J occur simultaneously.
5930 C The system loses extra energy.
5931 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5938 c------------------------------------------------------------------------------
5939 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5940 implicit real*8 (a-h,o-z)
5941 include 'DIMENSIONS'
5942 include 'COMMON.IOUNITS'
5943 include 'COMMON.DERIV'
5944 include 'COMMON.INTERACT'
5945 include 'COMMON.CONTACTS'
5946 double precision gx(3),gx1(3)
5956 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5957 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5958 C Following 4 lines for diagnostics.
5963 cd write (iout,*)'Contacts have occurred for peptide groups',i,j,
5965 cd write (iout,*)'Contacts have occurred for peptide groups',
5966 cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5967 cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5968 C Calculate the multi-body contribution to energy.
5969 ecorr=ecorr+ekont*ees
5971 C Calculate multi-body contributions to the gradient.
5973 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5974 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5975 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5976 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5977 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5978 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5979 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5980 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5981 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5982 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5983 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5984 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5985 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5986 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5990 gradcorr(ll,m)=gradcorr(ll,m)+
5991 & ees*ekl*gacont_hbr(ll,jj,i)-
5992 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5993 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5998 gradcorr(ll,m)=gradcorr(ll,m)+
5999 & ees*eij*gacont_hbr(ll,kk,k)-
6000 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6001 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6008 C---------------------------------------------------------------------------
6009 subroutine dipole(i,j,jj)
6010 implicit real*8 (a-h,o-z)
6011 include 'DIMENSIONS'
6012 include 'DIMENSIONS.ZSCOPT'
6013 include 'COMMON.IOUNITS'
6014 include 'COMMON.CHAIN'
6015 include 'COMMON.FFIELD'
6016 include 'COMMON.DERIV'
6017 include 'COMMON.INTERACT'
6018 include 'COMMON.CONTACTS'
6019 include 'COMMON.TORSION'
6020 include 'COMMON.VAR'
6021 include 'COMMON.GEO'
6022 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6024 iti1 = itortyp(itype(i+1))
6025 if (j.lt.nres-1) then
6026 itj1 = itortyp(itype(j+1))
6031 dipi(iii,1)=Ub2(iii,i)
6032 dipderi(iii)=Ub2der(iii,i)
6033 dipi(iii,2)=b1(iii,iti1)
6034 dipj(iii,1)=Ub2(iii,j)
6035 dipderj(iii)=Ub2der(iii,j)
6036 dipj(iii,2)=b1(iii,itj1)
6040 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6043 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6046 if (.not.calc_grad) return
6051 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6055 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6060 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6061 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6063 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6065 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6067 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6071 C---------------------------------------------------------------------------
6072 subroutine calc_eello(i,j,k,l,jj,kk)
6074 C This subroutine computes matrices and vectors needed to calculate
6075 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6077 implicit real*8 (a-h,o-z)
6078 include 'DIMENSIONS'
6079 include 'DIMENSIONS.ZSCOPT'
6080 include 'COMMON.IOUNITS'
6081 include 'COMMON.CHAIN'
6082 include 'COMMON.DERIV'
6083 include 'COMMON.INTERACT'
6084 include 'COMMON.CONTACTS'
6085 include 'COMMON.TORSION'
6086 include 'COMMON.VAR'
6087 include 'COMMON.GEO'
6088 include 'COMMON.FFIELD'
6089 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6090 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6093 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6094 cd & ' jj=',jj,' kk=',kk
6095 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6098 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6099 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6102 call transpose2(aa1(1,1),aa1t(1,1))
6103 call transpose2(aa2(1,1),aa2t(1,1))
6106 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6107 & aa1tder(1,1,lll,kkk))
6108 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6109 & aa2tder(1,1,lll,kkk))
6113 C parallel orientation of the two CA-CA-CA frames.
6115 iti=itortyp(itype(i))
6119 itk1=itortyp(itype(k+1))
6120 itj=itortyp(itype(j))
6121 if (l.lt.nres-1) then
6122 itl1=itortyp(itype(l+1))
6126 C A1 kernel(j+1) A2T
6128 cd write (iout,'(3f10.5,5x,3f10.5)')
6129 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6131 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6132 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6133 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6134 C Following matrices are needed only for 6-th order cumulants
6135 IF (wcorr6.gt.0.0d0) THEN
6136 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6137 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6138 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6139 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6140 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6141 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6142 & ADtEAderx(1,1,1,1,1,1))
6144 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6145 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6146 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6147 & ADtEA1derx(1,1,1,1,1,1))
6149 C End 6-th order cumulants
6152 cd write (2,*) 'In calc_eello6'
6154 cd write (2,*) 'iii=',iii
6156 cd write (2,*) 'kkk=',kkk
6158 cd write (2,'(3(2f10.5),5x)')
6159 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6164 call transpose2(EUgder(1,1,k),auxmat(1,1))
6165 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6166 call transpose2(EUg(1,1,k),auxmat(1,1))
6167 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6168 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6172 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6173 & EAEAderx(1,1,lll,kkk,iii,1))
6177 C A1T kernel(i+1) A2
6178 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6179 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6180 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6181 C Following matrices are needed only for 6-th order cumulants
6182 IF (wcorr6.gt.0.0d0) THEN
6183 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6184 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6185 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6186 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6187 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6188 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6189 & ADtEAderx(1,1,1,1,1,2))
6190 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6191 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6192 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6193 & ADtEA1derx(1,1,1,1,1,2))
6195 C End 6-th order cumulants
6196 call transpose2(EUgder(1,1,l),auxmat(1,1))
6197 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6198 call transpose2(EUg(1,1,l),auxmat(1,1))
6199 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6200 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6204 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6205 & EAEAderx(1,1,lll,kkk,iii,2))
6210 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6211 C They are needed only when the fifth- or the sixth-order cumulants are
6213 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6214 call transpose2(AEA(1,1,1),auxmat(1,1))
6215 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6216 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6217 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6218 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6219 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6220 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6221 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6222 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6223 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6224 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6225 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6226 call transpose2(AEA(1,1,2),auxmat(1,1))
6227 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6228 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6229 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6230 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6231 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6232 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6233 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6234 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6235 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6236 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6237 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6238 C Calculate the Cartesian derivatives of the vectors.
6242 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6243 call matvec2(auxmat(1,1),b1(1,iti),
6244 & AEAb1derx(1,lll,kkk,iii,1,1))
6245 call matvec2(auxmat(1,1),Ub2(1,i),
6246 & AEAb2derx(1,lll,kkk,iii,1,1))
6247 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6248 & AEAb1derx(1,lll,kkk,iii,2,1))
6249 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6250 & AEAb2derx(1,lll,kkk,iii,2,1))
6251 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6252 call matvec2(auxmat(1,1),b1(1,itj),
6253 & AEAb1derx(1,lll,kkk,iii,1,2))
6254 call matvec2(auxmat(1,1),Ub2(1,j),
6255 & AEAb2derx(1,lll,kkk,iii,1,2))
6256 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6257 & AEAb1derx(1,lll,kkk,iii,2,2))
6258 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6259 & AEAb2derx(1,lll,kkk,iii,2,2))
6266 C Antiparallel orientation of the two CA-CA-CA frames.
6268 iti=itortyp(itype(i))
6272 itk1=itortyp(itype(k+1))
6273 itl=itortyp(itype(l))
6274 itj=itortyp(itype(j))
6275 if (j.lt.nres-1) then
6276 itj1=itortyp(itype(j+1))
6280 C A2 kernel(j-1)T A1T
6281 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6282 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6283 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6284 C Following matrices are needed only for 6-th order cumulants
6285 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6286 & j.eq.i+4 .and. l.eq.i+3)) THEN
6287 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6288 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6289 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6290 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6291 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6292 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6293 & ADtEAderx(1,1,1,1,1,1))
6294 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6295 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6296 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6297 & ADtEA1derx(1,1,1,1,1,1))
6299 C End 6-th order cumulants
6300 call transpose2(EUgder(1,1,k),auxmat(1,1))
6301 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6302 call transpose2(EUg(1,1,k),auxmat(1,1))
6303 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6304 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6308 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6309 & EAEAderx(1,1,lll,kkk,iii,1))
6313 C A2T kernel(i+1)T A1
6314 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6315 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6316 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6317 C Following matrices are needed only for 6-th order cumulants
6318 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6319 & j.eq.i+4 .and. l.eq.i+3)) THEN
6320 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6321 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6322 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6323 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6324 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6325 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6326 & ADtEAderx(1,1,1,1,1,2))
6327 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6328 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6329 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6330 & ADtEA1derx(1,1,1,1,1,2))
6332 C End 6-th order cumulants
6333 call transpose2(EUgder(1,1,j),auxmat(1,1))
6334 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6335 call transpose2(EUg(1,1,j),auxmat(1,1))
6336 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6337 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6341 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6342 & EAEAderx(1,1,lll,kkk,iii,2))
6347 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6348 C They are needed only when the fifth- or the sixth-order cumulants are
6350 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6351 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6352 call transpose2(AEA(1,1,1),auxmat(1,1))
6353 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6354 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6355 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6356 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6357 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6358 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6359 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6360 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6361 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6362 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6363 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6364 call transpose2(AEA(1,1,2),auxmat(1,1))
6365 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6366 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6367 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6368 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6369 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6370 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6371 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6372 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6373 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6374 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6375 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6376 C Calculate the Cartesian derivatives of the vectors.
6380 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6381 call matvec2(auxmat(1,1),b1(1,iti),
6382 & AEAb1derx(1,lll,kkk,iii,1,1))
6383 call matvec2(auxmat(1,1),Ub2(1,i),
6384 & AEAb2derx(1,lll,kkk,iii,1,1))
6385 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6386 & AEAb1derx(1,lll,kkk,iii,2,1))
6387 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6388 & AEAb2derx(1,lll,kkk,iii,2,1))
6389 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6390 call matvec2(auxmat(1,1),b1(1,itl),
6391 & AEAb1derx(1,lll,kkk,iii,1,2))
6392 call matvec2(auxmat(1,1),Ub2(1,l),
6393 & AEAb2derx(1,lll,kkk,iii,1,2))
6394 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6395 & AEAb1derx(1,lll,kkk,iii,2,2))
6396 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6397 & AEAb2derx(1,lll,kkk,iii,2,2))
6406 C---------------------------------------------------------------------------
6407 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6408 & KK,KKderg,AKA,AKAderg,AKAderx)
6412 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6413 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6414 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6419 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6421 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6424 cd if (lprn) write (2,*) 'In kernel'
6426 cd if (lprn) write (2,*) 'kkk=',kkk
6428 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6429 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6431 cd write (2,*) 'lll=',lll
6432 cd write (2,*) 'iii=1'
6434 cd write (2,'(3(2f10.5),5x)')
6435 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6438 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6439 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6441 cd write (2,*) 'lll=',lll
6442 cd write (2,*) 'iii=2'
6444 cd write (2,'(3(2f10.5),5x)')
6445 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6452 C---------------------------------------------------------------------------
6453 double precision function eello4(i,j,k,l,jj,kk)
6454 implicit real*8 (a-h,o-z)
6455 include 'DIMENSIONS'
6456 include 'DIMENSIONS.ZSCOPT'
6457 include 'COMMON.IOUNITS'
6458 include 'COMMON.CHAIN'
6459 include 'COMMON.DERIV'
6460 include 'COMMON.INTERACT'
6461 include 'COMMON.CONTACTS'
6462 include 'COMMON.TORSION'
6463 include 'COMMON.VAR'
6464 include 'COMMON.GEO'
6465 double precision pizda(2,2),ggg1(3),ggg2(3)
6466 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6470 cd print *,'eello4:',i,j,k,l,jj,kk
6471 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6472 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6473 cold eij=facont_hb(jj,i)
6474 cold ekl=facont_hb(kk,k)
6476 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6478 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6479 gcorr_loc(k-1)=gcorr_loc(k-1)
6480 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6482 gcorr_loc(l-1)=gcorr_loc(l-1)
6483 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6485 gcorr_loc(j-1)=gcorr_loc(j-1)
6486 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6491 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6492 & -EAEAderx(2,2,lll,kkk,iii,1)
6493 cd derx(lll,kkk,iii)=0.0d0
6497 cd gcorr_loc(l-1)=0.0d0
6498 cd gcorr_loc(j-1)=0.0d0
6499 cd gcorr_loc(k-1)=0.0d0
6501 cd write (iout,*)'Contacts have occurred for peptide groups',
6502 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6503 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6504 if (j.lt.nres-1) then
6511 if (l.lt.nres-1) then
6519 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6520 ggg1(ll)=eel4*g_contij(ll,1)
6521 ggg2(ll)=eel4*g_contij(ll,2)
6522 ghalf=0.5d0*ggg1(ll)
6524 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6525 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6526 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6527 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6528 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6529 ghalf=0.5d0*ggg2(ll)
6531 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6532 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6533 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6534 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6539 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6540 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6545 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6546 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6552 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6557 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6561 cd write (2,*) iii,gcorr_loc(iii)
6565 cd write (2,*) 'ekont',ekont
6566 cd write (iout,*) 'eello4',ekont*eel4
6569 C---------------------------------------------------------------------------
6570 double precision function eello5(i,j,k,l,jj,kk)
6571 implicit real*8 (a-h,o-z)
6572 include 'DIMENSIONS'
6573 include 'DIMENSIONS.ZSCOPT'
6574 include 'COMMON.IOUNITS'
6575 include 'COMMON.CHAIN'
6576 include 'COMMON.DERIV'
6577 include 'COMMON.INTERACT'
6578 include 'COMMON.CONTACTS'
6579 include 'COMMON.TORSION'
6580 include 'COMMON.VAR'
6581 include 'COMMON.GEO'
6582 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6583 double precision ggg1(3),ggg2(3)
6584 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6589 C /l\ / \ \ / \ / \ / C
6590 C / \ / \ \ / \ / \ / C
6591 C j| o |l1 | o | o| o | | o |o C
6592 C \ |/k\| |/ \| / |/ \| |/ \| C
6593 C \i/ \ / \ / / \ / \ C
6595 C (I) (II) (III) (IV) C
6597 C eello5_1 eello5_2 eello5_3 eello5_4 C
6599 C Antiparallel chains C
6602 C /j\ / \ \ / \ / \ / C
6603 C / \ / \ \ / \ / \ / C
6604 C j1| o |l | o | o| o | | o |o C
6605 C \ |/k\| |/ \| / |/ \| |/ \| C
6606 C \i/ \ / \ / / \ / \ C
6608 C (I) (II) (III) (IV) C
6610 C eello5_1 eello5_2 eello5_3 eello5_4 C
6612 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6614 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6615 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6620 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6622 itk=itortyp(itype(k))
6623 itl=itortyp(itype(l))
6624 itj=itortyp(itype(j))
6629 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6630 cd & eel5_3_num,eel5_4_num)
6634 derx(lll,kkk,iii)=0.0d0
6638 cd eij=facont_hb(jj,i)
6639 cd ekl=facont_hb(kk,k)
6641 cd write (iout,*)'Contacts have occurred for peptide groups',
6642 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6644 C Contribution from the graph I.
6645 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6646 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6647 call transpose2(EUg(1,1,k),auxmat(1,1))
6648 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6649 vv(1)=pizda(1,1)-pizda(2,2)
6650 vv(2)=pizda(1,2)+pizda(2,1)
6651 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6652 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6654 C Explicit gradient in virtual-dihedral angles.
6655 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6656 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6657 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6658 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6659 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6660 vv(1)=pizda(1,1)-pizda(2,2)
6661 vv(2)=pizda(1,2)+pizda(2,1)
6662 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6663 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6664 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6665 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6666 vv(1)=pizda(1,1)-pizda(2,2)
6667 vv(2)=pizda(1,2)+pizda(2,1)
6669 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6670 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6671 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6673 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6674 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6675 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6677 C Cartesian gradient
6681 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6683 vv(1)=pizda(1,1)-pizda(2,2)
6684 vv(2)=pizda(1,2)+pizda(2,1)
6685 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6686 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6687 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6694 C Contribution from graph II
6695 call transpose2(EE(1,1,itk),auxmat(1,1))
6696 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6697 vv(1)=pizda(1,1)+pizda(2,2)
6698 vv(2)=pizda(2,1)-pizda(1,2)
6699 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6700 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6702 C Explicit gradient in virtual-dihedral angles.
6703 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6704 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6705 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6706 vv(1)=pizda(1,1)+pizda(2,2)
6707 vv(2)=pizda(2,1)-pizda(1,2)
6709 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6710 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6711 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6713 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6714 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6715 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6717 C Cartesian gradient
6721 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6723 vv(1)=pizda(1,1)+pizda(2,2)
6724 vv(2)=pizda(2,1)-pizda(1,2)
6725 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6726 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6727 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6736 C Parallel orientation
6737 C Contribution from graph III
6738 call transpose2(EUg(1,1,l),auxmat(1,1))
6739 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6740 vv(1)=pizda(1,1)-pizda(2,2)
6741 vv(2)=pizda(1,2)+pizda(2,1)
6742 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6743 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6745 C Explicit gradient in virtual-dihedral angles.
6746 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6747 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6748 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6749 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6750 vv(1)=pizda(1,1)-pizda(2,2)
6751 vv(2)=pizda(1,2)+pizda(2,1)
6752 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6753 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6754 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6755 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6756 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6757 vv(1)=pizda(1,1)-pizda(2,2)
6758 vv(2)=pizda(1,2)+pizda(2,1)
6759 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6760 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6761 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6762 C Cartesian gradient
6766 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6768 vv(1)=pizda(1,1)-pizda(2,2)
6769 vv(2)=pizda(1,2)+pizda(2,1)
6770 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6771 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6772 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6778 C Contribution from graph IV
6780 call transpose2(EE(1,1,itl),auxmat(1,1))
6781 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6782 vv(1)=pizda(1,1)+pizda(2,2)
6783 vv(2)=pizda(2,1)-pizda(1,2)
6784 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6785 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6787 C Explicit gradient in virtual-dihedral angles.
6788 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6789 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6790 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6791 vv(1)=pizda(1,1)+pizda(2,2)
6792 vv(2)=pizda(2,1)-pizda(1,2)
6793 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6794 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6795 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6796 C Cartesian gradient
6800 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6802 vv(1)=pizda(1,1)+pizda(2,2)
6803 vv(2)=pizda(2,1)-pizda(1,2)
6804 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6805 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6806 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6812 C Antiparallel orientation
6813 C Contribution from graph III
6815 call transpose2(EUg(1,1,j),auxmat(1,1))
6816 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6817 vv(1)=pizda(1,1)-pizda(2,2)
6818 vv(2)=pizda(1,2)+pizda(2,1)
6819 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6820 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6822 C Explicit gradient in virtual-dihedral angles.
6823 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6824 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6825 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6826 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6827 vv(1)=pizda(1,1)-pizda(2,2)
6828 vv(2)=pizda(1,2)+pizda(2,1)
6829 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6830 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6831 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6832 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6833 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6834 vv(1)=pizda(1,1)-pizda(2,2)
6835 vv(2)=pizda(1,2)+pizda(2,1)
6836 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6837 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6838 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6839 C Cartesian gradient
6843 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6845 vv(1)=pizda(1,1)-pizda(2,2)
6846 vv(2)=pizda(1,2)+pizda(2,1)
6847 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6848 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6849 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6855 C Contribution from graph IV
6857 call transpose2(EE(1,1,itj),auxmat(1,1))
6858 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6859 vv(1)=pizda(1,1)+pizda(2,2)
6860 vv(2)=pizda(2,1)-pizda(1,2)
6861 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6862 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6864 C Explicit gradient in virtual-dihedral angles.
6865 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6866 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6867 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6868 vv(1)=pizda(1,1)+pizda(2,2)
6869 vv(2)=pizda(2,1)-pizda(1,2)
6870 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6871 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6872 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6873 C Cartesian gradient
6877 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6879 vv(1)=pizda(1,1)+pizda(2,2)
6880 vv(2)=pizda(2,1)-pizda(1,2)
6881 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6882 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6883 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6890 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6891 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6892 cd write (2,*) 'ijkl',i,j,k,l
6893 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6894 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6896 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6897 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6898 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6899 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6901 if (j.lt.nres-1) then
6908 if (l.lt.nres-1) then
6918 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6920 ggg1(ll)=eel5*g_contij(ll,1)
6921 ggg2(ll)=eel5*g_contij(ll,2)
6922 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6923 ghalf=0.5d0*ggg1(ll)
6925 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6926 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6927 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6928 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6929 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6930 ghalf=0.5d0*ggg2(ll)
6932 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6933 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6934 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6935 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6940 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6941 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6946 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6947 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6953 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6958 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6962 cd write (2,*) iii,g_corr5_loc(iii)
6966 cd write (2,*) 'ekont',ekont
6967 cd write (iout,*) 'eello5',ekont*eel5
6970 c--------------------------------------------------------------------------
6971 double precision function eello6(i,j,k,l,jj,kk)
6972 implicit real*8 (a-h,o-z)
6973 include 'DIMENSIONS'
6974 include 'DIMENSIONS.ZSCOPT'
6975 include 'COMMON.IOUNITS'
6976 include 'COMMON.CHAIN'
6977 include 'COMMON.DERIV'
6978 include 'COMMON.INTERACT'
6979 include 'COMMON.CONTACTS'
6980 include 'COMMON.TORSION'
6981 include 'COMMON.VAR'
6982 include 'COMMON.GEO'
6983 include 'COMMON.FFIELD'
6984 double precision ggg1(3),ggg2(3)
6985 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6990 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6998 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6999 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7003 derx(lll,kkk,iii)=0.0d0
7007 cd eij=facont_hb(jj,i)
7008 cd ekl=facont_hb(kk,k)
7014 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7015 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7016 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7017 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7018 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7019 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7021 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7022 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7023 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7024 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7025 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7026 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7030 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7032 C If turn contributions are considered, they will be handled separately.
7033 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7034 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7035 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7036 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7037 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7038 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7039 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7042 if (j.lt.nres-1) then
7049 if (l.lt.nres-1) then
7057 ggg1(ll)=eel6*g_contij(ll,1)
7058 ggg2(ll)=eel6*g_contij(ll,2)
7059 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7060 ghalf=0.5d0*ggg1(ll)
7062 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7063 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7064 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7065 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7066 ghalf=0.5d0*ggg2(ll)
7067 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7069 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7070 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7071 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7072 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7077 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7078 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7083 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7084 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7090 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7095 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7099 cd write (2,*) iii,g_corr6_loc(iii)
7103 cd write (2,*) 'ekont',ekont
7104 cd write (iout,*) 'eello6',ekont*eel6
7107 c--------------------------------------------------------------------------
7108 double precision function eello6_graph1(i,j,k,l,imat,swap)
7109 implicit real*8 (a-h,o-z)
7110 include 'DIMENSIONS'
7111 include 'DIMENSIONS.ZSCOPT'
7112 include 'COMMON.IOUNITS'
7113 include 'COMMON.CHAIN'
7114 include 'COMMON.DERIV'
7115 include 'COMMON.INTERACT'
7116 include 'COMMON.CONTACTS'
7117 include 'COMMON.TORSION'
7118 include 'COMMON.VAR'
7119 include 'COMMON.GEO'
7120 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7124 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7126 C Parallel Antiparallel C
7132 C \ j|/k\| / \ |/k\|l / C
7137 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7138 itk=itortyp(itype(k))
7139 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7140 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7141 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7142 call transpose2(EUgC(1,1,k),auxmat(1,1))
7143 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(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)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7148 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7149 s5=scalar2(vv(1),Dtobr2(1,i))
7150 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7151 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7152 if (.not. calc_grad) return
7153 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7154 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7155 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7156 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7157 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7158 & +scalar2(vv(1),Dtobr2der(1,i)))
7159 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7160 vv1(1)=pizda1(1,1)-pizda1(2,2)
7161 vv1(2)=pizda1(1,2)+pizda1(2,1)
7162 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7163 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7165 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7166 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7167 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7168 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7169 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7171 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7172 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7173 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7174 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7175 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7177 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7178 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7179 vv1(1)=pizda1(1,1)-pizda1(2,2)
7180 vv1(2)=pizda1(1,2)+pizda1(2,1)
7181 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7182 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7183 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7184 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7193 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7194 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7195 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7196 call transpose2(EUgC(1,1,k),auxmat(1,1))
7197 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7199 vv1(1)=pizda1(1,1)-pizda1(2,2)
7200 vv1(2)=pizda1(1,2)+pizda1(2,1)
7201 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7202 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7203 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7204 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7205 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7206 s5=scalar2(vv(1),Dtobr2(1,i))
7207 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7213 c----------------------------------------------------------------------------
7214 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7215 implicit real*8 (a-h,o-z)
7216 include 'DIMENSIONS'
7217 include 'DIMENSIONS.ZSCOPT'
7218 include 'COMMON.IOUNITS'
7219 include 'COMMON.CHAIN'
7220 include 'COMMON.DERIV'
7221 include 'COMMON.INTERACT'
7222 include 'COMMON.CONTACTS'
7223 include 'COMMON.TORSION'
7224 include 'COMMON.VAR'
7225 include 'COMMON.GEO'
7227 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7228 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7231 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7233 C Parallel Antiparallel C
7239 C \ j|/k\| \ |/k\|l C
7244 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7245 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7246 C AL 7/4/01 s1 would occur in the sixth-order moment,
7247 C but not in a cluster cumulant
7249 s1=dip(1,jj,i)*dip(1,kk,k)
7251 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7252 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7253 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7254 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7255 call transpose2(EUg(1,1,k),auxmat(1,1))
7256 call matmat2(ADtEA1(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))
7260 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7262 eello6_graph2=-(s1+s2+s3+s4)
7264 eello6_graph2=-(s2+s3+s4)
7267 if (.not. calc_grad) return
7268 C Derivatives in gamma(i-1)
7271 s1=dipderg(1,jj,i)*dip(1,kk,k)
7273 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7274 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7275 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7276 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7278 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7280 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7282 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7284 C Derivatives in gamma(k-1)
7286 s1=dip(1,jj,i)*dipderg(1,kk,k)
7288 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7289 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7290 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7291 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7292 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7293 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7294 vv(1)=pizda(1,1)-pizda(2,2)
7295 vv(2)=pizda(1,2)+pizda(2,1)
7296 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7298 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7300 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7302 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7303 C Derivatives in gamma(j-1) or gamma(l-1)
7306 s1=dipderg(3,jj,i)*dip(1,kk,k)
7308 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7309 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7310 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7311 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7312 vv(1)=pizda(1,1)-pizda(2,2)
7313 vv(2)=pizda(1,2)+pizda(2,1)
7314 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7317 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7319 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7322 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7323 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7325 C Derivatives in gamma(l-1) or gamma(j-1)
7328 s1=dip(1,jj,i)*dipderg(3,kk,k)
7330 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7331 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7332 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7333 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7334 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7335 vv(1)=pizda(1,1)-pizda(2,2)
7336 vv(2)=pizda(1,2)+pizda(2,1)
7337 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7340 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7342 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7345 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7346 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7348 C Cartesian derivatives.
7350 write (2,*) 'In eello6_graph2'
7352 write (2,*) 'iii=',iii
7354 write (2,*) 'kkk=',kkk
7356 write (2,'(3(2f10.5),5x)')
7357 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7367 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7369 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7372 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7374 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7375 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7377 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7378 call transpose2(EUg(1,1,k),auxmat(1,1))
7379 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7381 vv(1)=pizda(1,1)-pizda(2,2)
7382 vv(2)=pizda(1,2)+pizda(2,1)
7383 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7384 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7386 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7391 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7393 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7400 c----------------------------------------------------------------------------
7401 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7402 implicit real*8 (a-h,o-z)
7403 include 'DIMENSIONS'
7404 include 'DIMENSIONS.ZSCOPT'
7405 include 'COMMON.IOUNITS'
7406 include 'COMMON.CHAIN'
7407 include 'COMMON.DERIV'
7408 include 'COMMON.INTERACT'
7409 include 'COMMON.CONTACTS'
7410 include 'COMMON.TORSION'
7411 include 'COMMON.VAR'
7412 include 'COMMON.GEO'
7413 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7417 C Parallel Antiparallel C
7423 C j|/k\| / |/k\|l / C
7428 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7430 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7431 C energy moment and not to the cluster cumulant.
7432 iti=itortyp(itype(i))
7433 if (j.lt.nres-1) then
7434 itj1=itortyp(itype(j+1))
7438 itk=itortyp(itype(k))
7439 itk1=itortyp(itype(k+1))
7440 if (l.lt.nres-1) then
7441 itl1=itortyp(itype(l+1))
7446 s1=dip(4,jj,i)*dip(4,kk,k)
7448 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7449 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7450 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7451 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7452 call transpose2(EE(1,1,itk),auxmat(1,1))
7453 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7454 vv(1)=pizda(1,1)+pizda(2,2)
7455 vv(2)=pizda(2,1)-pizda(1,2)
7456 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7457 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7459 eello6_graph3=-(s1+s2+s3+s4)
7461 eello6_graph3=-(s2+s3+s4)
7464 if (.not. calc_grad) return
7465 C Derivatives in gamma(k-1)
7466 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7467 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7468 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7469 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7470 C Derivatives in gamma(l-1)
7471 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7472 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7473 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7474 vv(1)=pizda(1,1)+pizda(2,2)
7475 vv(2)=pizda(2,1)-pizda(1,2)
7476 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7477 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7478 C Cartesian derivatives.
7484 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7486 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7489 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7491 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7492 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7494 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7495 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7497 vv(1)=pizda(1,1)+pizda(2,2)
7498 vv(2)=pizda(2,1)-pizda(1,2)
7499 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7501 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7503 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7506 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7508 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7510 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7516 c----------------------------------------------------------------------------
7517 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7518 implicit real*8 (a-h,o-z)
7519 include 'DIMENSIONS'
7520 include 'DIMENSIONS.ZSCOPT'
7521 include 'COMMON.IOUNITS'
7522 include 'COMMON.CHAIN'
7523 include 'COMMON.DERIV'
7524 include 'COMMON.INTERACT'
7525 include 'COMMON.CONTACTS'
7526 include 'COMMON.TORSION'
7527 include 'COMMON.VAR'
7528 include 'COMMON.GEO'
7529 include 'COMMON.FFIELD'
7530 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7531 & auxvec1(2),auxmat1(2,2)
7533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7535 C Parallel Antiparallel C
7541 C \ j|/k\| \ |/k\|l C
7546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7548 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7549 C energy moment and not to the cluster cumulant.
7550 cd write (2,*) 'eello_graph4: wturn6',wturn6
7551 iti=itortyp(itype(i))
7552 itj=itortyp(itype(j))
7553 if (j.lt.nres-1) then
7554 itj1=itortyp(itype(j+1))
7558 itk=itortyp(itype(k))
7559 if (k.lt.nres-1) then
7560 itk1=itortyp(itype(k+1))
7564 itl=itortyp(itype(l))
7565 if (l.lt.nres-1) then
7566 itl1=itortyp(itype(l+1))
7570 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7571 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7572 cd & ' itl',itl,' itl1',itl1
7575 s1=dip(3,jj,i)*dip(3,kk,k)
7577 s1=dip(2,jj,j)*dip(2,kk,l)
7580 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7581 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7583 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7584 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7586 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7587 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7589 call transpose2(EUg(1,1,k),auxmat(1,1))
7590 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7591 vv(1)=pizda(1,1)-pizda(2,2)
7592 vv(2)=pizda(2,1)+pizda(1,2)
7593 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7594 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7596 eello6_graph4=-(s1+s2+s3+s4)
7598 eello6_graph4=-(s2+s3+s4)
7600 if (.not. calc_grad) return
7601 C Derivatives in gamma(i-1)
7605 s1=dipderg(2,jj,i)*dip(3,kk,k)
7607 s1=dipderg(4,jj,j)*dip(2,kk,l)
7610 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7612 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7613 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7615 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7616 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7618 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7619 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7620 cd write (2,*) 'turn6 derivatives'
7622 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7624 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7628 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7630 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7634 C Derivatives in gamma(k-1)
7637 s1=dip(3,jj,i)*dipderg(2,kk,k)
7639 s1=dip(2,jj,j)*dipderg(4,kk,l)
7642 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7643 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7645 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7646 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7648 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7649 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7651 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7652 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7653 vv(1)=pizda(1,1)-pizda(2,2)
7654 vv(2)=pizda(2,1)+pizda(1,2)
7655 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7656 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7658 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7660 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7664 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7666 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7669 C Derivatives in gamma(j-1) or gamma(l-1)
7670 if (l.eq.j+1 .and. l.gt.1) then
7671 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7672 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7673 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7674 vv(1)=pizda(1,1)-pizda(2,2)
7675 vv(2)=pizda(2,1)+pizda(1,2)
7676 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7677 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7678 else if (j.gt.1) then
7679 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7680 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7681 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7682 vv(1)=pizda(1,1)-pizda(2,2)
7683 vv(2)=pizda(2,1)+pizda(1,2)
7684 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7685 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7686 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7688 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7691 C Cartesian derivatives.
7698 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7700 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7704 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7706 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7710 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7712 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7714 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7715 & b1(1,itj1),auxvec(1))
7716 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7718 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7719 & b1(1,itl1),auxvec(1))
7720 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7722 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7724 vv(1)=pizda(1,1)-pizda(2,2)
7725 vv(2)=pizda(2,1)+pizda(1,2)
7726 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7728 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7730 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7733 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7736 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7739 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7741 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7743 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7747 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7749 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7752 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7754 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7762 c----------------------------------------------------------------------------
7763 double precision function eello_turn6(i,jj,kk)
7764 implicit real*8 (a-h,o-z)
7765 include 'DIMENSIONS'
7766 include 'DIMENSIONS.ZSCOPT'
7767 include 'COMMON.IOUNITS'
7768 include 'COMMON.CHAIN'
7769 include 'COMMON.DERIV'
7770 include 'COMMON.INTERACT'
7771 include 'COMMON.CONTACTS'
7772 include 'COMMON.TORSION'
7773 include 'COMMON.VAR'
7774 include 'COMMON.GEO'
7775 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7776 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7778 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7779 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7780 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7781 C the respective energy moment and not to the cluster cumulant.
7786 iti=itortyp(itype(i))
7787 itk=itortyp(itype(k))
7788 itk1=itortyp(itype(k+1))
7789 itl=itortyp(itype(l))
7790 itj=itortyp(itype(j))
7791 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7792 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7793 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7798 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7800 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7804 derx_turn(lll,kkk,iii)=0.0d0
7811 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7813 cd write (2,*) 'eello6_5',eello6_5
7815 call transpose2(AEA(1,1,1),auxmat(1,1))
7816 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7817 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7818 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7822 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7823 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7824 s2 = scalar2(b1(1,itk),vtemp1(1))
7826 call transpose2(AEA(1,1,2),atemp(1,1))
7827 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7828 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7829 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7833 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7834 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7835 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7837 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7838 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7839 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7840 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7841 ss13 = scalar2(b1(1,itk),vtemp4(1))
7842 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7846 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7852 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7854 C Derivatives in gamma(i+2)
7856 call transpose2(AEA(1,1,1),auxmatd(1,1))
7857 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7858 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7859 call transpose2(AEAderg(1,1,2),atempd(1,1))
7860 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7861 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7865 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7866 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7867 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7873 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7874 C Derivatives in gamma(i+3)
7876 call transpose2(AEA(1,1,1),auxmatd(1,1))
7877 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7878 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7879 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7883 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7884 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7885 s2d = scalar2(b1(1,itk),vtemp1d(1))
7887 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7888 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7890 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7892 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7893 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7894 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7904 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7905 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7907 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7908 & -0.5d0*ekont*(s2d+s12d)
7910 C Derivatives in gamma(i+4)
7911 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7912 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7913 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7915 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7916 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7917 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7927 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7929 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7931 C Derivatives in gamma(i+5)
7933 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7934 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7935 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7939 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7940 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7941 s2d = scalar2(b1(1,itk),vtemp1d(1))
7943 call transpose2(AEA(1,1,2),atempd(1,1))
7944 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7945 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7949 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7950 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7952 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7953 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7954 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7964 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7965 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7967 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7968 & -0.5d0*ekont*(s2d+s12d)
7970 C Cartesian derivatives
7975 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7976 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7977 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7981 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7982 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7984 s2d = scalar2(b1(1,itk),vtemp1d(1))
7986 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7987 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7988 s8d = -(atempd(1,1)+atempd(2,2))*
7989 & scalar2(cc(1,1,itl),vtemp2(1))
7993 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7995 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7996 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8003 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8006 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8010 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8011 & - 0.5d0*(s8d+s12d)
8013 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8022 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8024 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8025 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8026 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8027 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8028 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8030 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8031 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8032 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8036 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8037 cd & 16*eel_turn6_num
8039 if (j.lt.nres-1) then
8046 if (l.lt.nres-1) then
8054 ggg1(ll)=eel_turn6*g_contij(ll,1)
8055 ggg2(ll)=eel_turn6*g_contij(ll,2)
8056 ghalf=0.5d0*ggg1(ll)
8058 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8059 & +ekont*derx_turn(ll,2,1)
8060 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8061 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8062 & +ekont*derx_turn(ll,4,1)
8063 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8064 ghalf=0.5d0*ggg2(ll)
8066 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8067 & +ekont*derx_turn(ll,2,2)
8068 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8069 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8070 & +ekont*derx_turn(ll,4,2)
8071 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8076 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8081 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8087 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8092 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8096 cd write (2,*) iii,g_corr6_loc(iii)
8099 eello_turn6=ekont*eel_turn6
8100 cd write (2,*) 'ekont',ekont
8101 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8104 crc-------------------------------------------------
8105 SUBROUTINE MATVEC2(A1,V1,V2)
8106 implicit real*8 (a-h,o-z)
8107 include 'DIMENSIONS'
8108 DIMENSION A1(2,2),V1(2),V2(2)
8112 c 3 VI=VI+A1(I,K)*V1(K)
8116 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8117 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8122 C---------------------------------------
8123 SUBROUTINE MATMAT2(A1,A2,A3)
8124 implicit real*8 (a-h,o-z)
8125 include 'DIMENSIONS'
8126 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8127 c DIMENSION AI3(2,2)
8131 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8137 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8138 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8139 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8140 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8148 c-------------------------------------------------------------------------
8149 double precision function scalar2(u,v)
8151 double precision u(2),v(2)
8154 scalar2=u(1)*v(1)+u(2)*v(2)
8158 C-----------------------------------------------------------------------------
8160 subroutine transpose2(a,at)
8162 double precision a(2,2),at(2,2)
8169 c--------------------------------------------------------------------------
8170 subroutine transpose(n,a,at)
8173 double precision a(n,n),at(n,n)
8181 C---------------------------------------------------------------------------
8182 subroutine prodmat3(a1,a2,kk,transp,prod)
8185 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8187 crc double precision auxmat(2,2),prod_(2,2)
8190 crc call transpose2(kk(1,1),auxmat(1,1))
8191 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8192 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8194 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8195 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8196 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8197 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8198 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8199 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8200 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8201 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8204 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8205 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8207 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8208 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8209 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8210 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8211 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8212 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8213 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8214 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8217 c call transpose2(a2(1,1),a2t(1,1))
8220 crc print *,((prod_(i,j),i=1,2),j=1,2)
8221 crc print *,((prod(i,j),i=1,2),j=1,2)
8225 C-----------------------------------------------------------------------------
8226 double precision function scalar(u,v)
8228 double precision u(3),v(3)