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
3227 do k=1,constr_homology
3228 if(.not.l_homo(k,ii)) cycle
3229 distance(k)=odl(k,ii)-dij
3230 c write (iout,*) "distance(",k,") =",distance(k)
3232 c For Gaussian-type Urestr
3234 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3235 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3236 c write (iout,*) "distancek(",k,") =",distancek(k)
3237 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3239 c For Lorentzian-type Urestr
3241 if (waga_dist.lt.0.0d0) then
3242 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3243 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3244 & (distance(k)**2+sigma_odlir(k,ii)**2))
3248 c min_odl=minval(distancek)
3249 do kk=1,constr_homology
3250 if(l_homo(kk,ii)) then
3251 min_odl=distancek(kk)
3255 do kk=1,constr_homology
3256 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3257 & min_odl=distancek(kk)
3259 c write (iout,* )"min_odl",min_odl
3261 write (iout,*) "ij dij",i,j,dij
3262 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3263 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3264 write (iout,* )"min_odl",min_odl
3267 do k=1,constr_homology
3268 c Nie wiem po co to liczycie jeszcze raz!
3269 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3270 c & (2*(sigma_odl(i,j,k))**2))
3271 if(.not.l_homo(k,ii)) cycle
3272 if (waga_dist.ge.0.0d0) then
3274 c For Gaussian-type Urestr
3276 godl(k)=dexp(-distancek(k)+min_odl)
3277 odleg2=odleg2+godl(k)
3279 c For Lorentzian-type Urestr
3282 odleg2=odleg2+distancek(k)
3285 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3286 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3287 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3288 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3291 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3292 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3294 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3295 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3297 if (waga_dist.ge.0.0d0) then
3299 c For Gaussian-type Urestr
3301 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3303 c For Lorentzian-type Urestr
3306 odleg=odleg+odleg2/constr_homology
3310 c write (iout,*) "odleg",odleg ! sum of -ln-s
3313 c For Gaussian-type Urestr
3315 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3317 do k=1,constr_homology
3318 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3319 c & *waga_dist)+min_odl
3320 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3322 if(.not.l_homo(k,ii)) cycle
3323 if (waga_dist.ge.0.0d0) then
3324 c For Gaussian-type Urestr
3326 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3328 c For Lorentzian-type Urestr
3331 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3332 & sigma_odlir(k,ii)**2)**2)
3334 sum_sgodl=sum_sgodl+sgodl
3336 c sgodl2=sgodl2+sgodl
3337 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3338 c write(iout,*) "constr_homology=",constr_homology
3339 c write(iout,*) i, j, k, "TEST K"
3341 if (waga_dist.ge.0.0d0) then
3343 c For Gaussian-type Urestr
3345 grad_odl3=waga_homology(iset)*waga_dist
3346 & *sum_sgodl/(sum_godl*dij)
3348 c For Lorentzian-type Urestr
3351 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3352 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3353 grad_odl3=-waga_homology(iset)*waga_dist*
3354 & sum_sgodl/(constr_homology*dij)
3357 c grad_odl3=sum_sgodl/(sum_godl*dij)
3360 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3361 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3362 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3364 ccc write(iout,*) godl, sgodl, grad_odl3
3366 c grad_odl=grad_odl+grad_odl3
3369 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3370 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3371 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3372 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3373 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3374 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3375 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3376 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3377 c if (i.eq.25.and.j.eq.27) then
3378 c write(iout,*) "jik",jik,"i",i,"j",j
3379 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3380 c write(iout,*) "grad_odl3",grad_odl3
3381 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3382 c write(iout,*) "ggodl",ggodl
3383 c write(iout,*) "ghpbc(",jik,i,")",
3384 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3389 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3390 ccc & dLOG(odleg2),"-odleg=", -odleg
3392 enddo ! ii-loop for dist
3394 write(iout,*) "------- dist restrs end -------"
3395 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3396 c & waga_d.eq.1.0d0) call sum_gradient
3398 c Pseudo-energy and gradient from dihedral-angle restraints from
3399 c homology templates
3400 c write (iout,*) "End of distance loop"
3403 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3405 write(iout,*) "------- dih restrs start -------"
3406 do i=idihconstr_start_homo,idihconstr_end_homo
3407 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3410 do i=idihconstr_start_homo,idihconstr_end_homo
3412 c betai=beta(i,i+1,i+2,i+3)
3414 c write (iout,*) "betai =",betai
3415 do k=1,constr_homology
3416 dih_diff(k)=pinorm(dih(k,i)-betai)
3417 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3418 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3419 c & -(6.28318-dih_diff(i,k))
3420 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3421 c & 6.28318+dih_diff(i,k)
3423 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3424 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3427 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3430 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3431 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3433 write (iout,*) "i",i," betai",betai," kat2",kat2
3434 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3436 if (kat2.le.1.0d-14) cycle
3437 kat=kat-dLOG(kat2/constr_homology)
3438 c write (iout,*) "kat",kat ! sum of -ln-s
3440 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3441 ccc & dLOG(kat2), "-kat=", -kat
3444 c ----------------------------------------------------------------------
3446 c ----------------------------------------------------------------------
3450 do k=1,constr_homology
3451 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3452 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3453 sum_sgdih=sum_sgdih+sgdih
3455 c grad_dih3=sum_sgdih/sum_gdih
3456 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3458 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3459 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3460 ccc & gloc(nphi+i-3,icg)
3461 gloc(i,icg)=gloc(i,icg)+grad_dih3
3463 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3465 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3466 ccc & gloc(nphi+i-3,icg)
3468 enddo ! i-loop for dih
3470 write(iout,*) "------- dih restrs end -------"
3473 c Pseudo-energy and gradient for theta angle restraints from
3474 c homology templates
3475 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3479 c For constr_homology reference structures (FP)
3481 c Uconst_back_tot=0.0d0
3484 c Econstr_back legacy
3487 c do i=ithet_start,ithet_end
3490 c do i=loc_start,loc_end
3493 duscdiffx(j,i)=0.0d0
3499 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3500 c write (iout,*) "waga_theta",waga_theta
3501 if (waga_theta.gt.0.0d0) then
3503 write (iout,*) "usampl",usampl
3504 write(iout,*) "------- theta restrs start -------"
3505 c do i=ithet_start,ithet_end
3506 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3509 c write (iout,*) "maxres",maxres,"nres",nres
3511 do i=ithet_start,ithet_end
3514 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3516 c Deviation of theta angles wrt constr_homology ref structures
3518 utheta_i=0.0d0 ! argument of Gaussian for single k
3519 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3520 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3521 c over residues in a fragment
3522 c write (iout,*) "theta(",i,")=",theta(i)
3523 do k=1,constr_homology
3525 c dtheta_i=theta(j)-thetaref(j,iref)
3526 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3527 theta_diff(k)=thetatpl(k,i)-theta(i)
3529 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3530 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3531 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3532 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3533 c Gradient for single Gaussian restraint in subr Econstr_back
3534 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3537 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3538 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3542 c Gradient for multiple Gaussian restraint
3543 sum_gtheta=gutheta_i
3545 do k=1,constr_homology
3546 c New generalized expr for multiple Gaussian from Econstr_back
3547 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3549 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3550 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3553 c Final value of gradient using same var as in Econstr_back
3554 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3555 & *waga_homology(iset)
3556 c dutheta(i)=sum_sgtheta/sum_gtheta
3558 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3560 Eval=Eval-dLOG(gutheta_i/constr_homology)
3561 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3562 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3563 c Uconst_back=Uconst_back+utheta(i)
3564 enddo ! (i-loop for theta)
3566 write(iout,*) "------- theta restrs end -------"
3570 c Deviation of local SC geometry
3572 c Separation of two i-loops (instructed by AL - 11/3/2014)
3574 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3575 c write (iout,*) "waga_d",waga_d
3578 write(iout,*) "------- SC restrs start -------"
3579 write (iout,*) "Initial duscdiff,duscdiffx"
3580 do i=loc_start,loc_end
3581 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3582 & (duscdiffx(jik,i),jik=1,3)
3585 do i=loc_start,loc_end
3586 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3587 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3588 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3589 c write(iout,*) "xxtab, yytab, zztab"
3590 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3591 do k=1,constr_homology
3593 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3594 c Original sign inverted for calc of gradients (s. Econstr_back)
3595 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3596 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3597 c write(iout,*) "dxx, dyy, dzz"
3598 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3600 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3601 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3602 c uscdiffk(k)=usc_diff(i)
3603 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3604 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3605 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3606 c & xxref(j),yyref(j),zzref(j)
3611 c Generalized expression for multiple Gaussian acc to that for a single
3612 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3614 c Original implementation
3615 c sum_guscdiff=guscdiff(i)
3617 c sum_sguscdiff=0.0d0
3618 c do k=1,constr_homology
3619 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3620 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3621 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3624 c Implementation of new expressions for gradient (Jan. 2015)
3626 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3628 do k=1,constr_homology
3630 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3631 c before. Now the drivatives should be correct
3633 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3634 c Original sign inverted for calc of gradients (s. Econstr_back)
3635 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3636 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3638 c New implementation
3640 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3641 & sigma_d(k,i) ! for the grad wrt r'
3642 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3645 c New implementation
3646 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3648 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3649 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3650 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3651 duscdiff(jik,i)=duscdiff(jik,i)+
3652 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3653 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3654 duscdiffx(jik,i)=duscdiffx(jik,i)+
3655 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3656 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3659 write(iout,*) "jik",jik,"i",i
3660 write(iout,*) "dxx, dyy, dzz"
3661 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3662 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3663 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3664 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3665 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3666 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3667 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3668 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3669 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3670 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3671 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3672 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3673 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3674 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3675 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3682 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3683 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3685 c write (iout,*) i," uscdiff",uscdiff(i)
3687 c Put together deviations from local geometry
3689 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3690 c & wfrag_back(3,i,iset)*uscdiff(i)
3691 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3692 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3693 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3694 c Uconst_back=Uconst_back+usc_diff(i)
3696 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3698 c New implment: multiplied by sum_sguscdiff
3701 enddo ! (i-loop for dscdiff)
3706 write(iout,*) "------- SC restrs end -------"
3707 write (iout,*) "------ After SC loop in e_modeller ------"
3708 do i=loc_start,loc_end
3709 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3710 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3712 if (waga_theta.eq.1.0d0) then
3713 write (iout,*) "in e_modeller after SC restr end: dutheta"
3714 do i=ithet_start,ithet_end
3715 write (iout,*) i,dutheta(i)
3718 if (waga_d.eq.1.0d0) then
3719 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3721 write (iout,*) i,(duscdiff(j,i),j=1,3)
3722 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3727 c Total energy from homology restraints
3729 write (iout,*) "odleg",odleg," kat",kat
3730 write (iout,*) "odleg",odleg," kat",kat
3731 write (iout,*) "Eval",Eval," Erot",Erot
3732 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3733 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3734 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3737 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3739 c ehomology_constr=odleg+kat
3741 c For Lorentzian-type Urestr
3744 if (waga_dist.ge.0.0d0) then
3746 c For Gaussian-type Urestr
3748 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3749 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3750 ehomology_constr=waga_dist*odleg+waga_angle*kat+
3751 & waga_theta*Eval+waga_d*Erot
3752 c write (iout,*) "ehomology_constr=",ehomology_constr
3755 c For Lorentzian-type Urestr
3757 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3758 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3759 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
3760 & waga_theta*Eval+waga_d*Erot
3761 c write (iout,*) "ehomology_constr=",ehomology_constr
3764 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3765 & "Eval",waga_theta,eval,
3766 & "Erot",waga_d,Erot
3767 write (iout,*) "ehomology_constr",ehomology_constr
3771 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3772 747 format(a12,i4,i4,i4,f8.3,f8.3)
3773 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3774 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3775 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3776 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3778 c-----------------------------------------------------------------------
3779 subroutine ebond(estr)
3781 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3783 implicit real*8 (a-h,o-z)
3784 include 'DIMENSIONS'
3785 include 'DIMENSIONS.ZSCOPT'
3786 include 'DIMENSIONS.FREE'
3787 include 'COMMON.LOCAL'
3788 include 'COMMON.GEO'
3789 include 'COMMON.INTERACT'
3790 include 'COMMON.DERIV'
3791 include 'COMMON.VAR'
3792 include 'COMMON.CHAIN'
3793 include 'COMMON.IOUNITS'
3794 include 'COMMON.NAMES'
3795 include 'COMMON.FFIELD'
3796 include 'COMMON.CONTROL'
3797 double precision u(3),ud(3)
3798 logical :: lprn=.false.
3801 diff = vbld(i)-vbldp0
3802 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3805 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3810 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3817 diff=vbld(i+nres)-vbldsc0(1,iti)
3819 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3820 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3821 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3823 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3827 diff=vbld(i+nres)-vbldsc0(j,iti)
3828 ud(j)=aksc(j,iti)*diff
3829 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3843 uprod2=uprod2*u(k)*u(k)
3847 usumsqder=usumsqder+ud(j)*uprod2
3850 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3851 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3852 estr=estr+uprod/usum
3854 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3862 C--------------------------------------------------------------------------
3863 subroutine ebend(etheta)
3865 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3866 C angles gamma and its derivatives in consecutive thetas and gammas.
3868 implicit real*8 (a-h,o-z)
3869 include 'DIMENSIONS'
3870 include 'DIMENSIONS.ZSCOPT'
3871 include 'COMMON.LOCAL'
3872 include 'COMMON.GEO'
3873 include 'COMMON.INTERACT'
3874 include 'COMMON.DERIV'
3875 include 'COMMON.VAR'
3876 include 'COMMON.CHAIN'
3877 include 'COMMON.IOUNITS'
3878 include 'COMMON.NAMES'
3879 include 'COMMON.FFIELD'
3880 common /calcthet/ term1,term2,termm,diffak,ratak,
3881 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3882 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3883 double precision y(2),z(2)
3885 time11=dexp(-2*time)
3888 c write (iout,*) "nres",nres
3889 c write (*,'(a,i2)') 'EBEND ICG=',icg
3890 c write (iout,*) ithet_start,ithet_end
3891 do i=ithet_start,ithet_end
3892 C Zero the energy function and its derivative at 0 or pi.
3893 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3895 c if (i.gt.ithet_start .and.
3896 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3897 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3905 c if (i.lt.nres .and. itel(i).ne.0) then
3917 call proc_proc(phii,icrc)
3918 if (icrc.eq.1) phii=150.0
3932 call proc_proc(phii1,icrc)
3933 if (icrc.eq.1) phii1=150.0
3945 C Calculate the "mean" value of theta from the part of the distribution
3946 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3947 C In following comments this theta will be referred to as t_c.
3948 thet_pred_mean=0.0d0
3952 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3954 c write (iout,*) "thet_pred_mean",thet_pred_mean
3955 dthett=thet_pred_mean*ssd
3956 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3957 c write (iout,*) "thet_pred_mean",thet_pred_mean
3958 C Derivatives of the "mean" values in gamma1 and gamma2.
3959 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3960 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3961 if (theta(i).gt.pi-delta) then
3962 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3964 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3965 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3966 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3968 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3970 else if (theta(i).lt.delta) then
3971 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3972 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3973 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3975 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3976 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3979 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3982 etheta=etheta+ethetai
3983 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3984 c & rad2deg*phii,rad2deg*phii1,ethetai
3985 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3986 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3987 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3990 C Ufff.... We've done all this!!!
3993 C---------------------------------------------------------------------------
3994 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3996 implicit real*8 (a-h,o-z)
3997 include 'DIMENSIONS'
3998 include 'COMMON.LOCAL'
3999 include 'COMMON.IOUNITS'
4000 common /calcthet/ term1,term2,termm,diffak,ratak,
4001 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4002 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4003 C Calculate the contributions to both Gaussian lobes.
4004 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4005 C The "polynomial part" of the "standard deviation" of this part of
4009 sig=sig*thet_pred_mean+polthet(j,it)
4011 C Derivative of the "interior part" of the "standard deviation of the"
4012 C gamma-dependent Gaussian lobe in t_c.
4013 sigtc=3*polthet(3,it)
4015 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4018 C Set the parameters of both Gaussian lobes of the distribution.
4019 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4020 fac=sig*sig+sigc0(it)
4023 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4024 sigsqtc=-4.0D0*sigcsq*sigtc
4025 c print *,i,sig,sigtc,sigsqtc
4026 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4027 sigtc=-sigtc/(fac*fac)
4028 C Following variable is sigma(t_c)**(-2)
4029 sigcsq=sigcsq*sigcsq
4031 sig0inv=1.0D0/sig0i**2
4032 delthec=thetai-thet_pred_mean
4033 delthe0=thetai-theta0i
4034 term1=-0.5D0*sigcsq*delthec*delthec
4035 term2=-0.5D0*sig0inv*delthe0*delthe0
4036 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4037 C NaNs in taking the logarithm. We extract the largest exponent which is added
4038 C to the energy (this being the log of the distribution) at the end of energy
4039 C term evaluation for this virtual-bond angle.
4040 if (term1.gt.term2) then
4042 term2=dexp(term2-termm)
4046 term1=dexp(term1-termm)
4049 C The ratio between the gamma-independent and gamma-dependent lobes of
4050 C the distribution is a Gaussian function of thet_pred_mean too.
4051 diffak=gthet(2,it)-thet_pred_mean
4052 ratak=diffak/gthet(3,it)**2
4053 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4054 C Let's differentiate it in thet_pred_mean NOW.
4056 C Now put together the distribution terms to make complete distribution.
4057 termexp=term1+ak*term2
4058 termpre=sigc+ak*sig0i
4059 C Contribution of the bending energy from this theta is just the -log of
4060 C the sum of the contributions from the two lobes and the pre-exponential
4061 C factor. Simple enough, isn't it?
4062 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4063 C NOW the derivatives!!!
4064 C 6/6/97 Take into account the deformation.
4065 E_theta=(delthec*sigcsq*term1
4066 & +ak*delthe0*sig0inv*term2)/termexp
4067 E_tc=((sigtc+aktc*sig0i)/termpre
4068 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4069 & aktc*term2)/termexp)
4072 c-----------------------------------------------------------------------------
4073 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4074 implicit real*8 (a-h,o-z)
4075 include 'DIMENSIONS'
4076 include 'COMMON.LOCAL'
4077 include 'COMMON.IOUNITS'
4078 common /calcthet/ term1,term2,termm,diffak,ratak,
4079 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4080 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4081 delthec=thetai-thet_pred_mean
4082 delthe0=thetai-theta0i
4083 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4084 t3 = thetai-thet_pred_mean
4088 t14 = t12+t6*sigsqtc
4090 t21 = thetai-theta0i
4096 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4097 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4098 & *(-t12*t9-ak*sig0inv*t27)
4102 C--------------------------------------------------------------------------
4103 subroutine ebend(etheta)
4105 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4106 C angles gamma and its derivatives in consecutive thetas and gammas.
4107 C ab initio-derived potentials from
4108 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4110 implicit real*8 (a-h,o-z)
4111 include 'DIMENSIONS'
4112 include 'DIMENSIONS.ZSCOPT'
4113 include 'DIMENSIONS.FREE'
4114 include 'COMMON.LOCAL'
4115 include 'COMMON.GEO'
4116 include 'COMMON.INTERACT'
4117 include 'COMMON.DERIV'
4118 include 'COMMON.VAR'
4119 include 'COMMON.CHAIN'
4120 include 'COMMON.IOUNITS'
4121 include 'COMMON.NAMES'
4122 include 'COMMON.FFIELD'
4123 include 'COMMON.CONTROL'
4124 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4125 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4126 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4127 & sinph1ph2(maxdouble,maxdouble)
4128 logical lprn /.false./, lprn1 /.false./
4130 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4131 do i=ithet_start,ithet_end
4132 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4133 & (itype(i).eq.ntyp1)) cycle
4137 theti2=0.5d0*theta(i)
4138 ityp2=ithetyp(itype(i-1))
4140 coskt(k)=dcos(k*theti2)
4141 sinkt(k)=dsin(k*theti2)
4143 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4146 if (phii.ne.phii) phii=150.0
4150 ityp1=ithetyp(itype(i-2))
4152 cosph1(k)=dcos(k*phii)
4153 sinph1(k)=dsin(k*phii)
4157 ityp1=ithetyp(itype(i-2))
4163 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4166 if (phii1.ne.phii1) phii1=150.0
4171 ityp3=ithetyp(itype(i))
4173 cosph2(k)=dcos(k*phii1)
4174 sinph2(k)=dsin(k*phii1)
4179 ityp3=ithetyp(itype(i))
4185 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4186 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4188 ethetai=aa0thet(ityp1,ityp2,ityp3)
4191 ccl=cosph1(l)*cosph2(k-l)
4192 ssl=sinph1(l)*sinph2(k-l)
4193 scl=sinph1(l)*cosph2(k-l)
4194 csl=cosph1(l)*sinph2(k-l)
4195 cosph1ph2(l,k)=ccl-ssl
4196 cosph1ph2(k,l)=ccl+ssl
4197 sinph1ph2(l,k)=scl+csl
4198 sinph1ph2(k,l)=scl-csl
4202 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4203 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4204 write (iout,*) "coskt and sinkt"
4206 write (iout,*) k,coskt(k),sinkt(k)
4210 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4211 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4214 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4215 & " ethetai",ethetai
4218 write (iout,*) "cosph and sinph"
4220 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4222 write (iout,*) "cosph1ph2 and sinph2ph2"
4225 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4226 & sinph1ph2(l,k),sinph1ph2(k,l)
4229 write(iout,*) "ethetai",ethetai
4233 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4234 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4235 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4236 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4237 ethetai=ethetai+sinkt(m)*aux
4238 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4239 dephii=dephii+k*sinkt(m)*(
4240 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4241 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4242 dephii1=dephii1+k*sinkt(m)*(
4243 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4244 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4246 & write (iout,*) "m",m," k",k," bbthet",
4247 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4248 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4249 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4250 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4254 & write(iout,*) "ethetai",ethetai
4258 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4259 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4260 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4261 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4262 ethetai=ethetai+sinkt(m)*aux
4263 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4264 dephii=dephii+l*sinkt(m)*(
4265 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4266 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4267 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4268 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4269 dephii1=dephii1+(k-l)*sinkt(m)*(
4270 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4271 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4272 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4273 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4275 write (iout,*) "m",m," k",k," l",l," ffthet",
4276 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4277 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4278 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4279 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4280 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4281 & cosph1ph2(k,l)*sinkt(m),
4282 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4289 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4290 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4291 & phii1*rad2deg,ethetai
4293 etheta=etheta+ethetai
4295 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4296 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4297 gloc(nphi+i-2,icg)=wang*dethetai
4303 c-----------------------------------------------------------------------------
4304 subroutine esc(escloc)
4305 C Calculate the local energy of a side chain and its derivatives in the
4306 C corresponding virtual-bond valence angles THETA and the spherical angles
4308 implicit real*8 (a-h,o-z)
4309 include 'DIMENSIONS'
4310 include 'DIMENSIONS.ZSCOPT'
4311 include 'COMMON.GEO'
4312 include 'COMMON.LOCAL'
4313 include 'COMMON.VAR'
4314 include 'COMMON.INTERACT'
4315 include 'COMMON.DERIV'
4316 include 'COMMON.CHAIN'
4317 include 'COMMON.IOUNITS'
4318 include 'COMMON.NAMES'
4319 include 'COMMON.FFIELD'
4320 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4321 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4322 common /sccalc/ time11,time12,time112,theti,it,nlobit
4325 c write (iout,'(a)') 'ESC'
4326 do i=loc_start,loc_end
4328 if (it.eq.10) goto 1
4330 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4331 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4332 theti=theta(i+1)-pipol
4336 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4338 if (x(2).gt.pi-delta) then
4342 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4344 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4345 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4347 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4348 & ddersc0(1),dersc(1))
4349 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4350 & ddersc0(3),dersc(3))
4352 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4354 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4355 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4356 & dersc0(2),esclocbi,dersc02)
4357 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4359 call splinthet(x(2),0.5d0*delta,ss,ssd)
4364 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4366 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4367 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4369 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4371 c write (iout,*) escloci
4372 else if (x(2).lt.delta) then
4376 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4378 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4379 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4381 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4382 & ddersc0(1),dersc(1))
4383 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4384 & ddersc0(3),dersc(3))
4386 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4388 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4389 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4390 & dersc0(2),esclocbi,dersc02)
4391 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4396 call splinthet(x(2),0.5d0*delta,ss,ssd)
4398 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4400 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4401 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4403 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4404 c write (iout,*) escloci
4406 call enesc(x,escloci,dersc,ddummy,.false.)
4409 escloc=escloc+escloci
4410 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4412 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4414 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4415 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4420 C---------------------------------------------------------------------------
4421 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4422 implicit real*8 (a-h,o-z)
4423 include 'DIMENSIONS'
4424 include 'COMMON.GEO'
4425 include 'COMMON.LOCAL'
4426 include 'COMMON.IOUNITS'
4427 common /sccalc/ time11,time12,time112,theti,it,nlobit
4428 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4429 double precision contr(maxlob,-1:1)
4431 c write (iout,*) 'it=',it,' nlobit=',nlobit
4435 if (mixed) ddersc(j)=0.0d0
4439 C Because of periodicity of the dependence of the SC energy in omega we have
4440 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4441 C To avoid underflows, first compute & store the exponents.
4449 z(k)=x(k)-censc(k,j,it)
4454 Axk=Axk+gaussc(l,k,j,it)*z(l)
4460 expfac=expfac+Ax(k,j,iii)*z(k)
4468 C As in the case of ebend, we want to avoid underflows in exponentiation and
4469 C subsequent NaNs and INFs in energy calculation.
4470 C Find the largest exponent
4474 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4478 cd print *,'it=',it,' emin=',emin
4480 C Compute the contribution to SC energy and derivatives
4484 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4485 cd print *,'j=',j,' expfac=',expfac
4486 escloc_i=escloc_i+expfac
4488 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4492 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4493 & +gaussc(k,2,j,it))*expfac
4500 dersc(1)=dersc(1)/cos(theti)**2
4501 ddersc(1)=ddersc(1)/cos(theti)**2
4504 escloci=-(dlog(escloc_i)-emin)
4506 dersc(j)=dersc(j)/escloc_i
4510 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4515 C------------------------------------------------------------------------------
4516 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4517 implicit real*8 (a-h,o-z)
4518 include 'DIMENSIONS'
4519 include 'COMMON.GEO'
4520 include 'COMMON.LOCAL'
4521 include 'COMMON.IOUNITS'
4522 common /sccalc/ time11,time12,time112,theti,it,nlobit
4523 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4524 double precision contr(maxlob)
4535 z(k)=x(k)-censc(k,j,it)
4541 Axk=Axk+gaussc(l,k,j,it)*z(l)
4547 expfac=expfac+Ax(k,j)*z(k)
4552 C As in the case of ebend, we want to avoid underflows in exponentiation and
4553 C subsequent NaNs and INFs in energy calculation.
4554 C Find the largest exponent
4557 if (emin.gt.contr(j)) emin=contr(j)
4561 C Compute the contribution to SC energy and derivatives
4565 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4566 escloc_i=escloc_i+expfac
4568 dersc(k)=dersc(k)+Ax(k,j)*expfac
4570 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4571 & +gaussc(1,2,j,it))*expfac
4575 dersc(1)=dersc(1)/cos(theti)**2
4576 dersc12=dersc12/cos(theti)**2
4577 escloci=-(dlog(escloc_i)-emin)
4579 dersc(j)=dersc(j)/escloc_i
4581 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4585 c----------------------------------------------------------------------------------
4586 subroutine esc(escloc)
4587 C Calculate the local energy of a side chain and its derivatives in the
4588 C corresponding virtual-bond valence angles THETA and the spherical angles
4589 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4590 C added by Urszula Kozlowska. 07/11/2007
4592 implicit real*8 (a-h,o-z)
4593 include 'DIMENSIONS'
4594 include 'DIMENSIONS.ZSCOPT'
4595 include 'DIMENSIONS.FREE'
4596 include 'COMMON.GEO'
4597 include 'COMMON.LOCAL'
4598 include 'COMMON.VAR'
4599 include 'COMMON.SCROT'
4600 include 'COMMON.INTERACT'
4601 include 'COMMON.DERIV'
4602 include 'COMMON.CHAIN'
4603 include 'COMMON.IOUNITS'
4604 include 'COMMON.NAMES'
4605 include 'COMMON.FFIELD'
4606 include 'COMMON.CONTROL'
4607 include 'COMMON.VECTORS'
4608 double precision x_prime(3),y_prime(3),z_prime(3)
4609 & , sumene,dsc_i,dp2_i,x(65),
4610 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4611 & de_dxx,de_dyy,de_dzz,de_dt
4612 double precision s1_t,s1_6_t,s2_t,s2_6_t
4614 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4615 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4616 & dt_dCi(3),dt_dCi1(3)
4617 common /sccalc/ time11,time12,time112,theti,it,nlobit
4620 do i=loc_start,loc_end
4621 costtab(i+1) =dcos(theta(i+1))
4622 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4623 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4624 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4625 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4626 cosfac=dsqrt(cosfac2)
4627 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4628 sinfac=dsqrt(sinfac2)
4630 if (it.eq.10) goto 1
4632 C Compute the axes of tghe local cartesian coordinates system; store in
4633 c x_prime, y_prime and z_prime
4640 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4641 C & dc_norm(3,i+nres)
4643 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4644 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4647 z_prime(j) = -uz(j,i-1)
4650 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4651 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4652 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4653 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4654 c & " xy",scalar(x_prime(1),y_prime(1)),
4655 c & " xz",scalar(x_prime(1),z_prime(1)),
4656 c & " yy",scalar(y_prime(1),y_prime(1)),
4657 c & " yz",scalar(y_prime(1),z_prime(1)),
4658 c & " zz",scalar(z_prime(1),z_prime(1))
4660 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4661 C to local coordinate system. Store in xx, yy, zz.
4667 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4668 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4669 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4676 C Compute the energy of the ith side cbain
4678 c write (2,*) "xx",xx," yy",yy," zz",zz
4681 x(j) = sc_parmin(j,it)
4684 Cc diagnostics - remove later
4686 yy1 = dsin(alph(2))*dcos(omeg(2))
4687 zz1 = -dsin(alph(2))*dsin(omeg(2))
4688 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4689 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4691 C," --- ", xx_w,yy_w,zz_w
4694 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4695 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4697 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4698 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4700 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4701 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4702 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4703 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4704 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4706 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4707 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4708 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4709 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4710 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4712 dsc_i = 0.743d0+x(61)
4714 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4715 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4716 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4717 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4718 s1=(1+x(63))/(0.1d0 + dscp1)
4719 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4720 s2=(1+x(65))/(0.1d0 + dscp2)
4721 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4722 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4723 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4724 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4726 c & dscp1,dscp2,sumene
4727 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4728 escloc = escloc + sumene
4729 c write (2,*) "escloc",escloc
4730 if (.not. calc_grad) goto 1
4734 C This section to check the numerical derivatives of the energy of ith side
4735 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4736 C #define DEBUG in the code to turn it on.
4738 write (2,*) "sumene =",sumene
4742 write (2,*) xx,yy,zz
4743 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4744 de_dxx_num=(sumenep-sumene)/aincr
4746 write (2,*) "xx+ sumene from enesc=",sumenep
4749 write (2,*) xx,yy,zz
4750 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4751 de_dyy_num=(sumenep-sumene)/aincr
4753 write (2,*) "yy+ sumene from enesc=",sumenep
4756 write (2,*) xx,yy,zz
4757 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4758 de_dzz_num=(sumenep-sumene)/aincr
4760 write (2,*) "zz+ sumene from enesc=",sumenep
4761 costsave=cost2tab(i+1)
4762 sintsave=sint2tab(i+1)
4763 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4764 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4765 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4766 de_dt_num=(sumenep-sumene)/aincr
4767 write (2,*) " t+ sumene from enesc=",sumenep
4768 cost2tab(i+1)=costsave
4769 sint2tab(i+1)=sintsave
4770 C End of diagnostics section.
4773 C Compute the gradient of esc
4775 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4776 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4777 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4778 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4779 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4780 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4781 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4782 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4783 pom1=(sumene3*sint2tab(i+1)+sumene1)
4784 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4785 pom2=(sumene4*cost2tab(i+1)+sumene2)
4786 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4787 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4788 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4789 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4791 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4792 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4793 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4795 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4796 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4797 & +(pom1+pom2)*pom_dx
4799 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4802 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4803 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4804 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4806 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4807 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4808 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4809 & +x(59)*zz**2 +x(60)*xx*zz
4810 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4811 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4812 & +(pom1-pom2)*pom_dy
4814 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4817 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4818 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4819 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4820 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4821 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4822 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4823 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4824 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4826 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4829 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4830 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4831 & +pom1*pom_dt1+pom2*pom_dt2
4833 write(2,*), "de_dt = ", de_dt,de_dt_num
4837 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4838 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4839 cosfac2xx=cosfac2*xx
4840 sinfac2yy=sinfac2*yy
4842 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4844 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4846 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4847 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4848 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4849 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4850 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4851 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4852 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4853 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4854 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4855 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4859 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4860 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4863 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4864 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4865 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4867 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4868 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4872 dXX_Ctab(k,i)=dXX_Ci(k)
4873 dXX_C1tab(k,i)=dXX_Ci1(k)
4874 dYY_Ctab(k,i)=dYY_Ci(k)
4875 dYY_C1tab(k,i)=dYY_Ci1(k)
4876 dZZ_Ctab(k,i)=dZZ_Ci(k)
4877 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4878 dXX_XYZtab(k,i)=dXX_XYZ(k)
4879 dYY_XYZtab(k,i)=dYY_XYZ(k)
4880 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4884 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4885 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4886 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4887 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4888 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4890 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4891 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4892 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4893 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4894 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4895 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4896 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4897 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4899 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4900 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4902 C to check gradient call subroutine check_grad
4909 c------------------------------------------------------------------------------
4910 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4912 C This procedure calculates two-body contact function g(rij) and its derivative:
4915 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4918 C where x=(rij-r0ij)/delta
4920 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4923 double precision rij,r0ij,eps0ij,fcont,fprimcont
4924 double precision x,x2,x4,delta
4928 if (x.lt.-1.0D0) then
4931 else if (x.le.1.0D0) then
4934 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4935 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4942 c------------------------------------------------------------------------------
4943 subroutine splinthet(theti,delta,ss,ssder)
4944 implicit real*8 (a-h,o-z)
4945 include 'DIMENSIONS'
4946 include 'DIMENSIONS.ZSCOPT'
4947 include 'COMMON.VAR'
4948 include 'COMMON.GEO'
4951 if (theti.gt.pipol) then
4952 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4954 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4959 c------------------------------------------------------------------------------
4960 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4962 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4963 double precision ksi,ksi2,ksi3,a1,a2,a3
4964 a1=fprim0*delta/(f1-f0)
4970 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4971 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4974 c------------------------------------------------------------------------------
4975 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4977 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4978 double precision ksi,ksi2,ksi3,a1,a2,a3
4983 a2=3*(f1x-f0x)-2*fprim0x*delta
4984 a3=fprim0x*delta-2*(f1x-f0x)
4985 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4988 C-----------------------------------------------------------------------------
4990 C-----------------------------------------------------------------------------
4991 subroutine etor(etors,edihcnstr,fact)
4992 implicit real*8 (a-h,o-z)
4993 include 'DIMENSIONS'
4994 include 'DIMENSIONS.ZSCOPT'
4995 include 'COMMON.VAR'
4996 include 'COMMON.GEO'
4997 include 'COMMON.LOCAL'
4998 include 'COMMON.TORSION'
4999 include 'COMMON.INTERACT'
5000 include 'COMMON.DERIV'
5001 include 'COMMON.CHAIN'
5002 include 'COMMON.NAMES'
5003 include 'COMMON.IOUNITS'
5004 include 'COMMON.FFIELD'
5005 include 'COMMON.TORCNSTR'
5007 C Set lprn=.true. for debugging
5011 do i=iphi_start,iphi_end
5012 itori=itortyp(itype(i-2))
5013 itori1=itortyp(itype(i-1))
5016 C Proline-Proline pair is a special case...
5017 if (itori.eq.3 .and. itori1.eq.3) then
5018 if (phii.gt.-dwapi3) then
5020 fac=1.0D0/(1.0D0-cosphi)
5021 etorsi=v1(1,3,3)*fac
5022 etorsi=etorsi+etorsi
5023 etors=etors+etorsi-v1(1,3,3)
5024 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5027 v1ij=v1(j+1,itori,itori1)
5028 v2ij=v2(j+1,itori,itori1)
5031 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5032 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5036 v1ij=v1(j,itori,itori1)
5037 v2ij=v2(j,itori,itori1)
5040 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5041 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5045 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5046 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5047 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5048 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5049 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5051 ! 6/20/98 - dihedral angle constraints
5054 itori=idih_constr(i)
5057 if (difi.gt.drange(i)) then
5059 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5060 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5061 else if (difi.lt.-drange(i)) then
5063 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5064 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5066 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5067 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5069 ! write (iout,*) 'edihcnstr',edihcnstr
5072 c------------------------------------------------------------------------------
5074 subroutine etor(etors,edihcnstr,fact)
5075 implicit real*8 (a-h,o-z)
5076 include 'DIMENSIONS'
5077 include 'DIMENSIONS.ZSCOPT'
5078 include 'COMMON.VAR'
5079 include 'COMMON.GEO'
5080 include 'COMMON.LOCAL'
5081 include 'COMMON.TORSION'
5082 include 'COMMON.INTERACT'
5083 include 'COMMON.DERIV'
5084 include 'COMMON.CHAIN'
5085 include 'COMMON.NAMES'
5086 include 'COMMON.IOUNITS'
5087 include 'COMMON.FFIELD'
5088 include 'COMMON.TORCNSTR'
5090 C Set lprn=.true. for debugging
5094 do i=iphi_start,iphi_end
5095 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5096 itori=itortyp(itype(i-2))
5097 itori1=itortyp(itype(i-1))
5100 C Regular cosine and sine terms
5101 do j=1,nterm(itori,itori1)
5102 v1ij=v1(j,itori,itori1)
5103 v2ij=v2(j,itori,itori1)
5106 etors=etors+v1ij*cosphi+v2ij*sinphi
5107 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5111 C E = SUM ----------------------------------- - v1
5112 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5114 cosphi=dcos(0.5d0*phii)
5115 sinphi=dsin(0.5d0*phii)
5116 do j=1,nlor(itori,itori1)
5117 vl1ij=vlor1(j,itori,itori1)
5118 vl2ij=vlor2(j,itori,itori1)
5119 vl3ij=vlor3(j,itori,itori1)
5120 pom=vl2ij*cosphi+vl3ij*sinphi
5121 pom1=1.0d0/(pom*pom+1.0d0)
5122 etors=etors+vl1ij*pom1
5124 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5126 C Subtract the constant term
5127 etors=etors-v0(itori,itori1)
5129 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5130 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5131 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5132 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5133 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5136 ! 6/20/98 - dihedral angle constraints
5139 itori=idih_constr(i)
5141 difi=pinorm(phii-phi0(i))
5143 if (difi.gt.drange(i)) then
5145 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5146 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5147 edihi=0.25d0*ftors*difi**4
5148 else if (difi.lt.-drange(i)) then
5150 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5151 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5152 edihi=0.25d0*ftors*difi**4
5156 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5158 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5159 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5161 ! write (iout,*) 'edihcnstr',edihcnstr
5164 c----------------------------------------------------------------------------
5165 subroutine etor_d(etors_d,fact2)
5166 C 6/23/01 Compute double torsional energy
5167 implicit real*8 (a-h,o-z)
5168 include 'DIMENSIONS'
5169 include 'DIMENSIONS.ZSCOPT'
5170 include 'COMMON.VAR'
5171 include 'COMMON.GEO'
5172 include 'COMMON.LOCAL'
5173 include 'COMMON.TORSION'
5174 include 'COMMON.INTERACT'
5175 include 'COMMON.DERIV'
5176 include 'COMMON.CHAIN'
5177 include 'COMMON.NAMES'
5178 include 'COMMON.IOUNITS'
5179 include 'COMMON.FFIELD'
5180 include 'COMMON.TORCNSTR'
5182 C Set lprn=.true. for debugging
5186 do i=iphi_start,iphi_end-1
5187 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5189 itori=itortyp(itype(i-2))
5190 itori1=itortyp(itype(i-1))
5191 itori2=itortyp(itype(i))
5196 C Regular cosine and sine terms
5197 do j=1,ntermd_1(itori,itori1,itori2)
5198 v1cij=v1c(1,j,itori,itori1,itori2)
5199 v1sij=v1s(1,j,itori,itori1,itori2)
5200 v2cij=v1c(2,j,itori,itori1,itori2)
5201 v2sij=v1s(2,j,itori,itori1,itori2)
5202 cosphi1=dcos(j*phii)
5203 sinphi1=dsin(j*phii)
5204 cosphi2=dcos(j*phii1)
5205 sinphi2=dsin(j*phii1)
5206 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5207 & v2cij*cosphi2+v2sij*sinphi2
5208 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5209 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5211 do k=2,ntermd_2(itori,itori1,itori2)
5213 v1cdij = v2c(k,l,itori,itori1,itori2)
5214 v2cdij = v2c(l,k,itori,itori1,itori2)
5215 v1sdij = v2s(k,l,itori,itori1,itori2)
5216 v2sdij = v2s(l,k,itori,itori1,itori2)
5217 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5218 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5219 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5220 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5221 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5222 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5223 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5224 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5225 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5226 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5229 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5230 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5236 c------------------------------------------------------------------------------
5237 subroutine eback_sc_corr(esccor)
5238 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5239 c conformational states; temporarily implemented as differences
5240 c between UNRES torsional potentials (dependent on three types of
5241 c residues) and the torsional potentials dependent on all 20 types
5242 c of residues computed from AM1 energy surfaces of terminally-blocked
5243 c amino-acid residues.
5244 implicit real*8 (a-h,o-z)
5245 include 'DIMENSIONS'
5246 include 'DIMENSIONS.ZSCOPT'
5247 include 'DIMENSIONS.FREE'
5248 include 'COMMON.VAR'
5249 include 'COMMON.GEO'
5250 include 'COMMON.LOCAL'
5251 include 'COMMON.TORSION'
5252 include 'COMMON.SCCOR'
5253 include 'COMMON.INTERACT'
5254 include 'COMMON.DERIV'
5255 include 'COMMON.CHAIN'
5256 include 'COMMON.NAMES'
5257 include 'COMMON.IOUNITS'
5258 include 'COMMON.FFIELD'
5259 include 'COMMON.CONTROL'
5261 C Set lprn=.true. for debugging
5264 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5266 do i=itau_start,itau_end
5268 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5269 isccori=isccortyp(itype(i-2))
5270 isccori1=isccortyp(itype(i-1))
5272 cccc Added 9 May 2012
5273 cc Tauangle is torsional engle depending on the value of first digit
5274 c(see comment below)
5275 cc Omicron is flat angle depending on the value of first digit
5276 c(see comment below)
5279 do intertyp=1,3 !intertyp
5280 cc Added 09 May 2012 (Adasko)
5281 cc Intertyp means interaction type of backbone mainchain correlation:
5282 c 1 = SC...Ca...Ca...Ca
5283 c 2 = Ca...Ca...Ca...SC
5284 c 3 = SC...Ca...Ca...SCi
5286 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5287 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5288 & (itype(i-1).eq.21)))
5289 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5290 & .or.(itype(i-2).eq.21)))
5291 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5292 & (itype(i-1).eq.21)))) cycle
5293 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5294 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5296 do j=1,nterm_sccor(isccori,isccori1)
5297 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5298 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5299 cosphi=dcos(j*tauangle(intertyp,i))
5300 sinphi=dsin(j*tauangle(intertyp,i))
5301 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5303 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5305 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5307 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5308 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5309 c &gloc_sc(intertyp,i-3,icg)
5311 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5312 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5313 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5314 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5315 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5318 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5322 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5326 c------------------------------------------------------------------------------
5327 subroutine multibody(ecorr)
5328 C This subroutine calculates multi-body contributions to energy following
5329 C the idea of Skolnick et al. If side chains I and J make a contact and
5330 C at the same time side chains I+1 and J+1 make a contact, an extra
5331 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5332 implicit real*8 (a-h,o-z)
5333 include 'DIMENSIONS'
5334 include 'COMMON.IOUNITS'
5335 include 'COMMON.DERIV'
5336 include 'COMMON.INTERACT'
5337 include 'COMMON.CONTACTS'
5338 double precision gx(3),gx1(3)
5341 C Set lprn=.true. for debugging
5345 write (iout,'(a)') 'Contact function values:'
5347 write (iout,'(i2,20(1x,i2,f10.5))')
5348 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5363 num_conti=num_cont(i)
5364 num_conti1=num_cont(i1)
5369 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5370 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5371 cd & ' ishift=',ishift
5372 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5373 C The system gains extra energy.
5374 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5375 endif ! j1==j+-ishift
5384 c------------------------------------------------------------------------------
5385 double precision function esccorr(i,j,k,l,jj,kk)
5386 implicit real*8 (a-h,o-z)
5387 include 'DIMENSIONS'
5388 include 'COMMON.IOUNITS'
5389 include 'COMMON.DERIV'
5390 include 'COMMON.INTERACT'
5391 include 'COMMON.CONTACTS'
5392 double precision gx(3),gx1(3)
5397 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5398 C Calculate the multi-body contribution to energy.
5399 C Calculate multi-body contributions to the gradient.
5400 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5401 cd & k,l,(gacont(m,kk,k),m=1,3)
5403 gx(m) =ekl*gacont(m,jj,i)
5404 gx1(m)=eij*gacont(m,kk,k)
5405 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5406 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5407 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5408 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5412 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5417 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5423 c------------------------------------------------------------------------------
5425 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5426 implicit real*8 (a-h,o-z)
5427 include 'DIMENSIONS'
5428 integer dimen1,dimen2,atom,indx
5429 double precision buffer(dimen1,dimen2)
5430 double precision zapas
5431 common /contacts_hb/ zapas(3,20,maxres,7),
5432 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5433 & num_cont_hb(maxres),jcont_hb(20,maxres)
5434 num_kont=num_cont_hb(atom)
5438 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5441 buffer(i,indx+22)=facont_hb(i,atom)
5442 buffer(i,indx+23)=ees0p(i,atom)
5443 buffer(i,indx+24)=ees0m(i,atom)
5444 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5446 buffer(1,indx+26)=dfloat(num_kont)
5449 c------------------------------------------------------------------------------
5450 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5451 implicit real*8 (a-h,o-z)
5452 include 'DIMENSIONS'
5453 integer dimen1,dimen2,atom,indx
5454 double precision buffer(dimen1,dimen2)
5455 double precision zapas
5456 common /contacts_hb/ zapas(3,20,maxres,7),
5457 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5458 & num_cont_hb(maxres),jcont_hb(20,maxres)
5459 num_kont=buffer(1,indx+26)
5460 num_kont_old=num_cont_hb(atom)
5461 num_cont_hb(atom)=num_kont+num_kont_old
5466 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5469 facont_hb(ii,atom)=buffer(i,indx+22)
5470 ees0p(ii,atom)=buffer(i,indx+23)
5471 ees0m(ii,atom)=buffer(i,indx+24)
5472 jcont_hb(ii,atom)=buffer(i,indx+25)
5476 c------------------------------------------------------------------------------
5478 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5479 C This subroutine calculates multi-body contributions to hydrogen-bonding
5480 implicit real*8 (a-h,o-z)
5481 include 'DIMENSIONS'
5482 include 'DIMENSIONS.ZSCOPT'
5483 include 'COMMON.IOUNITS'
5485 include 'COMMON.INFO'
5487 include 'COMMON.FFIELD'
5488 include 'COMMON.DERIV'
5489 include 'COMMON.INTERACT'
5490 include 'COMMON.CONTACTS'
5492 parameter (max_cont=maxconts)
5493 parameter (max_dim=2*(8*3+2))
5494 parameter (msglen1=max_cont*max_dim*4)
5495 parameter (msglen2=2*msglen1)
5496 integer source,CorrelType,CorrelID,Error
5497 double precision buffer(max_cont,max_dim)
5499 double precision gx(3),gx1(3)
5502 C Set lprn=.true. for debugging
5507 if (fgProcs.le.1) goto 30
5509 write (iout,'(a)') 'Contact function values:'
5511 write (iout,'(2i3,50(1x,i2,f5.2))')
5512 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5513 & j=1,num_cont_hb(i))
5516 C Caution! Following code assumes that electrostatic interactions concerning
5517 C a given atom are split among at most two processors!
5527 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5530 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5531 if (MyRank.gt.0) then
5532 C Send correlation contributions to the preceding processor
5534 nn=num_cont_hb(iatel_s)
5535 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5536 cd write (iout,*) 'The BUFFER array:'
5538 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5540 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5542 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5543 C Clear the contacts of the atom passed to the neighboring processor
5544 nn=num_cont_hb(iatel_s+1)
5546 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5548 num_cont_hb(iatel_s)=0
5550 cd write (iout,*) 'Processor ',MyID,MyRank,
5551 cd & ' is sending correlation contribution to processor',MyID-1,
5552 cd & ' msglen=',msglen
5553 cd write (*,*) 'Processor ',MyID,MyRank,
5554 cd & ' is sending correlation contribution to processor',MyID-1,
5555 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5556 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5557 cd write (iout,*) 'Processor ',MyID,
5558 cd & ' has sent correlation contribution to processor',MyID-1,
5559 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5560 cd write (*,*) 'Processor ',MyID,
5561 cd & ' has sent correlation contribution to processor',MyID-1,
5562 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5564 endif ! (MyRank.gt.0)
5568 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5569 if (MyRank.lt.fgProcs-1) then
5570 C Receive correlation contributions from the next processor
5572 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5573 cd write (iout,*) 'Processor',MyID,
5574 cd & ' is receiving correlation contribution from processor',MyID+1,
5575 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5576 cd write (*,*) 'Processor',MyID,
5577 cd & ' is receiving correlation contribution from processor',MyID+1,
5578 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5580 do while (nbytes.le.0)
5581 call mp_probe(MyID+1,CorrelType,nbytes)
5583 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5584 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5585 cd write (iout,*) 'Processor',MyID,
5586 cd & ' has received correlation contribution from processor',MyID+1,
5587 cd & ' msglen=',msglen,' nbytes=',nbytes
5588 cd write (iout,*) 'The received BUFFER array:'
5590 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5592 if (msglen.eq.msglen1) then
5593 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5594 else if (msglen.eq.msglen2) then
5595 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5596 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5599 & 'ERROR!!!! message length changed while processing correlations.'
5601 & 'ERROR!!!! message length changed while processing correlations.'
5602 call mp_stopall(Error)
5603 endif ! msglen.eq.msglen1
5604 endif ! MyRank.lt.fgProcs-1
5611 write (iout,'(a)') 'Contact function values:'
5613 write (iout,'(2i3,50(1x,i2,f5.2))')
5614 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5615 & j=1,num_cont_hb(i))
5619 C Remove the loop below after debugging !!!
5626 C Calculate the local-electrostatic correlation terms
5627 do i=iatel_s,iatel_e+1
5629 num_conti=num_cont_hb(i)
5630 num_conti1=num_cont_hb(i+1)
5635 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5636 c & ' jj=',jj,' kk=',kk
5637 if (j1.eq.j+1 .or. j1.eq.j-1) then
5638 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5639 C The system gains extra energy.
5640 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5642 write (iout,*) "ecorr",i,j,i+1,j1,
5643 & ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5646 else if (j1.eq.j) then
5647 C Contacts I-J and I-(J+1) occur simultaneously.
5648 C The system loses extra energy.
5649 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5654 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5655 c & ' jj=',jj,' kk=',kk
5657 C Contacts I-J and (I+1)-J occur simultaneously.
5658 C The system loses extra energy.
5659 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5666 c------------------------------------------------------------------------------
5667 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5669 C This subroutine calculates multi-body contributions to hydrogen-bonding
5670 implicit real*8 (a-h,o-z)
5671 include 'DIMENSIONS'
5672 include 'DIMENSIONS.ZSCOPT'
5673 include 'COMMON.IOUNITS'
5675 include 'COMMON.INFO'
5677 include 'COMMON.FFIELD'
5678 include 'COMMON.DERIV'
5679 include 'COMMON.INTERACT'
5680 include 'COMMON.CONTACTS'
5682 parameter (max_cont=maxconts)
5683 parameter (max_dim=2*(8*3+2))
5684 parameter (msglen1=max_cont*max_dim*4)
5685 parameter (msglen2=2*msglen1)
5686 integer source,CorrelType,CorrelID,Error
5687 double precision buffer(max_cont,max_dim)
5689 double precision gx(3),gx1(3)
5692 C Set lprn=.true. for debugging
5698 if (fgProcs.le.1) goto 30
5700 write (iout,'(a)') 'Contact function values:'
5702 write (iout,'(2i3,50(1x,i2,f5.2))')
5703 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5704 & j=1,num_cont_hb(i))
5707 C Caution! Following code assumes that electrostatic interactions concerning
5708 C a given atom are split among at most two processors!
5718 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5721 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5722 if (MyRank.gt.0) then
5723 C Send correlation contributions to the preceding processor
5725 nn=num_cont_hb(iatel_s)
5726 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5727 cd write (iout,*) 'The BUFFER array:'
5729 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5731 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5733 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5734 C Clear the contacts of the atom passed to the neighboring processor
5735 nn=num_cont_hb(iatel_s+1)
5737 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5739 num_cont_hb(iatel_s)=0
5741 cd write (iout,*) 'Processor ',MyID,MyRank,
5742 cd & ' is sending correlation contribution to processor',MyID-1,
5743 cd & ' msglen=',msglen
5744 cd write (*,*) 'Processor ',MyID,MyRank,
5745 cd & ' is sending correlation contribution to processor',MyID-1,
5746 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5747 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5748 cd write (iout,*) 'Processor ',MyID,
5749 cd & ' has sent correlation contribution to processor',MyID-1,
5750 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5751 cd write (*,*) 'Processor ',MyID,
5752 cd & ' has sent correlation contribution to processor',MyID-1,
5753 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5755 endif ! (MyRank.gt.0)
5759 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5760 if (MyRank.lt.fgProcs-1) then
5761 C Receive correlation contributions from the next processor
5763 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5764 cd write (iout,*) 'Processor',MyID,
5765 cd & ' is receiving correlation contribution from processor',MyID+1,
5766 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5767 cd write (*,*) 'Processor',MyID,
5768 cd & ' is receiving correlation contribution from processor',MyID+1,
5769 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5771 do while (nbytes.le.0)
5772 call mp_probe(MyID+1,CorrelType,nbytes)
5774 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5775 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5776 cd write (iout,*) 'Processor',MyID,
5777 cd & ' has received correlation contribution from processor',MyID+1,
5778 cd & ' msglen=',msglen,' nbytes=',nbytes
5779 cd write (iout,*) 'The received BUFFER array:'
5781 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5783 if (msglen.eq.msglen1) then
5784 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5785 else if (msglen.eq.msglen2) then
5786 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5787 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5790 & 'ERROR!!!! message length changed while processing correlations.'
5792 & 'ERROR!!!! message length changed while processing correlations.'
5793 call mp_stopall(Error)
5794 endif ! msglen.eq.msglen1
5795 endif ! MyRank.lt.fgProcs-1
5802 write (iout,'(a)') 'Contact function values:'
5804 write (iout,'(2i3,50(1x,i2,f5.2))')
5805 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5806 & j=1,num_cont_hb(i))
5812 C Remove the loop below after debugging !!!
5819 C Calculate the dipole-dipole interaction energies
5820 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5821 do i=iatel_s,iatel_e+1
5822 num_conti=num_cont_hb(i)
5829 C Calculate the local-electrostatic correlation terms
5830 do i=iatel_s,iatel_e+1
5832 num_conti=num_cont_hb(i)
5833 num_conti1=num_cont_hb(i+1)
5838 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5839 c & ' jj=',jj,' kk=',kk
5840 if (j1.eq.j+1 .or. j1.eq.j-1) then
5841 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5842 C The system gains extra energy.
5844 sqd1=dsqrt(d_cont(jj,i))
5845 sqd2=dsqrt(d_cont(kk,i1))
5846 sred_geom = sqd1*sqd2
5847 IF (sred_geom.lt.cutoff_corr) THEN
5848 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5850 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5851 c & ' jj=',jj,' kk=',kk
5852 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5853 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5855 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5856 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5859 cd write (iout,*) 'sred_geom=',sred_geom,
5860 cd & ' ekont=',ekont,' fprim=',fprimcont
5861 call calc_eello(i,j,i+1,j1,jj,kk)
5862 if (wcorr4.gt.0.0d0)
5863 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5864 if (wcorr5.gt.0.0d0)
5865 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5866 c print *,"wcorr5",ecorr5
5867 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5868 cd write(2,*)'ijkl',i,j,i+1,j1
5869 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5870 & .or. wturn6.eq.0.0d0))then
5871 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5872 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5873 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5874 cd & 'ecorr6=',ecorr6
5875 cd write (iout,'(4e15.5)') sred_geom,
5876 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5877 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5878 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5879 else if (wturn6.gt.0.0d0
5880 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5881 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5882 eturn6=eturn6+eello_turn6(i,jj,kk)
5883 cd write (2,*) 'multibody_eello:eturn6',eturn6
5887 else if (j1.eq.j) then
5888 C Contacts I-J and I-(J+1) occur simultaneously.
5889 C The system loses extra energy.
5890 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5895 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5896 c & ' jj=',jj,' kk=',kk
5898 C Contacts I-J and (I+1)-J occur simultaneously.
5899 C The system loses extra energy.
5900 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5907 c------------------------------------------------------------------------------
5908 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5909 implicit real*8 (a-h,o-z)
5910 include 'DIMENSIONS'
5911 include 'COMMON.IOUNITS'
5912 include 'COMMON.DERIV'
5913 include 'COMMON.INTERACT'
5914 include 'COMMON.CONTACTS'
5915 double precision gx(3),gx1(3)
5925 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5926 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5927 C Following 4 lines for diagnostics.
5932 cd write (iout,*)'Contacts have occurred for peptide groups',i,j,
5934 cd write (iout,*)'Contacts have occurred for peptide groups',
5935 cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5936 cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5937 C Calculate the multi-body contribution to energy.
5938 ecorr=ecorr+ekont*ees
5940 C Calculate multi-body contributions to the gradient.
5942 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5943 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5944 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5945 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5946 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5947 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5948 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5949 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5950 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5951 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5952 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5953 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5954 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5955 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5959 gradcorr(ll,m)=gradcorr(ll,m)+
5960 & ees*ekl*gacont_hbr(ll,jj,i)-
5961 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5962 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5967 gradcorr(ll,m)=gradcorr(ll,m)+
5968 & ees*eij*gacont_hbr(ll,kk,k)-
5969 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5970 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5977 C---------------------------------------------------------------------------
5978 subroutine dipole(i,j,jj)
5979 implicit real*8 (a-h,o-z)
5980 include 'DIMENSIONS'
5981 include 'DIMENSIONS.ZSCOPT'
5982 include 'COMMON.IOUNITS'
5983 include 'COMMON.CHAIN'
5984 include 'COMMON.FFIELD'
5985 include 'COMMON.DERIV'
5986 include 'COMMON.INTERACT'
5987 include 'COMMON.CONTACTS'
5988 include 'COMMON.TORSION'
5989 include 'COMMON.VAR'
5990 include 'COMMON.GEO'
5991 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5993 iti1 = itortyp(itype(i+1))
5994 if (j.lt.nres-1) then
5995 itj1 = itortyp(itype(j+1))
6000 dipi(iii,1)=Ub2(iii,i)
6001 dipderi(iii)=Ub2der(iii,i)
6002 dipi(iii,2)=b1(iii,iti1)
6003 dipj(iii,1)=Ub2(iii,j)
6004 dipderj(iii)=Ub2der(iii,j)
6005 dipj(iii,2)=b1(iii,itj1)
6009 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6012 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6015 if (.not.calc_grad) return
6020 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6024 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6029 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6030 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6032 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6034 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6036 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6040 C---------------------------------------------------------------------------
6041 subroutine calc_eello(i,j,k,l,jj,kk)
6043 C This subroutine computes matrices and vectors needed to calculate
6044 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6046 implicit real*8 (a-h,o-z)
6047 include 'DIMENSIONS'
6048 include 'DIMENSIONS.ZSCOPT'
6049 include 'COMMON.IOUNITS'
6050 include 'COMMON.CHAIN'
6051 include 'COMMON.DERIV'
6052 include 'COMMON.INTERACT'
6053 include 'COMMON.CONTACTS'
6054 include 'COMMON.TORSION'
6055 include 'COMMON.VAR'
6056 include 'COMMON.GEO'
6057 include 'COMMON.FFIELD'
6058 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6059 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6062 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6063 cd & ' jj=',jj,' kk=',kk
6064 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6067 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6068 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6071 call transpose2(aa1(1,1),aa1t(1,1))
6072 call transpose2(aa2(1,1),aa2t(1,1))
6075 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6076 & aa1tder(1,1,lll,kkk))
6077 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6078 & aa2tder(1,1,lll,kkk))
6082 C parallel orientation of the two CA-CA-CA frames.
6084 iti=itortyp(itype(i))
6088 itk1=itortyp(itype(k+1))
6089 itj=itortyp(itype(j))
6090 if (l.lt.nres-1) then
6091 itl1=itortyp(itype(l+1))
6095 C A1 kernel(j+1) A2T
6097 cd write (iout,'(3f10.5,5x,3f10.5)')
6098 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6101 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6102 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6103 C Following matrices are needed only for 6-th order cumulants
6104 IF (wcorr6.gt.0.0d0) THEN
6105 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6106 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6107 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6108 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6109 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6110 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6111 & ADtEAderx(1,1,1,1,1,1))
6113 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6114 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6115 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6116 & ADtEA1derx(1,1,1,1,1,1))
6118 C End 6-th order cumulants
6121 cd write (2,*) 'In calc_eello6'
6123 cd write (2,*) 'iii=',iii
6125 cd write (2,*) 'kkk=',kkk
6127 cd write (2,'(3(2f10.5),5x)')
6128 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6133 call transpose2(EUgder(1,1,k),auxmat(1,1))
6134 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6135 call transpose2(EUg(1,1,k),auxmat(1,1))
6136 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6137 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6141 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6142 & EAEAderx(1,1,lll,kkk,iii,1))
6146 C A1T kernel(i+1) A2
6147 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6148 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6149 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6150 C Following matrices are needed only for 6-th order cumulants
6151 IF (wcorr6.gt.0.0d0) THEN
6152 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6153 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6154 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6155 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6156 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6157 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6158 & ADtEAderx(1,1,1,1,1,2))
6159 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6160 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6161 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6162 & ADtEA1derx(1,1,1,1,1,2))
6164 C End 6-th order cumulants
6165 call transpose2(EUgder(1,1,l),auxmat(1,1))
6166 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6167 call transpose2(EUg(1,1,l),auxmat(1,1))
6168 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6169 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6173 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6174 & EAEAderx(1,1,lll,kkk,iii,2))
6179 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6180 C They are needed only when the fifth- or the sixth-order cumulants are
6182 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6183 call transpose2(AEA(1,1,1),auxmat(1,1))
6184 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6185 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6186 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6187 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6188 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6189 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6190 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6191 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6192 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6193 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6194 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6195 call transpose2(AEA(1,1,2),auxmat(1,1))
6196 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6197 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6198 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6199 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6200 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6201 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6202 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6203 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6204 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6205 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6206 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6207 C Calculate the Cartesian derivatives of the vectors.
6211 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6212 call matvec2(auxmat(1,1),b1(1,iti),
6213 & AEAb1derx(1,lll,kkk,iii,1,1))
6214 call matvec2(auxmat(1,1),Ub2(1,i),
6215 & AEAb2derx(1,lll,kkk,iii,1,1))
6216 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6217 & AEAb1derx(1,lll,kkk,iii,2,1))
6218 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6219 & AEAb2derx(1,lll,kkk,iii,2,1))
6220 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6221 call matvec2(auxmat(1,1),b1(1,itj),
6222 & AEAb1derx(1,lll,kkk,iii,1,2))
6223 call matvec2(auxmat(1,1),Ub2(1,j),
6224 & AEAb2derx(1,lll,kkk,iii,1,2))
6225 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6226 & AEAb1derx(1,lll,kkk,iii,2,2))
6227 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6228 & AEAb2derx(1,lll,kkk,iii,2,2))
6235 C Antiparallel orientation of the two CA-CA-CA frames.
6237 iti=itortyp(itype(i))
6241 itk1=itortyp(itype(k+1))
6242 itl=itortyp(itype(l))
6243 itj=itortyp(itype(j))
6244 if (j.lt.nres-1) then
6245 itj1=itortyp(itype(j+1))
6249 C A2 kernel(j-1)T A1T
6250 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6251 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6252 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6253 C Following matrices are needed only for 6-th order cumulants
6254 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6255 & j.eq.i+4 .and. l.eq.i+3)) THEN
6256 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6257 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6258 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6259 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6260 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6261 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6262 & ADtEAderx(1,1,1,1,1,1))
6263 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6264 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6265 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6266 & ADtEA1derx(1,1,1,1,1,1))
6268 C End 6-th order cumulants
6269 call transpose2(EUgder(1,1,k),auxmat(1,1))
6270 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6271 call transpose2(EUg(1,1,k),auxmat(1,1))
6272 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6273 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6277 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6278 & EAEAderx(1,1,lll,kkk,iii,1))
6282 C A2T kernel(i+1)T A1
6283 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6284 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6285 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6286 C Following matrices are needed only for 6-th order cumulants
6287 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6288 & j.eq.i+4 .and. l.eq.i+3)) THEN
6289 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6290 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6291 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6292 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6293 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6294 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6295 & ADtEAderx(1,1,1,1,1,2))
6296 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6297 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6298 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6299 & ADtEA1derx(1,1,1,1,1,2))
6301 C End 6-th order cumulants
6302 call transpose2(EUgder(1,1,j),auxmat(1,1))
6303 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6304 call transpose2(EUg(1,1,j),auxmat(1,1))
6305 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6306 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6310 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6311 & EAEAderx(1,1,lll,kkk,iii,2))
6316 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6317 C They are needed only when the fifth- or the sixth-order cumulants are
6319 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6320 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6321 call transpose2(AEA(1,1,1),auxmat(1,1))
6322 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6323 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6324 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6325 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6326 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6327 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6328 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6329 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6330 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6331 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6332 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6333 call transpose2(AEA(1,1,2),auxmat(1,1))
6334 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6335 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6336 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6337 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6338 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6339 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6340 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6341 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6342 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6343 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6344 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6345 C Calculate the Cartesian derivatives of the vectors.
6349 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6350 call matvec2(auxmat(1,1),b1(1,iti),
6351 & AEAb1derx(1,lll,kkk,iii,1,1))
6352 call matvec2(auxmat(1,1),Ub2(1,i),
6353 & AEAb2derx(1,lll,kkk,iii,1,1))
6354 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6355 & AEAb1derx(1,lll,kkk,iii,2,1))
6356 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6357 & AEAb2derx(1,lll,kkk,iii,2,1))
6358 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6359 call matvec2(auxmat(1,1),b1(1,itl),
6360 & AEAb1derx(1,lll,kkk,iii,1,2))
6361 call matvec2(auxmat(1,1),Ub2(1,l),
6362 & AEAb2derx(1,lll,kkk,iii,1,2))
6363 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6364 & AEAb1derx(1,lll,kkk,iii,2,2))
6365 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6366 & AEAb2derx(1,lll,kkk,iii,2,2))
6375 C---------------------------------------------------------------------------
6376 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6377 & KK,KKderg,AKA,AKAderg,AKAderx)
6381 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6382 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6383 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6388 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6390 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6393 cd if (lprn) write (2,*) 'In kernel'
6395 cd if (lprn) write (2,*) 'kkk=',kkk
6397 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6398 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6400 cd write (2,*) 'lll=',lll
6401 cd write (2,*) 'iii=1'
6403 cd write (2,'(3(2f10.5),5x)')
6404 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6407 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6408 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6410 cd write (2,*) 'lll=',lll
6411 cd write (2,*) 'iii=2'
6413 cd write (2,'(3(2f10.5),5x)')
6414 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6421 C---------------------------------------------------------------------------
6422 double precision function eello4(i,j,k,l,jj,kk)
6423 implicit real*8 (a-h,o-z)
6424 include 'DIMENSIONS'
6425 include 'DIMENSIONS.ZSCOPT'
6426 include 'COMMON.IOUNITS'
6427 include 'COMMON.CHAIN'
6428 include 'COMMON.DERIV'
6429 include 'COMMON.INTERACT'
6430 include 'COMMON.CONTACTS'
6431 include 'COMMON.TORSION'
6432 include 'COMMON.VAR'
6433 include 'COMMON.GEO'
6434 double precision pizda(2,2),ggg1(3),ggg2(3)
6435 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6439 cd print *,'eello4:',i,j,k,l,jj,kk
6440 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6441 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6442 cold eij=facont_hb(jj,i)
6443 cold ekl=facont_hb(kk,k)
6445 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6447 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6448 gcorr_loc(k-1)=gcorr_loc(k-1)
6449 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6451 gcorr_loc(l-1)=gcorr_loc(l-1)
6452 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6454 gcorr_loc(j-1)=gcorr_loc(j-1)
6455 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6460 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6461 & -EAEAderx(2,2,lll,kkk,iii,1)
6462 cd derx(lll,kkk,iii)=0.0d0
6466 cd gcorr_loc(l-1)=0.0d0
6467 cd gcorr_loc(j-1)=0.0d0
6468 cd gcorr_loc(k-1)=0.0d0
6470 cd write (iout,*)'Contacts have occurred for peptide groups',
6471 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6472 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6473 if (j.lt.nres-1) then
6480 if (l.lt.nres-1) then
6488 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6489 ggg1(ll)=eel4*g_contij(ll,1)
6490 ggg2(ll)=eel4*g_contij(ll,2)
6491 ghalf=0.5d0*ggg1(ll)
6493 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6494 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6495 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6496 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6497 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6498 ghalf=0.5d0*ggg2(ll)
6500 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6501 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6502 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6503 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6508 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6509 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6514 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6515 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6521 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6526 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6530 cd write (2,*) iii,gcorr_loc(iii)
6534 cd write (2,*) 'ekont',ekont
6535 cd write (iout,*) 'eello4',ekont*eel4
6538 C---------------------------------------------------------------------------
6539 double precision function eello5(i,j,k,l,jj,kk)
6540 implicit real*8 (a-h,o-z)
6541 include 'DIMENSIONS'
6542 include 'DIMENSIONS.ZSCOPT'
6543 include 'COMMON.IOUNITS'
6544 include 'COMMON.CHAIN'
6545 include 'COMMON.DERIV'
6546 include 'COMMON.INTERACT'
6547 include 'COMMON.CONTACTS'
6548 include 'COMMON.TORSION'
6549 include 'COMMON.VAR'
6550 include 'COMMON.GEO'
6551 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6552 double precision ggg1(3),ggg2(3)
6553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6558 C /l\ / \ \ / \ / \ / C
6559 C / \ / \ \ / \ / \ / C
6560 C j| o |l1 | o | o| o | | o |o C
6561 C \ |/k\| |/ \| / |/ \| |/ \| C
6562 C \i/ \ / \ / / \ / \ C
6564 C (I) (II) (III) (IV) C
6566 C eello5_1 eello5_2 eello5_3 eello5_4 C
6568 C Antiparallel chains C
6571 C /j\ / \ \ / \ / \ / C
6572 C / \ / \ \ / \ / \ / C
6573 C j1| o |l | o | o| o | | o |o C
6574 C \ |/k\| |/ \| / |/ \| |/ \| C
6575 C \i/ \ / \ / / \ / \ C
6577 C (I) (II) (III) (IV) C
6579 C eello5_1 eello5_2 eello5_3 eello5_4 C
6581 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6584 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6589 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6591 itk=itortyp(itype(k))
6592 itl=itortyp(itype(l))
6593 itj=itortyp(itype(j))
6598 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6599 cd & eel5_3_num,eel5_4_num)
6603 derx(lll,kkk,iii)=0.0d0
6607 cd eij=facont_hb(jj,i)
6608 cd ekl=facont_hb(kk,k)
6610 cd write (iout,*)'Contacts have occurred for peptide groups',
6611 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6613 C Contribution from the graph I.
6614 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6615 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6616 call transpose2(EUg(1,1,k),auxmat(1,1))
6617 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6618 vv(1)=pizda(1,1)-pizda(2,2)
6619 vv(2)=pizda(1,2)+pizda(2,1)
6620 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6621 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6623 C Explicit gradient in virtual-dihedral angles.
6624 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6625 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6626 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6627 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6628 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6629 vv(1)=pizda(1,1)-pizda(2,2)
6630 vv(2)=pizda(1,2)+pizda(2,1)
6631 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6632 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6633 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6634 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6635 vv(1)=pizda(1,1)-pizda(2,2)
6636 vv(2)=pizda(1,2)+pizda(2,1)
6638 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6639 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6640 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6642 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6643 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6644 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6646 C Cartesian gradient
6650 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6652 vv(1)=pizda(1,1)-pizda(2,2)
6653 vv(2)=pizda(1,2)+pizda(2,1)
6654 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6655 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6656 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6663 C Contribution from graph II
6664 call transpose2(EE(1,1,itk),auxmat(1,1))
6665 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6666 vv(1)=pizda(1,1)+pizda(2,2)
6667 vv(2)=pizda(2,1)-pizda(1,2)
6668 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6669 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6671 C Explicit gradient in virtual-dihedral angles.
6672 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6673 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6674 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6675 vv(1)=pizda(1,1)+pizda(2,2)
6676 vv(2)=pizda(2,1)-pizda(1,2)
6678 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6679 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6680 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6682 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6683 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6684 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6686 C Cartesian gradient
6690 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6692 vv(1)=pizda(1,1)+pizda(2,2)
6693 vv(2)=pizda(2,1)-pizda(1,2)
6694 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6695 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6696 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6705 C Parallel orientation
6706 C Contribution from graph III
6707 call transpose2(EUg(1,1,l),auxmat(1,1))
6708 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6709 vv(1)=pizda(1,1)-pizda(2,2)
6710 vv(2)=pizda(1,2)+pizda(2,1)
6711 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6712 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6714 C Explicit gradient in virtual-dihedral angles.
6715 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6716 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6717 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6718 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6719 vv(1)=pizda(1,1)-pizda(2,2)
6720 vv(2)=pizda(1,2)+pizda(2,1)
6721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6722 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6723 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6724 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6725 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6726 vv(1)=pizda(1,1)-pizda(2,2)
6727 vv(2)=pizda(1,2)+pizda(2,1)
6728 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6729 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6730 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6731 C Cartesian gradient
6735 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6737 vv(1)=pizda(1,1)-pizda(2,2)
6738 vv(2)=pizda(1,2)+pizda(2,1)
6739 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6740 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6741 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6747 C Contribution from graph IV
6749 call transpose2(EE(1,1,itl),auxmat(1,1))
6750 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6751 vv(1)=pizda(1,1)+pizda(2,2)
6752 vv(2)=pizda(2,1)-pizda(1,2)
6753 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6754 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6756 C Explicit gradient in virtual-dihedral angles.
6757 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6758 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6759 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6760 vv(1)=pizda(1,1)+pizda(2,2)
6761 vv(2)=pizda(2,1)-pizda(1,2)
6762 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6763 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6764 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6765 C Cartesian gradient
6769 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6771 vv(1)=pizda(1,1)+pizda(2,2)
6772 vv(2)=pizda(2,1)-pizda(1,2)
6773 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6774 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6775 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6781 C Antiparallel orientation
6782 C Contribution from graph III
6784 call transpose2(EUg(1,1,j),auxmat(1,1))
6785 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6786 vv(1)=pizda(1,1)-pizda(2,2)
6787 vv(2)=pizda(1,2)+pizda(2,1)
6788 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6789 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6791 C Explicit gradient in virtual-dihedral angles.
6792 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6793 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6794 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6795 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6796 vv(1)=pizda(1,1)-pizda(2,2)
6797 vv(2)=pizda(1,2)+pizda(2,1)
6798 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6799 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6800 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6801 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6802 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6803 vv(1)=pizda(1,1)-pizda(2,2)
6804 vv(2)=pizda(1,2)+pizda(2,1)
6805 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6806 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6807 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6808 C Cartesian gradient
6812 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6814 vv(1)=pizda(1,1)-pizda(2,2)
6815 vv(2)=pizda(1,2)+pizda(2,1)
6816 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6817 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6818 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6824 C Contribution from graph IV
6826 call transpose2(EE(1,1,itj),auxmat(1,1))
6827 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6828 vv(1)=pizda(1,1)+pizda(2,2)
6829 vv(2)=pizda(2,1)-pizda(1,2)
6830 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6831 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6833 C Explicit gradient in virtual-dihedral angles.
6834 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6835 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6836 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6837 vv(1)=pizda(1,1)+pizda(2,2)
6838 vv(2)=pizda(2,1)-pizda(1,2)
6839 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6840 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6841 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6842 C Cartesian gradient
6846 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6848 vv(1)=pizda(1,1)+pizda(2,2)
6849 vv(2)=pizda(2,1)-pizda(1,2)
6850 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6851 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6852 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6859 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6860 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6861 cd write (2,*) 'ijkl',i,j,k,l
6862 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6863 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6865 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6866 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6867 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6868 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6870 if (j.lt.nres-1) then
6877 if (l.lt.nres-1) then
6887 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6889 ggg1(ll)=eel5*g_contij(ll,1)
6890 ggg2(ll)=eel5*g_contij(ll,2)
6891 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6892 ghalf=0.5d0*ggg1(ll)
6894 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6895 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6896 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6897 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6898 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6899 ghalf=0.5d0*ggg2(ll)
6901 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6902 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6903 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6904 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6909 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6910 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6915 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6916 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6922 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6927 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6931 cd write (2,*) iii,g_corr5_loc(iii)
6935 cd write (2,*) 'ekont',ekont
6936 cd write (iout,*) 'eello5',ekont*eel5
6939 c--------------------------------------------------------------------------
6940 double precision function eello6(i,j,k,l,jj,kk)
6941 implicit real*8 (a-h,o-z)
6942 include 'DIMENSIONS'
6943 include 'DIMENSIONS.ZSCOPT'
6944 include 'COMMON.IOUNITS'
6945 include 'COMMON.CHAIN'
6946 include 'COMMON.DERIV'
6947 include 'COMMON.INTERACT'
6948 include 'COMMON.CONTACTS'
6949 include 'COMMON.TORSION'
6950 include 'COMMON.VAR'
6951 include 'COMMON.GEO'
6952 include 'COMMON.FFIELD'
6953 double precision ggg1(3),ggg2(3)
6954 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6959 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6967 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6968 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6972 derx(lll,kkk,iii)=0.0d0
6976 cd eij=facont_hb(jj,i)
6977 cd ekl=facont_hb(kk,k)
6983 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6984 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6985 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6986 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6987 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6988 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6990 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6991 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6992 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6993 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6994 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6995 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6999 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7001 C If turn contributions are considered, they will be handled separately.
7002 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7003 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7004 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7005 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7006 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7007 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7008 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7011 if (j.lt.nres-1) then
7018 if (l.lt.nres-1) then
7026 ggg1(ll)=eel6*g_contij(ll,1)
7027 ggg2(ll)=eel6*g_contij(ll,2)
7028 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7029 ghalf=0.5d0*ggg1(ll)
7031 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7032 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7033 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7034 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7035 ghalf=0.5d0*ggg2(ll)
7036 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7038 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7039 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7040 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7041 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7046 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7047 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7052 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7053 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7059 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7064 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7068 cd write (2,*) iii,g_corr6_loc(iii)
7072 cd write (2,*) 'ekont',ekont
7073 cd write (iout,*) 'eello6',ekont*eel6
7076 c--------------------------------------------------------------------------
7077 double precision function eello6_graph1(i,j,k,l,imat,swap)
7078 implicit real*8 (a-h,o-z)
7079 include 'DIMENSIONS'
7080 include 'DIMENSIONS.ZSCOPT'
7081 include 'COMMON.IOUNITS'
7082 include 'COMMON.CHAIN'
7083 include 'COMMON.DERIV'
7084 include 'COMMON.INTERACT'
7085 include 'COMMON.CONTACTS'
7086 include 'COMMON.TORSION'
7087 include 'COMMON.VAR'
7088 include 'COMMON.GEO'
7089 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7093 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7095 C Parallel Antiparallel C
7101 C \ j|/k\| / \ |/k\|l / C
7106 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7107 itk=itortyp(itype(k))
7108 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7109 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7110 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7111 call transpose2(EUgC(1,1,k),auxmat(1,1))
7112 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7113 vv1(1)=pizda1(1,1)-pizda1(2,2)
7114 vv1(2)=pizda1(1,2)+pizda1(2,1)
7115 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7116 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7117 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7118 s5=scalar2(vv(1),Dtobr2(1,i))
7119 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7120 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7121 if (.not. calc_grad) return
7122 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7123 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7124 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7125 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7126 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7127 & +scalar2(vv(1),Dtobr2der(1,i)))
7128 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7129 vv1(1)=pizda1(1,1)-pizda1(2,2)
7130 vv1(2)=pizda1(1,2)+pizda1(2,1)
7131 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7132 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7134 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7135 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7136 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7137 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7138 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7140 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7141 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7142 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7143 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7144 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7146 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7147 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7148 vv1(1)=pizda1(1,1)-pizda1(2,2)
7149 vv1(2)=pizda1(1,2)+pizda1(2,1)
7150 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7151 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7152 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7153 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7162 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7163 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7164 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7165 call transpose2(EUgC(1,1,k),auxmat(1,1))
7166 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7168 vv1(1)=pizda1(1,1)-pizda1(2,2)
7169 vv1(2)=pizda1(1,2)+pizda1(2,1)
7170 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7171 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7172 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7173 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7174 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7175 s5=scalar2(vv(1),Dtobr2(1,i))
7176 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7182 c----------------------------------------------------------------------------
7183 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7184 implicit real*8 (a-h,o-z)
7185 include 'DIMENSIONS'
7186 include 'DIMENSIONS.ZSCOPT'
7187 include 'COMMON.IOUNITS'
7188 include 'COMMON.CHAIN'
7189 include 'COMMON.DERIV'
7190 include 'COMMON.INTERACT'
7191 include 'COMMON.CONTACTS'
7192 include 'COMMON.TORSION'
7193 include 'COMMON.VAR'
7194 include 'COMMON.GEO'
7196 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7197 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7200 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7202 C Parallel Antiparallel C
7208 C \ j|/k\| \ |/k\|l C
7213 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7214 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7215 C AL 7/4/01 s1 would occur in the sixth-order moment,
7216 C but not in a cluster cumulant
7218 s1=dip(1,jj,i)*dip(1,kk,k)
7220 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7221 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7222 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7223 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7224 call transpose2(EUg(1,1,k),auxmat(1,1))
7225 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7226 vv(1)=pizda(1,1)-pizda(2,2)
7227 vv(2)=pizda(1,2)+pizda(2,1)
7228 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7229 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7231 eello6_graph2=-(s1+s2+s3+s4)
7233 eello6_graph2=-(s2+s3+s4)
7236 if (.not. calc_grad) return
7237 C Derivatives in gamma(i-1)
7240 s1=dipderg(1,jj,i)*dip(1,kk,k)
7242 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7243 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7244 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7245 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7247 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7249 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7251 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7253 C Derivatives in gamma(k-1)
7255 s1=dip(1,jj,i)*dipderg(1,kk,k)
7257 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7258 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7259 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7260 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7261 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7262 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7263 vv(1)=pizda(1,1)-pizda(2,2)
7264 vv(2)=pizda(1,2)+pizda(2,1)
7265 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7267 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7269 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7271 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7272 C Derivatives in gamma(j-1) or gamma(l-1)
7275 s1=dipderg(3,jj,i)*dip(1,kk,k)
7277 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7278 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7279 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7280 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7281 vv(1)=pizda(1,1)-pizda(2,2)
7282 vv(2)=pizda(1,2)+pizda(2,1)
7283 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7286 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7288 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7291 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7292 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7294 C Derivatives in gamma(l-1) or gamma(j-1)
7297 s1=dip(1,jj,i)*dipderg(3,kk,k)
7299 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7300 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7301 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7302 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7303 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7304 vv(1)=pizda(1,1)-pizda(2,2)
7305 vv(2)=pizda(1,2)+pizda(2,1)
7306 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7309 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7311 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7314 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7315 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7317 C Cartesian derivatives.
7319 write (2,*) 'In eello6_graph2'
7321 write (2,*) 'iii=',iii
7323 write (2,*) 'kkk=',kkk
7325 write (2,'(3(2f10.5),5x)')
7326 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7336 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7338 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7341 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7343 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7344 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7346 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7347 call transpose2(EUg(1,1,k),auxmat(1,1))
7348 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7350 vv(1)=pizda(1,1)-pizda(2,2)
7351 vv(2)=pizda(1,2)+pizda(2,1)
7352 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7353 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7355 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7357 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7360 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7362 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7369 c----------------------------------------------------------------------------
7370 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7371 implicit real*8 (a-h,o-z)
7372 include 'DIMENSIONS'
7373 include 'DIMENSIONS.ZSCOPT'
7374 include 'COMMON.IOUNITS'
7375 include 'COMMON.CHAIN'
7376 include 'COMMON.DERIV'
7377 include 'COMMON.INTERACT'
7378 include 'COMMON.CONTACTS'
7379 include 'COMMON.TORSION'
7380 include 'COMMON.VAR'
7381 include 'COMMON.GEO'
7382 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7384 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7386 C Parallel Antiparallel C
7392 C j|/k\| / |/k\|l / C
7397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7399 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7400 C energy moment and not to the cluster cumulant.
7401 iti=itortyp(itype(i))
7402 if (j.lt.nres-1) then
7403 itj1=itortyp(itype(j+1))
7407 itk=itortyp(itype(k))
7408 itk1=itortyp(itype(k+1))
7409 if (l.lt.nres-1) then
7410 itl1=itortyp(itype(l+1))
7415 s1=dip(4,jj,i)*dip(4,kk,k)
7417 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7418 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7419 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7420 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7421 call transpose2(EE(1,1,itk),auxmat(1,1))
7422 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7423 vv(1)=pizda(1,1)+pizda(2,2)
7424 vv(2)=pizda(2,1)-pizda(1,2)
7425 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7426 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7428 eello6_graph3=-(s1+s2+s3+s4)
7430 eello6_graph3=-(s2+s3+s4)
7433 if (.not. calc_grad) return
7434 C Derivatives in gamma(k-1)
7435 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7436 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7437 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7438 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7439 C Derivatives in gamma(l-1)
7440 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7441 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7442 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7443 vv(1)=pizda(1,1)+pizda(2,2)
7444 vv(2)=pizda(2,1)-pizda(1,2)
7445 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7446 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7447 C Cartesian derivatives.
7453 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7455 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7458 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7460 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7461 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7463 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7464 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7466 vv(1)=pizda(1,1)+pizda(2,2)
7467 vv(2)=pizda(2,1)-pizda(1,2)
7468 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7470 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7472 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7475 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7477 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7479 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7485 c----------------------------------------------------------------------------
7486 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7487 implicit real*8 (a-h,o-z)
7488 include 'DIMENSIONS'
7489 include 'DIMENSIONS.ZSCOPT'
7490 include 'COMMON.IOUNITS'
7491 include 'COMMON.CHAIN'
7492 include 'COMMON.DERIV'
7493 include 'COMMON.INTERACT'
7494 include 'COMMON.CONTACTS'
7495 include 'COMMON.TORSION'
7496 include 'COMMON.VAR'
7497 include 'COMMON.GEO'
7498 include 'COMMON.FFIELD'
7499 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7500 & auxvec1(2),auxmat1(2,2)
7502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7504 C Parallel Antiparallel C
7510 C \ j|/k\| \ |/k\|l C
7515 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7517 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7518 C energy moment and not to the cluster cumulant.
7519 cd write (2,*) 'eello_graph4: wturn6',wturn6
7520 iti=itortyp(itype(i))
7521 itj=itortyp(itype(j))
7522 if (j.lt.nres-1) then
7523 itj1=itortyp(itype(j+1))
7527 itk=itortyp(itype(k))
7528 if (k.lt.nres-1) then
7529 itk1=itortyp(itype(k+1))
7533 itl=itortyp(itype(l))
7534 if (l.lt.nres-1) then
7535 itl1=itortyp(itype(l+1))
7539 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7540 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7541 cd & ' itl',itl,' itl1',itl1
7544 s1=dip(3,jj,i)*dip(3,kk,k)
7546 s1=dip(2,jj,j)*dip(2,kk,l)
7549 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7550 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7552 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7553 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7555 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7556 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7558 call transpose2(EUg(1,1,k),auxmat(1,1))
7559 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7560 vv(1)=pizda(1,1)-pizda(2,2)
7561 vv(2)=pizda(2,1)+pizda(1,2)
7562 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7563 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7565 eello6_graph4=-(s1+s2+s3+s4)
7567 eello6_graph4=-(s2+s3+s4)
7569 if (.not. calc_grad) return
7570 C Derivatives in gamma(i-1)
7574 s1=dipderg(2,jj,i)*dip(3,kk,k)
7576 s1=dipderg(4,jj,j)*dip(2,kk,l)
7579 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7581 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7582 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7584 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7585 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7587 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7588 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7589 cd write (2,*) 'turn6 derivatives'
7591 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7593 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7597 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7599 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7603 C Derivatives in gamma(k-1)
7606 s1=dip(3,jj,i)*dipderg(2,kk,k)
7608 s1=dip(2,jj,j)*dipderg(4,kk,l)
7611 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7612 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7614 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7615 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7617 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7618 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7620 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7621 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7622 vv(1)=pizda(1,1)-pizda(2,2)
7623 vv(2)=pizda(2,1)+pizda(1,2)
7624 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7625 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7627 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7629 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7633 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7635 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7638 C Derivatives in gamma(j-1) or gamma(l-1)
7639 if (l.eq.j+1 .and. l.gt.1) then
7640 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7641 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7642 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(2,1)+pizda(1,2)
7645 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7646 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7647 else if (j.gt.1) then
7648 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7649 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7650 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7651 vv(1)=pizda(1,1)-pizda(2,2)
7652 vv(2)=pizda(2,1)+pizda(1,2)
7653 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7654 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7655 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7657 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7660 C Cartesian derivatives.
7667 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7669 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7673 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7675 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7679 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7681 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7683 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7684 & b1(1,itj1),auxvec(1))
7685 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7687 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7688 & b1(1,itl1),auxvec(1))
7689 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7691 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7693 vv(1)=pizda(1,1)-pizda(2,2)
7694 vv(2)=pizda(2,1)+pizda(1,2)
7695 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7697 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7699 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7702 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7705 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7708 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7710 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7712 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7718 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7721 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7723 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7731 c----------------------------------------------------------------------------
7732 double precision function eello_turn6(i,jj,kk)
7733 implicit real*8 (a-h,o-z)
7734 include 'DIMENSIONS'
7735 include 'DIMENSIONS.ZSCOPT'
7736 include 'COMMON.IOUNITS'
7737 include 'COMMON.CHAIN'
7738 include 'COMMON.DERIV'
7739 include 'COMMON.INTERACT'
7740 include 'COMMON.CONTACTS'
7741 include 'COMMON.TORSION'
7742 include 'COMMON.VAR'
7743 include 'COMMON.GEO'
7744 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7745 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7747 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7748 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7749 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7750 C the respective energy moment and not to the cluster cumulant.
7755 iti=itortyp(itype(i))
7756 itk=itortyp(itype(k))
7757 itk1=itortyp(itype(k+1))
7758 itl=itortyp(itype(l))
7759 itj=itortyp(itype(j))
7760 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7761 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7762 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7767 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7769 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7773 derx_turn(lll,kkk,iii)=0.0d0
7780 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7782 cd write (2,*) 'eello6_5',eello6_5
7784 call transpose2(AEA(1,1,1),auxmat(1,1))
7785 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7786 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7787 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7791 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7792 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7793 s2 = scalar2(b1(1,itk),vtemp1(1))
7795 call transpose2(AEA(1,1,2),atemp(1,1))
7796 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7797 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7798 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7802 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7803 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7804 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7806 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7807 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7808 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7809 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7810 ss13 = scalar2(b1(1,itk),vtemp4(1))
7811 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7815 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7821 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7823 C Derivatives in gamma(i+2)
7825 call transpose2(AEA(1,1,1),auxmatd(1,1))
7826 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7827 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7828 call transpose2(AEAderg(1,1,2),atempd(1,1))
7829 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7830 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7834 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7835 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7836 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7842 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7843 C Derivatives in gamma(i+3)
7845 call transpose2(AEA(1,1,1),auxmatd(1,1))
7846 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7847 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7848 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7852 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7853 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7854 s2d = scalar2(b1(1,itk),vtemp1d(1))
7856 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7857 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7859 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7861 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7862 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7863 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7873 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7874 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7876 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7877 & -0.5d0*ekont*(s2d+s12d)
7879 C Derivatives in gamma(i+4)
7880 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7881 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7882 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7884 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7885 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7886 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7896 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7898 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7900 C Derivatives in gamma(i+5)
7902 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7903 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7904 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7908 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7909 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7910 s2d = scalar2(b1(1,itk),vtemp1d(1))
7912 call transpose2(AEA(1,1,2),atempd(1,1))
7913 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7914 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7918 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7919 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7921 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7922 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7923 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7933 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7934 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7936 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7937 & -0.5d0*ekont*(s2d+s12d)
7939 C Cartesian derivatives
7944 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7945 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7946 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7950 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7951 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7953 s2d = scalar2(b1(1,itk),vtemp1d(1))
7955 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7956 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7957 s8d = -(atempd(1,1)+atempd(2,2))*
7958 & scalar2(cc(1,1,itl),vtemp2(1))
7962 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7964 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7965 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7972 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7975 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7979 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7980 & - 0.5d0*(s8d+s12d)
7982 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7991 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7993 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7994 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7995 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7996 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7997 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7999 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8000 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8001 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8005 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8006 cd & 16*eel_turn6_num
8008 if (j.lt.nres-1) then
8015 if (l.lt.nres-1) then
8023 ggg1(ll)=eel_turn6*g_contij(ll,1)
8024 ggg2(ll)=eel_turn6*g_contij(ll,2)
8025 ghalf=0.5d0*ggg1(ll)
8027 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8028 & +ekont*derx_turn(ll,2,1)
8029 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8030 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8031 & +ekont*derx_turn(ll,4,1)
8032 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8033 ghalf=0.5d0*ggg2(ll)
8035 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8036 & +ekont*derx_turn(ll,2,2)
8037 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8038 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8039 & +ekont*derx_turn(ll,4,2)
8040 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8045 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8050 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8056 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8061 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8065 cd write (2,*) iii,g_corr6_loc(iii)
8068 eello_turn6=ekont*eel_turn6
8069 cd write (2,*) 'ekont',ekont
8070 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8073 crc-------------------------------------------------
8074 SUBROUTINE MATVEC2(A1,V1,V2)
8075 implicit real*8 (a-h,o-z)
8076 include 'DIMENSIONS'
8077 DIMENSION A1(2,2),V1(2),V2(2)
8081 c 3 VI=VI+A1(I,K)*V1(K)
8085 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8086 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8091 C---------------------------------------
8092 SUBROUTINE MATMAT2(A1,A2,A3)
8093 implicit real*8 (a-h,o-z)
8094 include 'DIMENSIONS'
8095 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8096 c DIMENSION AI3(2,2)
8100 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8106 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8107 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8108 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8109 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8117 c-------------------------------------------------------------------------
8118 double precision function scalar2(u,v)
8120 double precision u(2),v(2)
8123 scalar2=u(1)*v(1)+u(2)*v(2)
8127 C-----------------------------------------------------------------------------
8129 subroutine transpose2(a,at)
8131 double precision a(2,2),at(2,2)
8138 c--------------------------------------------------------------------------
8139 subroutine transpose(n,a,at)
8142 double precision a(n,n),at(n,n)
8150 C---------------------------------------------------------------------------
8151 subroutine prodmat3(a1,a2,kk,transp,prod)
8154 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8156 crc double precision auxmat(2,2),prod_(2,2)
8159 crc call transpose2(kk(1,1),auxmat(1,1))
8160 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8161 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8163 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8164 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8165 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8166 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8167 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8168 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8169 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8170 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8173 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8174 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8176 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8177 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8178 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8179 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8180 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8181 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8182 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8183 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8186 c call transpose2(a2(1,1),a2t(1,1))
8189 crc print *,((prod_(i,j),i=1,2),j=1,2)
8190 crc print *,((prod(i,j),i=1,2),j=1,2)
8194 C-----------------------------------------------------------------------------
8195 double precision function scalar(u,v)
8197 double precision u(3),v(3)