1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 double precision fact(6)
27 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
28 cd print *,'nnt=',nnt,' nct=',nct
30 C Compute the side-chain and electrostatic interaction energy
32 goto (101,102,103,104,105) ipot
33 C Lennard-Jones potential.
34 101 call elj(evdw,evdw_t)
35 cd print '(a)','Exit ELJ'
37 C Lennard-Jones-Kihara potential (shifted).
38 102 call eljk(evdw,evdw_t)
40 C Berne-Pechukas potential (dilated LJ, angular dependence).
41 103 call ebp(evdw,evdw_t)
43 C Gay-Berne potential (shifted LJ, angular dependence).
44 104 call egb(evdw,evdw_t)
46 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
47 105 call egbv(evdw,evdw_t)
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
53 C Calculate excluded-volume interaction energy between peptide groups
56 call escp(evdw2,evdw2_14)
58 c Calculate the bond-stretching energy
61 c write (iout,*) "estr",estr
63 C Calculate the disulfide-bridge and other energy and the contributions
64 C from other distance constraints.
65 cd print *,'Calling EHPB'
67 cd print *,'EHPB exitted succesfully.'
69 C Calculate the virtual-bond-angle energy.
72 cd print *,'Bend energy finished.'
74 C Calculate the SC local energy.
77 cd print *,'SCLOC energy finished.'
79 C Calculate the virtual-bond torsional energy.
81 cd print *,'nterm=',nterm
82 call etor(etors,edihcnstr,fact(1))
84 C 6/23/01 Calculate double-torsional energy
86 call etor_d(etors_d,fact(2))
88 C 21/5/07 Calculate local sicdechain correlation energy
90 call eback_sc_corr(esccor)
92 C 12/1/95 Multi-body terms
96 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
97 & .or. wturn6.gt.0.0d0) then
98 c print *,"calling multibody_eello"
99 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
100 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
101 c print *,ecorr,ecorr5,ecorr6,eturn6
103 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
104 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
108 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
109 if (constr_homology.ge.1) then
110 call e_modeller(ehomology_constr)
112 ehomology_constr=0.0d0
115 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
117 C BARTEK for dfa test!
118 if (wdfa_dist.gt.0) call edfad(edfadis)
119 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
120 if (wdfa_tor.gt.0) call edfat(edfator)
121 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
122 if (wdfa_nei.gt.0) call edfan(edfanei)
123 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
124 if (wdfa_beta.gt.0) call edfab(edfabet)
125 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
127 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
129 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
131 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
132 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
133 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
134 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
135 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
136 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
137 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
140 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
141 & +welec*fact(1)*(ees+evdw1)
142 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
143 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
144 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
145 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
146 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
147 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
148 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
154 energia(2)=evdw2-evdw2_14
171 energia(8)=eello_turn3
172 energia(9)=eello_turn4
181 energia(20)=edihcnstr
183 energia(22)=ehomology_constr
188 c if (dyn_ss) call dyn_set_nss
192 if (isnan(etot).ne.0) energia(0)=1.0d+99
194 if (isnan(etot)) energia(0)=1.0d+99
199 idumm=proc_proc(etot,i)
201 call proc_proc(etot,i)
203 if(i.eq.1)energia(0)=1.0d+99
210 C Sum up the components of the Cartesian gradient.
215 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
216 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
218 & wstrain*ghpbc(j,i)+
219 & wcorr*fact(3)*gradcorr(j,i)+
220 & wel_loc*fact(2)*gel_loc(j,i)+
221 & wturn3*fact(2)*gcorr3_turn(j,i)+
222 & wturn4*fact(3)*gcorr4_turn(j,i)+
223 & wcorr5*fact(4)*gradcorr5(j,i)+
224 & wcorr6*fact(5)*gradcorr6(j,i)+
225 & wturn6*fact(5)*gcorr6_turn(j,i)+
226 & wsccor*fact(2)*gsccorc(j,i)+
227 & wdfa_dist*gdfad(j,i)+
228 & wdfa_tor*gdfat(j,i)+
229 & wdfa_nei*gdfan(j,i)+
230 & wdfa_beta*gdfab(j,i)
231 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
233 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
234 & wsccor*fact(2)*gsccorx(j,i)
239 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
240 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
242 & wcorr*fact(3)*gradcorr(j,i)+
243 & wel_loc*fact(2)*gel_loc(j,i)+
244 & wturn3*fact(2)*gcorr3_turn(j,i)+
245 & wturn4*fact(3)*gcorr4_turn(j,i)+
246 & wcorr5*fact(4)*gradcorr5(j,i)+
247 & wcorr6*fact(5)*gradcorr6(j,i)+
248 & wturn6*fact(5)*gcorr6_turn(j,i)+
249 & wsccor*fact(2)*gsccorc(j,i)+
250 & wdfa_dist*gdfad(j,i)+
251 & wdfa_tor*gdfat(j,i)+
252 & wdfa_nei*gdfan(j,i)+
253 & wdfa_beta*gdfab(j,i)
254 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
256 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
257 & wsccor*fact(1)*gsccorx(j,i)
264 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
265 & +wcorr5*fact(4)*g_corr5_loc(i)
266 & +wcorr6*fact(5)*g_corr6_loc(i)
267 & +wturn4*fact(3)*gel_loc_turn4(i)
268 & +wturn3*fact(2)*gel_loc_turn3(i)
269 & +wturn6*fact(5)*gel_loc_turn6(i)
270 & +wel_loc*fact(2)*gel_loc_loc(i)
271 & +wsccor*fact(1)*gsccor_loc(i)
276 C------------------------------------------------------------------------
277 subroutine enerprint(energia,fact)
278 implicit real*8 (a-h,o-z)
280 include 'DIMENSIONS.ZSCOPT'
281 include 'COMMON.IOUNITS'
282 include 'COMMON.FFIELD'
283 include 'COMMON.SBRIDGE'
284 double precision energia(0:max_ene),fact(6)
286 evdw=energia(1)+fact(6)*energia(21)
288 evdw2=energia(2)+energia(17)
300 eello_turn3=energia(8)
301 eello_turn4=energia(9)
302 eello_turn6=energia(10)
309 edihcnstr=energia(20)
311 ehomology_constr=energia(22)
317 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
319 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
320 & etors_d,wtor_d*fact(2),ehpb,wstrain,
321 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
322 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
323 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
324 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
325 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
327 10 format (/'Virtual-chain energies:'//
328 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
329 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
330 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
331 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
332 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
333 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
334 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
335 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
336 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
337 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
338 & ' (SS bridges & dist. cnstr.)'/
339 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
340 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
341 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
342 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
343 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
344 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
345 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
346 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
347 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
348 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
349 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
350 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
351 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
352 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
353 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
354 & 'ETOT= ',1pE16.6,' (total)')
356 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
357 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
358 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
359 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
360 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
361 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
362 & edihcnstr,ehomology_constr,ebr*nss,
363 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
365 10 format (/'Virtual-chain energies:'//
366 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
367 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
368 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
369 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
370 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
371 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
372 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
373 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
374 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
375 & ' (SS bridges & dist. cnstr.)'/
376 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
377 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
378 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
379 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
380 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
381 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
382 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
383 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
384 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
385 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
386 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
387 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
388 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
389 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
390 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
391 & 'ETOT= ',1pE16.6,' (total)')
395 C-----------------------------------------------------------------------
396 subroutine elj(evdw,evdw_t)
398 C This subroutine calculates the interaction energy of nonbonded side chains
399 C assuming the LJ potential of interaction.
401 implicit real*8 (a-h,o-z)
403 include 'DIMENSIONS.ZSCOPT'
404 include "DIMENSIONS.COMPAR"
405 parameter (accur=1.0d-10)
408 include 'COMMON.LOCAL'
409 include 'COMMON.CHAIN'
410 include 'COMMON.DERIV'
411 include 'COMMON.INTERACT'
412 include 'COMMON.TORSION'
413 include 'COMMON.ENEPS'
414 include 'COMMON.SBRIDGE'
415 include 'COMMON.NAMES'
416 include 'COMMON.IOUNITS'
417 include 'COMMON.CONTACTS'
421 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
424 eneps_temp(j,i)=0.0d0
438 C Calculate SC interaction energy.
441 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
442 cd & 'iend=',iend(i,iint)
443 do j=istart(i,iint),iend(i,iint)
448 C Change 12/1/95 to calculate four-body interactions
449 rij=xj*xj+yj*yj+zj*zj
451 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
452 eps0ij=eps(itypi,itypj)
454 e1=fac*fac*aa(itypi,itypj)
455 e2=fac*bb(itypi,itypj)
457 ij=icant(itypi,itypj)
458 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
459 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
460 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
461 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
462 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
463 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
464 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
465 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
466 if (bb(itypi,itypj).gt.0.0d0) then
473 C Calculate the components of the gradient in DC and X
475 fac=-rrij*(e1+evdwij)
480 gvdwx(k,i)=gvdwx(k,i)-gg(k)
481 gvdwx(k,j)=gvdwx(k,j)+gg(k)
485 gvdwc(l,k)=gvdwc(l,k)+gg(l)
490 C 12/1/95, revised on 5/20/97
492 C Calculate the contact function. The ith column of the array JCONT will
493 C contain the numbers of atoms that make contacts with the atom I (of numbers
494 C greater than I). The arrays FACONT and GACONT will contain the values of
495 C the contact function and its derivative.
497 C Uncomment next line, if the correlation interactions include EVDW explicitly.
498 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
499 C Uncomment next line, if the correlation interactions are contact function only
500 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
502 sigij=sigma(itypi,itypj)
503 r0ij=rs0(itypi,itypj)
505 C Check whether the SC's are not too far to make a contact.
508 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
509 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
511 if (fcont.gt.0.0D0) then
512 C If the SC-SC distance if close to sigma, apply spline.
513 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
514 cAdam & fcont1,fprimcont1)
515 cAdam fcont1=1.0d0-fcont1
516 cAdam if (fcont1.gt.0.0d0) then
517 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
518 cAdam fcont=fcont*fcont1
520 C Uncomment following 4 lines to have the geometric average of the epsilon0's
521 cga eps0ij=1.0d0/dsqrt(eps0ij)
523 cga gg(k)=gg(k)*eps0ij
525 cga eps0ij=-evdwij*eps0ij
526 C Uncomment for AL's type of SC correlation interactions.
528 num_conti=num_conti+1
530 facont(num_conti,i)=fcont*eps0ij
531 fprimcont=eps0ij*fprimcont/rij
533 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
534 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
535 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
536 C Uncomment following 3 lines for Skolnick's type of SC correlation.
537 gacont(1,num_conti,i)=-fprimcont*xj
538 gacont(2,num_conti,i)=-fprimcont*yj
539 gacont(3,num_conti,i)=-fprimcont*zj
540 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
541 cd write (iout,'(2i3,3f10.5)')
542 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
548 num_cont(i)=num_conti
553 gvdwc(j,i)=expon*gvdwc(j,i)
554 gvdwx(j,i)=expon*gvdwx(j,i)
558 C******************************************************************************
562 C To save time, the factor of EXPON has been extracted from ALL components
563 C of GVDWC and GRADX. Remember to multiply them by this factor before further
566 C******************************************************************************
569 C-----------------------------------------------------------------------------
570 subroutine eljk(evdw,evdw_t)
572 C This subroutine calculates the interaction energy of nonbonded side chains
573 C assuming the LJK potential of interaction.
575 implicit real*8 (a-h,o-z)
577 include 'DIMENSIONS.ZSCOPT'
578 include "DIMENSIONS.COMPAR"
581 include 'COMMON.LOCAL'
582 include 'COMMON.CHAIN'
583 include 'COMMON.DERIV'
584 include 'COMMON.INTERACT'
585 include 'COMMON.ENEPS'
586 include 'COMMON.IOUNITS'
587 include 'COMMON.NAMES'
592 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
595 eneps_temp(j,i)=0.0d0
607 C Calculate SC interaction energy.
610 do j=istart(i,iint),iend(i,iint)
615 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
617 e_augm=augm(itypi,itypj)*fac_augm
620 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
621 fac=r_shift_inv**expon
622 e1=fac*fac*aa(itypi,itypj)
623 e2=fac*bb(itypi,itypj)
625 ij=icant(itypi,itypj)
626 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
627 & /dabs(eps(itypi,itypj))
628 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
629 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
630 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
631 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
632 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
633 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
634 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
635 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
636 if (bb(itypi,itypj).gt.0.0d0) then
643 C Calculate the components of the gradient in DC and X
645 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
650 gvdwx(k,i)=gvdwx(k,i)-gg(k)
651 gvdwx(k,j)=gvdwx(k,j)+gg(k)
655 gvdwc(l,k)=gvdwc(l,k)+gg(l)
665 gvdwc(j,i)=expon*gvdwc(j,i)
666 gvdwx(j,i)=expon*gvdwx(j,i)
672 C-----------------------------------------------------------------------------
673 subroutine ebp(evdw,evdw_t)
675 C This subroutine calculates the interaction energy of nonbonded side chains
676 C assuming the Berne-Pechukas potential of interaction.
678 implicit real*8 (a-h,o-z)
680 include 'DIMENSIONS.ZSCOPT'
681 include "DIMENSIONS.COMPAR"
684 include 'COMMON.LOCAL'
685 include 'COMMON.CHAIN'
686 include 'COMMON.DERIV'
687 include 'COMMON.NAMES'
688 include 'COMMON.INTERACT'
689 include 'COMMON.ENEPS'
690 include 'COMMON.IOUNITS'
691 include 'COMMON.CALC'
693 c double precision rrsave(maxdim)
699 eneps_temp(j,i)=0.0d0
704 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
705 c if (icall.eq.0) then
717 dxi=dc_norm(1,nres+i)
718 dyi=dc_norm(2,nres+i)
719 dzi=dc_norm(3,nres+i)
720 dsci_inv=vbld_inv(i+nres)
722 C Calculate SC interaction energy.
725 do j=istart(i,iint),iend(i,iint)
728 dscj_inv=vbld_inv(j+nres)
729 chi1=chi(itypi,itypj)
730 chi2=chi(itypj,itypi)
737 alf12=0.5D0*(alf1+alf2)
738 C For diagnostics only!!!
751 dxj=dc_norm(1,nres+j)
752 dyj=dc_norm(2,nres+j)
753 dzj=dc_norm(3,nres+j)
754 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
755 cd if (icall.eq.0) then
761 C Calculate the angle-dependent terms of energy & contributions to derivatives.
763 C Calculate whole angle-dependent part of epsilon and contributions
765 fac=(rrij*sigsq)**expon2
766 e1=fac*fac*aa(itypi,itypj)
767 e2=fac*bb(itypi,itypj)
768 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
769 eps2der=evdwij*eps3rt
770 eps3der=evdwij*eps2rt
771 evdwij=evdwij*eps2rt*eps3rt
772 ij=icant(itypi,itypj)
773 aux=eps1*eps2rt**2*eps3rt**2
774 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
775 & /dabs(eps(itypi,itypj))
776 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
777 if (bb(itypi,itypj).gt.0.0d0) then
784 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
785 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
786 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
787 cd & restyp(itypi),i,restyp(itypj),j,
788 cd & epsi,sigm,chi1,chi2,chip1,chip2,
789 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
790 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
793 C Calculate gradient components.
794 e1=e1*eps1*eps2rt**2*eps3rt**2
795 fac=-expon*(e1+evdwij)
798 C Calculate radial part of the gradient
802 C Calculate the angular part of the gradient and sum add the contributions
803 C to the appropriate components of the Cartesian gradient.
812 C-----------------------------------------------------------------------------
813 subroutine egb(evdw,evdw_t)
815 C This subroutine calculates the interaction energy of nonbonded side chains
816 C assuming the Gay-Berne potential of interaction.
818 implicit real*8 (a-h,o-z)
820 include 'DIMENSIONS.ZSCOPT'
821 include "DIMENSIONS.COMPAR"
824 include 'COMMON.LOCAL'
825 include 'COMMON.CHAIN'
826 include 'COMMON.DERIV'
827 include 'COMMON.NAMES'
828 include 'COMMON.INTERACT'
829 include 'COMMON.ENEPS'
830 include 'COMMON.IOUNITS'
831 include 'COMMON.CALC'
832 include 'COMMON.SBRIDGE'
839 eneps_temp(j,i)=0.0d0
842 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
846 c if (icall.gt.0) lprn=.true.
854 dxi=dc_norm(1,nres+i)
855 dyi=dc_norm(2,nres+i)
856 dzi=dc_norm(3,nres+i)
857 dsci_inv=vbld_inv(i+nres)
859 C Calculate SC interaction energy.
862 do j=istart(i,iint),iend(i,iint)
863 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
864 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
865 C formation no electrostatic interactions should be calculated. If it
866 C would be allowed NaN would appear
867 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
868 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
869 C residue can or cannot form disulfide bond. There is still bug allowing
870 C Cys...Cys...Cys bond formation
871 call dyn_ssbond_ene(i,j,evdwij)
872 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
875 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
876 c & 'evdw',i,j,evdwij,' ss'
880 dscj_inv=vbld_inv(j+nres)
881 sig0ij=sigma(itypi,itypj)
882 chi1=chi(itypi,itypj)
883 chi2=chi(itypj,itypi)
890 alf12=0.5D0*(alf1+alf2)
891 C For diagnostics only!!!
904 dxj=dc_norm(1,nres+j)
905 dyj=dc_norm(2,nres+j)
906 dzj=dc_norm(3,nres+j)
907 c write (iout,*) i,j,xj,yj,zj
908 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
910 C Calculate angle-dependent terms of energy and contributions to their
914 sig=sig0ij*dsqrt(sigsq)
915 rij_shift=1.0D0/rij-sig+sig0ij
916 C I hate to put IF's in the loops, but here don't have another choice!!!!
917 if (rij_shift.le.0.0D0) then
922 c---------------------------------------------------------------
923 rij_shift=1.0D0/rij_shift
925 e1=fac*fac*aa(itypi,itypj)
926 e2=fac*bb(itypi,itypj)
927 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
928 eps2der=evdwij*eps3rt
929 eps3der=evdwij*eps2rt
930 evdwij=evdwij*eps2rt*eps3rt
931 if (bb(itypi,itypj).gt.0) then
936 ij=icant(itypi,itypj)
937 aux=eps1*eps2rt**2*eps3rt**2
938 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
939 & /dabs(eps(itypi,itypj))
940 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
941 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
942 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
943 c & aux*e2/eps(itypi,itypj)
944 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
946 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
947 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
948 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
949 & restyp(itypi),i,restyp(itypj),j,
950 & epsi,sigm,chi1,chi2,chip1,chip2,
951 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
952 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
956 C Calculate gradient components.
957 e1=e1*eps1*eps2rt**2*eps3rt**2
958 fac=-expon*(e1+evdwij)*rij_shift
961 C Calculate the radial part of the gradient
965 C Calculate angular part of the gradient.
974 C-----------------------------------------------------------------------------
975 subroutine egbv(evdw,evdw_t)
977 C This subroutine calculates the interaction energy of nonbonded side chains
978 C assuming the Gay-Berne-Vorobjev potential of interaction.
980 implicit real*8 (a-h,o-z)
982 include 'DIMENSIONS.ZSCOPT'
983 include "DIMENSIONS.COMPAR"
986 include 'COMMON.LOCAL'
987 include 'COMMON.CHAIN'
988 include 'COMMON.DERIV'
989 include 'COMMON.NAMES'
990 include 'COMMON.INTERACT'
991 include 'COMMON.ENEPS'
992 include 'COMMON.IOUNITS'
993 include 'COMMON.CALC'
1000 eneps_temp(j,i)=0.0d0
1005 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1008 c if (icall.gt.0) lprn=.true.
1010 do i=iatsc_s,iatsc_e
1016 dxi=dc_norm(1,nres+i)
1017 dyi=dc_norm(2,nres+i)
1018 dzi=dc_norm(3,nres+i)
1019 dsci_inv=vbld_inv(i+nres)
1021 C Calculate SC interaction energy.
1023 do iint=1,nint_gr(i)
1024 do j=istart(i,iint),iend(i,iint)
1027 dscj_inv=vbld_inv(j+nres)
1028 sig0ij=sigma(itypi,itypj)
1029 r0ij=r0(itypi,itypj)
1030 chi1=chi(itypi,itypj)
1031 chi2=chi(itypj,itypi)
1038 alf12=0.5D0*(alf1+alf2)
1039 C For diagnostics only!!!
1052 dxj=dc_norm(1,nres+j)
1053 dyj=dc_norm(2,nres+j)
1054 dzj=dc_norm(3,nres+j)
1055 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1057 C Calculate angle-dependent terms of energy and contributions to their
1061 sig=sig0ij*dsqrt(sigsq)
1062 rij_shift=1.0D0/rij-sig+r0ij
1063 C I hate to put IF's in the loops, but here don't have another choice!!!!
1064 if (rij_shift.le.0.0D0) then
1069 c---------------------------------------------------------------
1070 rij_shift=1.0D0/rij_shift
1071 fac=rij_shift**expon
1072 e1=fac*fac*aa(itypi,itypj)
1073 e2=fac*bb(itypi,itypj)
1074 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1075 eps2der=evdwij*eps3rt
1076 eps3der=evdwij*eps2rt
1077 fac_augm=rrij**expon
1078 e_augm=augm(itypi,itypj)*fac_augm
1079 evdwij=evdwij*eps2rt*eps3rt
1080 if (bb(itypi,itypj).gt.0.0d0) then
1081 evdw=evdw+evdwij+e_augm
1083 evdw_t=evdw_t+evdwij+e_augm
1085 ij=icant(itypi,itypj)
1086 aux=eps1*eps2rt**2*eps3rt**2
1087 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1088 & /dabs(eps(itypi,itypj))
1089 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1090 c eneps_temp(ij)=eneps_temp(ij)
1091 c & +(evdwij+e_augm)/eps(itypi,itypj)
1093 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1094 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1095 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1096 c & restyp(itypi),i,restyp(itypj),j,
1097 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1098 c & chi1,chi2,chip1,chip2,
1099 c & eps1,eps2rt**2,eps3rt**2,
1100 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1104 C Calculate gradient components.
1105 e1=e1*eps1*eps2rt**2*eps3rt**2
1106 fac=-expon*(e1+evdwij)*rij_shift
1108 fac=rij*fac-2*expon*rrij*e_augm
1109 C Calculate the radial part of the gradient
1113 C Calculate angular part of the gradient.
1121 C-----------------------------------------------------------------------------
1122 subroutine sc_angular
1123 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1124 C om12. Called by ebp, egb, and egbv.
1126 include 'COMMON.CALC'
1130 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1131 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1132 om12=dxi*dxj+dyi*dyj+dzi*dzj
1134 C Calculate eps1(om12) and its derivative in om12
1135 faceps1=1.0D0-om12*chiom12
1136 faceps1_inv=1.0D0/faceps1
1137 eps1=dsqrt(faceps1_inv)
1138 C Following variable is eps1*deps1/dom12
1139 eps1_om12=faceps1_inv*chiom12
1140 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1145 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1146 sigsq=1.0D0-facsig*faceps1_inv
1147 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1148 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1149 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1150 C Calculate eps2 and its derivatives in om1, om2, and om12.
1153 chipom12=chip12*om12
1154 facp=1.0D0-om12*chipom12
1156 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1157 C Following variable is the square root of eps2
1158 eps2rt=1.0D0-facp1*facp_inv
1159 C Following three variables are the derivatives of the square root of eps
1160 C in om1, om2, and om12.
1161 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1162 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1163 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1164 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1165 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1166 C Calculate whole angle-dependent part of epsilon and contributions
1167 C to its derivatives
1170 C----------------------------------------------------------------------------
1172 implicit real*8 (a-h,o-z)
1173 include 'DIMENSIONS'
1174 include 'DIMENSIONS.ZSCOPT'
1175 include 'COMMON.CHAIN'
1176 include 'COMMON.DERIV'
1177 include 'COMMON.CALC'
1178 double precision dcosom1(3),dcosom2(3)
1179 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1180 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1181 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1182 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1184 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1185 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1188 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1191 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1192 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1193 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1194 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1195 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1196 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1199 C Calculate the components of the gradient in DC and X
1203 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1208 c------------------------------------------------------------------------------
1209 subroutine vec_and_deriv
1210 implicit real*8 (a-h,o-z)
1211 include 'DIMENSIONS'
1212 include 'DIMENSIONS.ZSCOPT'
1213 include 'COMMON.IOUNITS'
1214 include 'COMMON.GEO'
1215 include 'COMMON.VAR'
1216 include 'COMMON.LOCAL'
1217 include 'COMMON.CHAIN'
1218 include 'COMMON.VECTORS'
1219 include 'COMMON.DERIV'
1220 include 'COMMON.INTERACT'
1221 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1222 C Compute the local reference systems. For reference system (i), the
1223 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1224 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1226 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1227 if (i.eq.nres-1) then
1228 C Case of the last full residue
1229 C Compute the Z-axis
1230 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1231 costh=dcos(pi-theta(nres))
1232 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 C Compute the derivatives of uz
1239 uzder(2,1,1)=-dc_norm(3,i-1)
1240 uzder(3,1,1)= dc_norm(2,i-1)
1241 uzder(1,2,1)= dc_norm(3,i-1)
1243 uzder(3,2,1)=-dc_norm(1,i-1)
1244 uzder(1,3,1)=-dc_norm(2,i-1)
1245 uzder(2,3,1)= dc_norm(1,i-1)
1248 uzder(2,1,2)= dc_norm(3,i)
1249 uzder(3,1,2)=-dc_norm(2,i)
1250 uzder(1,2,2)=-dc_norm(3,i)
1252 uzder(3,2,2)= dc_norm(1,i)
1253 uzder(1,3,2)= dc_norm(2,i)
1254 uzder(2,3,2)=-dc_norm(1,i)
1257 C Compute the Y-axis
1260 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1263 C Compute the derivatives of uy
1266 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1267 & -dc_norm(k,i)*dc_norm(j,i-1)
1268 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1270 uyder(j,j,1)=uyder(j,j,1)-costh
1271 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1276 uygrad(l,k,j,i)=uyder(l,k,j)
1277 uzgrad(l,k,j,i)=uzder(l,k,j)
1281 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1282 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1283 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1284 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1288 C Compute the Z-axis
1289 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1290 costh=dcos(pi-theta(i+2))
1291 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1296 C Compute the derivatives of uz
1298 uzder(2,1,1)=-dc_norm(3,i+1)
1299 uzder(3,1,1)= dc_norm(2,i+1)
1300 uzder(1,2,1)= dc_norm(3,i+1)
1302 uzder(3,2,1)=-dc_norm(1,i+1)
1303 uzder(1,3,1)=-dc_norm(2,i+1)
1304 uzder(2,3,1)= dc_norm(1,i+1)
1307 uzder(2,1,2)= dc_norm(3,i)
1308 uzder(3,1,2)=-dc_norm(2,i)
1309 uzder(1,2,2)=-dc_norm(3,i)
1311 uzder(3,2,2)= dc_norm(1,i)
1312 uzder(1,3,2)= dc_norm(2,i)
1313 uzder(2,3,2)=-dc_norm(1,i)
1316 C Compute the Y-axis
1319 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1322 C Compute the derivatives of uy
1325 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1326 & -dc_norm(k,i)*dc_norm(j,i+1)
1327 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1329 uyder(j,j,1)=uyder(j,j,1)-costh
1330 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1335 uygrad(l,k,j,i)=uyder(l,k,j)
1336 uzgrad(l,k,j,i)=uzder(l,k,j)
1340 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1341 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1342 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1343 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1349 vbld_inv_temp(1)=vbld_inv(i+1)
1350 if (i.lt.nres-1) then
1351 vbld_inv_temp(2)=vbld_inv(i+2)
1353 vbld_inv_temp(2)=vbld_inv(i)
1358 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1359 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1367 C-----------------------------------------------------------------------------
1368 subroutine vec_and_deriv_test
1369 implicit real*8 (a-h,o-z)
1370 include 'DIMENSIONS'
1371 include 'DIMENSIONS.ZSCOPT'
1372 include 'COMMON.IOUNITS'
1373 include 'COMMON.GEO'
1374 include 'COMMON.VAR'
1375 include 'COMMON.LOCAL'
1376 include 'COMMON.CHAIN'
1377 include 'COMMON.VECTORS'
1378 dimension uyder(3,3,2),uzder(3,3,2)
1379 C Compute the local reference systems. For reference system (i), the
1380 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1381 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1383 if (i.eq.nres-1) then
1384 C Case of the last full residue
1385 C Compute the Z-axis
1386 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1387 costh=dcos(pi-theta(nres))
1388 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1389 c write (iout,*) 'fac',fac,
1390 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1391 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1395 C Compute the derivatives of uz
1397 uzder(2,1,1)=-dc_norm(3,i-1)
1398 uzder(3,1,1)= dc_norm(2,i-1)
1399 uzder(1,2,1)= dc_norm(3,i-1)
1401 uzder(3,2,1)=-dc_norm(1,i-1)
1402 uzder(1,3,1)=-dc_norm(2,i-1)
1403 uzder(2,3,1)= dc_norm(1,i-1)
1406 uzder(2,1,2)= dc_norm(3,i)
1407 uzder(3,1,2)=-dc_norm(2,i)
1408 uzder(1,2,2)=-dc_norm(3,i)
1410 uzder(3,2,2)= dc_norm(1,i)
1411 uzder(1,3,2)= dc_norm(2,i)
1412 uzder(2,3,2)=-dc_norm(1,i)
1414 C Compute the Y-axis
1416 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1419 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1420 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1421 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1423 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1426 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1427 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1430 c write (iout,*) 'facy',facy,
1431 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1432 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1434 uy(k,i)=facy*uy(k,i)
1436 C Compute the derivatives of uy
1439 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1440 & -dc_norm(k,i)*dc_norm(j,i-1)
1441 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1443 c uyder(j,j,1)=uyder(j,j,1)-costh
1444 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1445 uyder(j,j,1)=uyder(j,j,1)
1446 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1447 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1453 uygrad(l,k,j,i)=uyder(l,k,j)
1454 uzgrad(l,k,j,i)=uzder(l,k,j)
1458 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1459 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1460 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1461 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1464 C Compute the Z-axis
1465 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1466 costh=dcos(pi-theta(i+2))
1467 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1468 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1472 C Compute the derivatives of uz
1474 uzder(2,1,1)=-dc_norm(3,i+1)
1475 uzder(3,1,1)= dc_norm(2,i+1)
1476 uzder(1,2,1)= dc_norm(3,i+1)
1478 uzder(3,2,1)=-dc_norm(1,i+1)
1479 uzder(1,3,1)=-dc_norm(2,i+1)
1480 uzder(2,3,1)= dc_norm(1,i+1)
1483 uzder(2,1,2)= dc_norm(3,i)
1484 uzder(3,1,2)=-dc_norm(2,i)
1485 uzder(1,2,2)=-dc_norm(3,i)
1487 uzder(3,2,2)= dc_norm(1,i)
1488 uzder(1,3,2)= dc_norm(2,i)
1489 uzder(2,3,2)=-dc_norm(1,i)
1491 C Compute the Y-axis
1493 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1494 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1495 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1497 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1500 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1501 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1504 c write (iout,*) 'facy',facy,
1505 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1506 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1508 uy(k,i)=facy*uy(k,i)
1510 C Compute the derivatives of uy
1513 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1514 & -dc_norm(k,i)*dc_norm(j,i+1)
1515 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1517 c uyder(j,j,1)=uyder(j,j,1)-costh
1518 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1519 uyder(j,j,1)=uyder(j,j,1)
1520 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1521 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1527 uygrad(l,k,j,i)=uyder(l,k,j)
1528 uzgrad(l,k,j,i)=uzder(l,k,j)
1532 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1533 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1534 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1535 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1542 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1543 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1550 C-----------------------------------------------------------------------------
1551 subroutine check_vecgrad
1552 implicit real*8 (a-h,o-z)
1553 include 'DIMENSIONS'
1554 include 'DIMENSIONS.ZSCOPT'
1555 include 'COMMON.IOUNITS'
1556 include 'COMMON.GEO'
1557 include 'COMMON.VAR'
1558 include 'COMMON.LOCAL'
1559 include 'COMMON.CHAIN'
1560 include 'COMMON.VECTORS'
1561 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1562 dimension uyt(3,maxres),uzt(3,maxres)
1563 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1564 double precision delta /1.0d-7/
1567 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1568 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1569 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1570 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1571 cd & (dc_norm(if90,i),if90=1,3)
1572 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1573 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1574 cd write(iout,'(a)')
1580 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1581 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1594 cd write (iout,*) 'i=',i
1596 erij(k)=dc_norm(k,i)
1600 dc_norm(k,i)=erij(k)
1602 dc_norm(j,i)=dc_norm(j,i)+delta
1603 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1605 c dc_norm(k,i)=dc_norm(k,i)/fac
1607 c write (iout,*) (dc_norm(k,i),k=1,3)
1608 c write (iout,*) (erij(k),k=1,3)
1611 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1612 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1613 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1614 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1616 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1617 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1618 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1621 dc_norm(k,i)=erij(k)
1624 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1625 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1626 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1627 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1628 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1629 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1630 cd write (iout,'(a)')
1635 C--------------------------------------------------------------------------
1636 subroutine set_matrices
1637 implicit real*8 (a-h,o-z)
1638 include 'DIMENSIONS'
1639 include 'DIMENSIONS.ZSCOPT'
1640 include 'COMMON.IOUNITS'
1641 include 'COMMON.GEO'
1642 include 'COMMON.VAR'
1643 include 'COMMON.LOCAL'
1644 include 'COMMON.CHAIN'
1645 include 'COMMON.DERIV'
1646 include 'COMMON.INTERACT'
1647 include 'COMMON.CONTACTS'
1648 include 'COMMON.TORSION'
1649 include 'COMMON.VECTORS'
1650 include 'COMMON.FFIELD'
1651 double precision auxvec(2),auxmat(2,2)
1653 C Compute the virtual-bond-torsional-angle dependent quantities needed
1654 C to calculate the el-loc multibody terms of various order.
1657 if (i .lt. nres+1) then
1694 if (i .gt. 3 .and. i .lt. nres+1) then
1695 obrot_der(1,i-2)=-sin1
1696 obrot_der(2,i-2)= cos1
1697 Ugder(1,1,i-2)= sin1
1698 Ugder(1,2,i-2)=-cos1
1699 Ugder(2,1,i-2)=-cos1
1700 Ugder(2,2,i-2)=-sin1
1703 obrot2_der(1,i-2)=-dwasin2
1704 obrot2_der(2,i-2)= dwacos2
1705 Ug2der(1,1,i-2)= dwasin2
1706 Ug2der(1,2,i-2)=-dwacos2
1707 Ug2der(2,1,i-2)=-dwacos2
1708 Ug2der(2,2,i-2)=-dwasin2
1710 obrot_der(1,i-2)=0.0d0
1711 obrot_der(2,i-2)=0.0d0
1712 Ugder(1,1,i-2)=0.0d0
1713 Ugder(1,2,i-2)=0.0d0
1714 Ugder(2,1,i-2)=0.0d0
1715 Ugder(2,2,i-2)=0.0d0
1716 obrot2_der(1,i-2)=0.0d0
1717 obrot2_der(2,i-2)=0.0d0
1718 Ug2der(1,1,i-2)=0.0d0
1719 Ug2der(1,2,i-2)=0.0d0
1720 Ug2der(2,1,i-2)=0.0d0
1721 Ug2der(2,2,i-2)=0.0d0
1723 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1724 iti = itortyp(itype(i-2))
1728 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1729 iti1 = itortyp(itype(i-1))
1733 cd write (iout,*) '*******i',i,' iti1',iti
1734 cd write (iout,*) 'b1',b1(:,iti)
1735 cd write (iout,*) 'b2',b2(:,iti)
1736 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1737 if (i .gt. iatel_s+2) then
1738 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1739 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1740 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1741 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1742 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1743 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1744 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1754 DtUg2(l,k,i-2)=0.0d0
1758 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1759 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1760 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1761 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1762 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1763 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1764 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1766 muder(k,i-2)=Ub2der(k,i-2)
1768 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1769 iti1 = itortyp(itype(i-1))
1774 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1776 C Vectors and matrices dependent on a single virtual-bond dihedral.
1777 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1778 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1779 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1780 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1781 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1782 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1783 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1784 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1785 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1786 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1787 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1789 C Matrices dependent on two consecutive virtual-bond dihedrals.
1790 C The order of matrices is from left to right.
1792 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1793 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1794 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1795 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1796 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1797 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1798 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1799 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1802 cd iti = itortyp(itype(i))
1805 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1806 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1811 C--------------------------------------------------------------------------
1812 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1814 C This subroutine calculates the average interaction energy and its gradient
1815 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1816 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1817 C The potential depends both on the distance of peptide-group centers and on
1818 C the orientation of the CA-CA virtual bonds.
1820 implicit real*8 (a-h,o-z)
1821 include 'DIMENSIONS'
1822 include 'DIMENSIONS.ZSCOPT'
1823 include 'COMMON.CONTROL'
1824 include 'COMMON.IOUNITS'
1825 include 'COMMON.GEO'
1826 include 'COMMON.VAR'
1827 include 'COMMON.LOCAL'
1828 include 'COMMON.CHAIN'
1829 include 'COMMON.DERIV'
1830 include 'COMMON.INTERACT'
1831 include 'COMMON.CONTACTS'
1832 include 'COMMON.TORSION'
1833 include 'COMMON.VECTORS'
1834 include 'COMMON.FFIELD'
1835 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1836 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1837 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1838 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1839 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1840 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1841 double precision scal_el /0.5d0/
1843 C 13-go grudnia roku pamietnego...
1844 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1845 & 0.0d0,1.0d0,0.0d0,
1846 & 0.0d0,0.0d0,1.0d0/
1847 cd write(iout,*) 'In EELEC'
1849 cd write(iout,*) 'Type',i
1850 cd write(iout,*) 'B1',B1(:,i)
1851 cd write(iout,*) 'B2',B2(:,i)
1852 cd write(iout,*) 'CC',CC(:,:,i)
1853 cd write(iout,*) 'DD',DD(:,:,i)
1854 cd write(iout,*) 'EE',EE(:,:,i)
1856 cd call check_vecgrad
1858 if (icheckgrad.eq.1) then
1860 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1862 dc_norm(k,i)=dc(k,i)*fac
1864 c write (iout,*) 'i',i,' fac',fac
1867 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1868 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1869 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1870 cd if (wel_loc.gt.0.0d0) then
1871 if (icheckgrad.eq.1) then
1872 call vec_and_deriv_test
1879 cd write (iout,*) 'i=',i
1881 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1884 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1885 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1898 cd print '(a)','Enter EELEC'
1899 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1901 gel_loc_loc(i)=0.0d0
1904 do i=iatel_s,iatel_e
1905 if (itel(i).eq.0) goto 1215
1909 dx_normi=dc_norm(1,i)
1910 dy_normi=dc_norm(2,i)
1911 dz_normi=dc_norm(3,i)
1912 xmedi=c(1,i)+0.5d0*dxi
1913 ymedi=c(2,i)+0.5d0*dyi
1914 zmedi=c(3,i)+0.5d0*dzi
1916 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1917 do j=ielstart(i),ielend(i)
1918 if (itel(j).eq.0) goto 1216
1922 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1923 aaa=app(iteli,itelj)
1924 bbb=bpp(iteli,itelj)
1925 C Diagnostics only!!!
1931 ael6i=ael6(iteli,itelj)
1932 ael3i=ael3(iteli,itelj)
1936 dx_normj=dc_norm(1,j)
1937 dy_normj=dc_norm(2,j)
1938 dz_normj=dc_norm(3,j)
1939 xj=c(1,j)+0.5D0*dxj-xmedi
1940 yj=c(2,j)+0.5D0*dyj-ymedi
1941 zj=c(3,j)+0.5D0*dzj-zmedi
1942 rij=xj*xj+yj*yj+zj*zj
1948 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1949 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1950 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1951 fac=cosa-3.0D0*cosb*cosg
1953 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1954 if (j.eq.i+2) ev1=scal_el*ev1
1959 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1962 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1963 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1964 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1967 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1968 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1969 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1970 cd & xmedi,ymedi,zmedi,xj,yj,zj
1972 C Calculate contributions to the Cartesian gradient.
1975 facvdw=-6*rrmij*(ev1+evdwij)
1976 facel=-3*rrmij*(el1+eesij)
1983 * Radial derivatives. First process both termini of the fragment (i,j)
1990 gelc(k,i)=gelc(k,i)+ghalf
1991 gelc(k,j)=gelc(k,j)+ghalf
1994 * Loop over residues i+1 thru j-1.
1998 gelc(l,k)=gelc(l,k)+ggg(l)
2006 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2007 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2010 * Loop over residues i+1 thru j-1.
2014 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2021 fac=-3*rrmij*(facvdw+facvdw+facel)
2027 * Radial derivatives. First process both termini of the fragment (i,j)
2034 gelc(k,i)=gelc(k,i)+ghalf
2035 gelc(k,j)=gelc(k,j)+ghalf
2038 * Loop over residues i+1 thru j-1.
2042 gelc(l,k)=gelc(l,k)+ggg(l)
2049 ecosa=2.0D0*fac3*fac1+fac4
2052 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2053 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2055 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2056 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2058 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2059 cd & (dcosg(k),k=1,3)
2061 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2065 gelc(k,i)=gelc(k,i)+ghalf
2066 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2067 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2068 gelc(k,j)=gelc(k,j)+ghalf
2069 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2070 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2074 gelc(l,k)=gelc(l,k)+ggg(l)
2079 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2080 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2081 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2083 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2084 C energy of a peptide unit is assumed in the form of a second-order
2085 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2086 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2087 C are computed for EVERY pair of non-contiguous peptide groups.
2089 if (j.lt.nres-1) then
2100 muij(kkk)=mu(k,i)*mu(l,j)
2103 cd write (iout,*) 'EELEC: i',i,' j',j
2104 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2105 cd write(iout,*) 'muij',muij
2106 ury=scalar(uy(1,i),erij)
2107 urz=scalar(uz(1,i),erij)
2108 vry=scalar(uy(1,j),erij)
2109 vrz=scalar(uz(1,j),erij)
2110 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2111 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2112 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2113 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2114 C For diagnostics only
2119 fac=dsqrt(-ael6i)*r3ij
2120 cd write (2,*) 'fac=',fac
2121 C For diagnostics only
2127 cd write (iout,'(4i5,4f10.5)')
2128 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2129 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2130 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2131 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2132 cd write (iout,'(4f10.5)')
2133 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2134 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2135 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2136 cd write (iout,'(2i3,9f10.5/)') i,j,
2137 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2139 C Derivatives of the elements of A in virtual-bond vectors
2140 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2147 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2148 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2149 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2150 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2151 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2152 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2153 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2154 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2155 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2156 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2157 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2158 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2168 C Compute radial contributions to the gradient
2190 C Add the contributions coming from er
2193 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2194 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2195 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2196 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2199 C Derivatives in DC(i)
2200 ghalf1=0.5d0*agg(k,1)
2201 ghalf2=0.5d0*agg(k,2)
2202 ghalf3=0.5d0*agg(k,3)
2203 ghalf4=0.5d0*agg(k,4)
2204 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2205 & -3.0d0*uryg(k,2)*vry)+ghalf1
2206 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2207 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2208 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2209 & -3.0d0*urzg(k,2)*vry)+ghalf3
2210 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2211 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2212 C Derivatives in DC(i+1)
2213 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2214 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2215 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2216 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2217 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2218 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2219 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2220 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2221 C Derivatives in DC(j)
2222 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2223 & -3.0d0*vryg(k,2)*ury)+ghalf1
2224 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2225 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2226 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2227 & -3.0d0*vryg(k,2)*urz)+ghalf3
2228 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2229 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2230 C Derivatives in DC(j+1) or DC(nres-1)
2231 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2232 & -3.0d0*vryg(k,3)*ury)
2233 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2234 & -3.0d0*vrzg(k,3)*ury)
2235 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2236 & -3.0d0*vryg(k,3)*urz)
2237 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2238 & -3.0d0*vrzg(k,3)*urz)
2243 C Derivatives in DC(i+1)
2244 cd aggi1(k,1)=agg(k,1)
2245 cd aggi1(k,2)=agg(k,2)
2246 cd aggi1(k,3)=agg(k,3)
2247 cd aggi1(k,4)=agg(k,4)
2248 C Derivatives in DC(j)
2253 C Derivatives in DC(j+1)
2258 if (j.eq.nres-1 .and. i.lt.j-2) then
2260 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2261 cd aggj1(k,l)=agg(k,l)
2267 C Check the loc-el terms by numerical integration
2277 aggi(k,l)=-aggi(k,l)
2278 aggi1(k,l)=-aggi1(k,l)
2279 aggj(k,l)=-aggj(k,l)
2280 aggj1(k,l)=-aggj1(k,l)
2283 if (j.lt.nres-1) then
2289 aggi(k,l)=-aggi(k,l)
2290 aggi1(k,l)=-aggi1(k,l)
2291 aggj(k,l)=-aggj(k,l)
2292 aggj1(k,l)=-aggj1(k,l)
2303 aggi(k,l)=-aggi(k,l)
2304 aggi1(k,l)=-aggi1(k,l)
2305 aggj(k,l)=-aggj(k,l)
2306 aggj1(k,l)=-aggj1(k,l)
2312 IF (wel_loc.gt.0.0d0) THEN
2313 C Contribution to the local-electrostatic energy coming from the i-j pair
2314 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2316 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2317 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2318 eel_loc=eel_loc+eel_loc_ij
2319 C Partial derivatives in virtual-bond dihedral angles gamma
2322 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2323 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2324 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2325 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2326 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2327 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2328 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2329 cd write(iout,*) 'agg ',agg
2330 cd write(iout,*) 'aggi ',aggi
2331 cd write(iout,*) 'aggi1',aggi1
2332 cd write(iout,*) 'aggj ',aggj
2333 cd write(iout,*) 'aggj1',aggj1
2335 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2337 ggg(l)=agg(l,1)*muij(1)+
2338 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2342 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2345 C Remaining derivatives of eello
2347 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2348 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2349 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2350 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2351 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2352 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2353 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2354 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2358 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2359 C Contributions from turns
2364 call eturn34(i,j,eello_turn3,eello_turn4)
2366 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2367 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2369 C Calculate the contact function. The ith column of the array JCONT will
2370 C contain the numbers of atoms that make contacts with the atom I (of numbers
2371 C greater than I). The arrays FACONT and GACONT will contain the values of
2372 C the contact function and its derivative.
2373 c r0ij=1.02D0*rpp(iteli,itelj)
2374 c r0ij=1.11D0*rpp(iteli,itelj)
2375 r0ij=2.20D0*rpp(iteli,itelj)
2376 c r0ij=1.55D0*rpp(iteli,itelj)
2377 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2378 if (fcont.gt.0.0D0) then
2379 num_conti=num_conti+1
2380 if (num_conti.gt.maxconts) then
2381 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2382 & ' will skip next contacts for this conf.'
2384 jcont_hb(num_conti,i)=j
2385 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2386 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2387 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2389 d_cont(num_conti,i)=rij
2390 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2391 C --- Electrostatic-interaction matrix ---
2392 a_chuj(1,1,num_conti,i)=a22
2393 a_chuj(1,2,num_conti,i)=a23
2394 a_chuj(2,1,num_conti,i)=a32
2395 a_chuj(2,2,num_conti,i)=a33
2396 C --- Gradient of rij
2398 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2401 c a_chuj(1,1,num_conti,i)=-0.61d0
2402 c a_chuj(1,2,num_conti,i)= 0.4d0
2403 c a_chuj(2,1,num_conti,i)= 0.65d0
2404 c a_chuj(2,2,num_conti,i)= 0.50d0
2405 c else if (i.eq.2) then
2406 c a_chuj(1,1,num_conti,i)= 0.0d0
2407 c a_chuj(1,2,num_conti,i)= 0.0d0
2408 c a_chuj(2,1,num_conti,i)= 0.0d0
2409 c a_chuj(2,2,num_conti,i)= 0.0d0
2411 C --- and its gradients
2412 cd write (iout,*) 'i',i,' j',j
2414 cd write (iout,*) 'iii 1 kkk',kkk
2415 cd write (iout,*) agg(kkk,:)
2418 cd write (iout,*) 'iii 2 kkk',kkk
2419 cd write (iout,*) aggi(kkk,:)
2422 cd write (iout,*) 'iii 3 kkk',kkk
2423 cd write (iout,*) aggi1(kkk,:)
2426 cd write (iout,*) 'iii 4 kkk',kkk
2427 cd write (iout,*) aggj(kkk,:)
2430 cd write (iout,*) 'iii 5 kkk',kkk
2431 cd write (iout,*) aggj1(kkk,:)
2438 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2439 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2440 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2441 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2442 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2444 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2450 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2451 C Calculate contact energies
2453 wij=cosa-3.0D0*cosb*cosg
2456 c fac3=dsqrt(-ael6i)/r0ij**3
2457 fac3=dsqrt(-ael6i)*r3ij
2458 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2459 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2461 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2462 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2463 C Diagnostics. Comment out or remove after debugging!
2464 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2465 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2466 c ees0m(num_conti,i)=0.0D0
2468 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2469 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2470 facont_hb(num_conti,i)=fcont
2472 C Angular derivatives of the contact function
2473 ees0pij1=fac3/ees0pij
2474 ees0mij1=fac3/ees0mij
2475 fac3p=-3.0D0*fac3*rrmij
2476 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2477 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2479 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2480 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2481 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2482 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2483 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2484 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2485 ecosap=ecosa1+ecosa2
2486 ecosbp=ecosb1+ecosb2
2487 ecosgp=ecosg1+ecosg2
2488 ecosam=ecosa1-ecosa2
2489 ecosbm=ecosb1-ecosb2
2490 ecosgm=ecosg1-ecosg2
2499 fprimcont=fprimcont/rij
2500 cd facont_hb(num_conti,i)=1.0D0
2501 C Following line is for diagnostics.
2504 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2505 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2508 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2509 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2511 gggp(1)=gggp(1)+ees0pijp*xj
2512 gggp(2)=gggp(2)+ees0pijp*yj
2513 gggp(3)=gggp(3)+ees0pijp*zj
2514 gggm(1)=gggm(1)+ees0mijp*xj
2515 gggm(2)=gggm(2)+ees0mijp*yj
2516 gggm(3)=gggm(3)+ees0mijp*zj
2517 C Derivatives due to the contact function
2518 gacont_hbr(1,num_conti,i)=fprimcont*xj
2519 gacont_hbr(2,num_conti,i)=fprimcont*yj
2520 gacont_hbr(3,num_conti,i)=fprimcont*zj
2522 ghalfp=0.5D0*gggp(k)
2523 ghalfm=0.5D0*gggm(k)
2524 gacontp_hb1(k,num_conti,i)=ghalfp
2525 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2526 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2527 gacontp_hb2(k,num_conti,i)=ghalfp
2528 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2529 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2530 gacontp_hb3(k,num_conti,i)=gggp(k)
2531 gacontm_hb1(k,num_conti,i)=ghalfm
2532 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2533 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2534 gacontm_hb2(k,num_conti,i)=ghalfm
2535 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2536 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2537 gacontm_hb3(k,num_conti,i)=gggm(k)
2540 C Diagnostics. Comment out or remove after debugging!
2542 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2543 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2544 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2545 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2546 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2547 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2550 endif ! num_conti.le.maxconts
2555 num_cont_hb(i)=num_conti
2559 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2560 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2562 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2563 ccc eel_loc=eel_loc+eello_turn3
2566 C-----------------------------------------------------------------------------
2567 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2568 C Third- and fourth-order contributions from turns
2569 implicit real*8 (a-h,o-z)
2570 include 'DIMENSIONS'
2571 include 'DIMENSIONS.ZSCOPT'
2572 include 'COMMON.IOUNITS'
2573 include 'COMMON.GEO'
2574 include 'COMMON.VAR'
2575 include 'COMMON.LOCAL'
2576 include 'COMMON.CHAIN'
2577 include 'COMMON.DERIV'
2578 include 'COMMON.INTERACT'
2579 include 'COMMON.CONTACTS'
2580 include 'COMMON.TORSION'
2581 include 'COMMON.VECTORS'
2582 include 'COMMON.FFIELD'
2584 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2585 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2586 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2587 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2588 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2589 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2593 C Third-order contributions
2600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2601 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2602 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2603 call transpose2(auxmat(1,1),auxmat1(1,1))
2604 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2605 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2606 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2607 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2608 cd & ' eello_turn3_num',4*eello_turn3_num
2610 C Derivatives in gamma(i)
2611 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2612 call transpose2(auxmat2(1,1),pizda(1,1))
2613 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2614 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2615 C Derivatives in gamma(i+1)
2616 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2617 call transpose2(auxmat2(1,1),pizda(1,1))
2618 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2619 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2620 & +0.5d0*(pizda(1,1)+pizda(2,2))
2621 C Cartesian derivatives
2623 a_temp(1,1)=aggi(l,1)
2624 a_temp(1,2)=aggi(l,2)
2625 a_temp(2,1)=aggi(l,3)
2626 a_temp(2,2)=aggi(l,4)
2627 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2628 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2629 & +0.5d0*(pizda(1,1)+pizda(2,2))
2630 a_temp(1,1)=aggi1(l,1)
2631 a_temp(1,2)=aggi1(l,2)
2632 a_temp(2,1)=aggi1(l,3)
2633 a_temp(2,2)=aggi1(l,4)
2634 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2635 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2636 & +0.5d0*(pizda(1,1)+pizda(2,2))
2637 a_temp(1,1)=aggj(l,1)
2638 a_temp(1,2)=aggj(l,2)
2639 a_temp(2,1)=aggj(l,3)
2640 a_temp(2,2)=aggj(l,4)
2641 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2642 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2643 & +0.5d0*(pizda(1,1)+pizda(2,2))
2644 a_temp(1,1)=aggj1(l,1)
2645 a_temp(1,2)=aggj1(l,2)
2646 a_temp(2,1)=aggj1(l,3)
2647 a_temp(2,2)=aggj1(l,4)
2648 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2649 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2650 & +0.5d0*(pizda(1,1)+pizda(2,2))
2653 else if (j.eq.i+3) then
2654 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2656 C Fourth-order contributions
2664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2665 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2666 iti1=itortyp(itype(i+1))
2667 iti2=itortyp(itype(i+2))
2668 iti3=itortyp(itype(i+3))
2669 call transpose2(EUg(1,1,i+1),e1t(1,1))
2670 call transpose2(Eug(1,1,i+2),e2t(1,1))
2671 call transpose2(Eug(1,1,i+3),e3t(1,1))
2672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2674 s1=scalar2(b1(1,iti2),auxvec(1))
2675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2677 s2=scalar2(b1(1,iti1),auxvec(1))
2678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2681 eello_turn4=eello_turn4-(s1+s2+s3)
2682 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2683 cd & ' eello_turn4_num',8*eello_turn4_num
2684 C Derivatives in gamma(i)
2686 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2687 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2688 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2689 s1=scalar2(b1(1,iti2),auxvec(1))
2690 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2691 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2692 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2693 C Derivatives in gamma(i+1)
2694 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2695 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2698 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2701 C Derivatives in gamma(i+2)
2702 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2703 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2704 s1=scalar2(b1(1,iti2),auxvec(1))
2705 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2706 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2707 s2=scalar2(b1(1,iti1),auxvec(1))
2708 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2709 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2710 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2711 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2712 C Cartesian derivatives
2713 C Derivatives of this turn contributions in DC(i+2)
2714 if (j.lt.nres-1) then
2716 a_temp(1,1)=agg(l,1)
2717 a_temp(1,2)=agg(l,2)
2718 a_temp(2,1)=agg(l,3)
2719 a_temp(2,2)=agg(l,4)
2720 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2721 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2722 s1=scalar2(b1(1,iti2),auxvec(1))
2723 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2724 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2725 s2=scalar2(b1(1,iti1),auxvec(1))
2726 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2727 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2730 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2733 C Remaining derivatives of this turn contribution
2735 a_temp(1,1)=aggi(l,1)
2736 a_temp(1,2)=aggi(l,2)
2737 a_temp(2,1)=aggi(l,3)
2738 a_temp(2,2)=aggi(l,4)
2739 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2740 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2741 s1=scalar2(b1(1,iti2),auxvec(1))
2742 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2743 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2744 s2=scalar2(b1(1,iti1),auxvec(1))
2745 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2746 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2747 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2748 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2749 a_temp(1,1)=aggi1(l,1)
2750 a_temp(1,2)=aggi1(l,2)
2751 a_temp(2,1)=aggi1(l,3)
2752 a_temp(2,2)=aggi1(l,4)
2753 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2754 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2755 s1=scalar2(b1(1,iti2),auxvec(1))
2756 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2757 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2758 s2=scalar2(b1(1,iti1),auxvec(1))
2759 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2760 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2761 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2762 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2763 a_temp(1,1)=aggj(l,1)
2764 a_temp(1,2)=aggj(l,2)
2765 a_temp(2,1)=aggj(l,3)
2766 a_temp(2,2)=aggj(l,4)
2767 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2768 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2769 s1=scalar2(b1(1,iti2),auxvec(1))
2770 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2771 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2772 s2=scalar2(b1(1,iti1),auxvec(1))
2773 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2774 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2775 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2776 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2777 a_temp(1,1)=aggj1(l,1)
2778 a_temp(1,2)=aggj1(l,2)
2779 a_temp(2,1)=aggj1(l,3)
2780 a_temp(2,2)=aggj1(l,4)
2781 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2782 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2783 s1=scalar2(b1(1,iti2),auxvec(1))
2784 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2785 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2786 s2=scalar2(b1(1,iti1),auxvec(1))
2787 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2790 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2796 C-----------------------------------------------------------------------------
2797 subroutine vecpr(u,v,w)
2798 implicit real*8(a-h,o-z)
2799 dimension u(3),v(3),w(3)
2800 w(1)=u(2)*v(3)-u(3)*v(2)
2801 w(2)=-u(1)*v(3)+u(3)*v(1)
2802 w(3)=u(1)*v(2)-u(2)*v(1)
2805 C-----------------------------------------------------------------------------
2806 subroutine unormderiv(u,ugrad,unorm,ungrad)
2807 C This subroutine computes the derivatives of a normalized vector u, given
2808 C the derivatives computed without normalization conditions, ugrad. Returns
2811 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2812 double precision vec(3)
2813 double precision scalar
2815 c write (2,*) 'ugrad',ugrad
2818 vec(i)=scalar(ugrad(1,i),u(1))
2820 c write (2,*) 'vec',vec
2823 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2826 c write (2,*) 'ungrad',ungrad
2829 C-----------------------------------------------------------------------------
2830 subroutine escp(evdw2,evdw2_14)
2832 C This subroutine calculates the excluded-volume interaction energy between
2833 C peptide-group centers and side chains and its gradient in virtual-bond and
2834 C side-chain vectors.
2836 implicit real*8 (a-h,o-z)
2837 include 'DIMENSIONS'
2838 include 'DIMENSIONS.ZSCOPT'
2839 include 'COMMON.GEO'
2840 include 'COMMON.VAR'
2841 include 'COMMON.LOCAL'
2842 include 'COMMON.CHAIN'
2843 include 'COMMON.DERIV'
2844 include 'COMMON.INTERACT'
2845 include 'COMMON.FFIELD'
2846 include 'COMMON.IOUNITS'
2850 cd print '(a)','Enter ESCP'
2851 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2852 c & ' scal14',scal14
2853 do i=iatscp_s,iatscp_e
2855 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2856 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2857 if (iteli.eq.0) goto 1225
2858 xi=0.5D0*(c(1,i)+c(1,i+1))
2859 yi=0.5D0*(c(2,i)+c(2,i+1))
2860 zi=0.5D0*(c(3,i)+c(3,i+1))
2862 do iint=1,nscp_gr(i)
2864 do j=iscpstart(i,iint),iscpend(i,iint)
2866 C Uncomment following three lines for SC-p interactions
2870 C Uncomment following three lines for Ca-p interactions
2874 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2876 e1=fac*fac*aad(itypj,iteli)
2877 e2=fac*bad(itypj,iteli)
2878 if (iabs(j-i) .le. 2) then
2881 evdw2_14=evdw2_14+e1+e2
2884 c write (iout,*) i,j,evdwij
2888 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2890 fac=-(evdwij+e1)*rrij
2895 cd write (iout,*) 'j<i'
2896 C Uncomment following three lines for SC-p interactions
2898 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2901 cd write (iout,*) 'j>i'
2904 C Uncomment following line for SC-p interactions
2905 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2909 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2913 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2914 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2917 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2927 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2928 gradx_scp(j,i)=expon*gradx_scp(j,i)
2931 C******************************************************************************
2935 C To save time the factor EXPON has been extracted from ALL components
2936 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2939 C******************************************************************************
2942 C--------------------------------------------------------------------------
2943 subroutine edis(ehpb)
2945 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2947 implicit real*8 (a-h,o-z)
2948 include 'DIMENSIONS'
2949 include 'COMMON.SBRIDGE'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.VAR'
2953 include 'COMMON.INTERACT'
2954 include 'COMMON.IOUNITS'
2957 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2958 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2959 if (link_end.eq.0) return
2960 do i=link_start,link_end
2961 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2962 C CA-CA distance used in regularization of structure.
2965 C iii and jjj point to the residues for which the distance is assigned.
2966 if (ii.gt.nres) then
2973 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2974 c & dhpb(i),dhpb1(i),forcon(i)
2975 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2976 C distance and angle dependent SS bond potential.
2977 if (.not.dyn_ss .and. i.le.nss) then
2978 C 15/02/13 CC dynamic SSbond - additional check
2979 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2980 call ssbond_ene(iii,jjj,eij)
2983 cd write (iout,*) "eij",eij
2984 else if (ii.gt.nres .and. jj.gt.nres) then
2985 c Restraints from contact prediction
2987 if (dhpb1(i).gt.0.0d0) then
2988 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2989 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2990 c write (iout,*) "beta nmr",
2991 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2995 C Get the force constant corresponding to this distance.
2997 C Calculate the contribution to energy.
2998 ehpb=ehpb+waga*rdis*rdis
2999 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3001 C Evaluate gradient.
3006 ggg(j)=fac*(c(j,jj)-c(j,ii))
3009 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3010 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3013 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3014 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3017 C Calculate the distance between the two points and its difference from the
3020 if (dhpb1(i).gt.0.0d0) then
3021 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3022 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3023 c write (iout,*) "alph nmr",
3024 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3027 C Get the force constant corresponding to this distance.
3029 C Calculate the contribution to energy.
3030 ehpb=ehpb+waga*rdis*rdis
3031 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3033 C Evaluate gradient.
3037 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3038 cd & ' waga=',waga,' fac=',fac
3040 ggg(j)=fac*(c(j,jj)-c(j,ii))
3042 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3043 C If this is a SC-SC distance, we need to calculate the contributions to the
3044 C Cartesian gradient in the SC vectors (ghpbx).
3047 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3048 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3052 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3053 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3060 C--------------------------------------------------------------------------
3061 subroutine ssbond_ene(i,j,eij)
3063 C Calculate the distance and angle dependent SS-bond potential energy
3064 C using a free-energy function derived based on RHF/6-31G** ab initio
3065 C calculations of diethyl disulfide.
3067 C A. Liwo and U. Kozlowska, 11/24/03
3069 implicit real*8 (a-h,o-z)
3070 include 'DIMENSIONS'
3071 include 'DIMENSIONS.ZSCOPT'
3072 include 'COMMON.SBRIDGE'
3073 include 'COMMON.CHAIN'
3074 include 'COMMON.DERIV'
3075 include 'COMMON.LOCAL'
3076 include 'COMMON.INTERACT'
3077 include 'COMMON.VAR'
3078 include 'COMMON.IOUNITS'
3079 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3084 dxi=dc_norm(1,nres+i)
3085 dyi=dc_norm(2,nres+i)
3086 dzi=dc_norm(3,nres+i)
3087 dsci_inv=dsc_inv(itypi)
3089 dscj_inv=dsc_inv(itypj)
3093 dxj=dc_norm(1,nres+j)
3094 dyj=dc_norm(2,nres+j)
3095 dzj=dc_norm(3,nres+j)
3096 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3101 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3102 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3103 om12=dxi*dxj+dyi*dyj+dzi*dzj
3105 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3106 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3112 deltat12=om2-om1+2.0d0
3114 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3115 & +akct*deltad*deltat12+ebr
3116 c & +akct*deltad*deltat12
3117 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3118 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3119 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3120 & " deltat12",deltat12," eij",eij,"ebr",ebr
3121 ed=2*akcm*deltad+akct*deltat12
3123 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3124 eom1=-2*akth*deltat1-pom1-om2*pom2
3125 eom2= 2*akth*deltat2+pom1-om1*pom2
3128 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3131 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3132 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3133 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3134 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3137 C Calculate the components of the gradient in DC and X
3141 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3146 C--------------------------------------------------------------------------
3147 c MODELLER restraint function
3148 subroutine e_modeller(ehomology_constr)
3149 implicit real*8 (a-h,o-z)
3150 include 'DIMENSIONS'
3151 include 'DIMENSIONS.ZSCOPT'
3153 integer nnn, i, j, k, ki, irec, l
3154 integer katy, odleglosci, test7
3155 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3156 real*8 distance(max_template),distancek(max_template),
3157 & min_odl,godl(max_template),dih_diff(max_template)
3160 c FP - 30/10/2014 Temporary specifications for homology restraints
3162 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3164 double precision, dimension (maxres) :: guscdiff,usc_diff
3165 double precision, dimension (max_template) ::
3166 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3169 include 'COMMON.SBRIDGE'
3170 include 'COMMON.CHAIN'
3171 include 'COMMON.GEO'
3172 include 'COMMON.DERIV'
3173 include 'COMMON.LOCAL'
3174 include 'COMMON.INTERACT'
3175 include 'COMMON.VAR'
3176 include 'COMMON.IOUNITS'
3177 include 'COMMON.CONTROL'
3178 include 'COMMON.HOMRESTR'
3180 include 'COMMON.SETUP'
3181 include 'COMMON.NAMES'
3184 distancek(i)=9999999.9
3189 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3191 C AL 5/2/14 - Introduce list of restraints
3192 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3194 write(iout,*) "------- dist restrs start -------"
3196 do ii = link_start_homo,link_end_homo
3200 c write (iout,*) "dij(",i,j,") =",dij
3201 do k=1,constr_homology
3202 distance(k)=odl(k,ii)-dij
3203 c write (iout,*) "distance(",k,") =",distance(k)
3205 c For Gaussian-type Urestr
3207 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3208 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3209 c write (iout,*) "distancek(",k,") =",distancek(k)
3210 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3212 c For Lorentzian-type Urestr
3214 if (waga_dist.lt.0.0d0) then
3215 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3216 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3217 & (distance(k)**2+sigma_odlir(k,ii)**2))
3221 min_odl=minval(distancek)
3222 c write (iout,* )"min_odl",min_odl
3224 write (iout,*) "ij dij",i,j,dij
3225 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3226 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3227 write (iout,* )"min_odl",min_odl
3230 do k=1,constr_homology
3231 c Nie wiem po co to liczycie jeszcze raz!
3232 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3233 c & (2*(sigma_odl(i,j,k))**2))
3234 if (waga_dist.ge.0.0d0) then
3236 c For Gaussian-type Urestr
3238 godl(k)=dexp(-distancek(k)+min_odl)
3239 odleg2=odleg2+godl(k)
3241 c For Lorentzian-type Urestr
3244 odleg2=odleg2+distancek(k)
3247 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3248 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3249 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3250 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3253 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3254 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3256 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3257 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3259 if (waga_dist.ge.0.0d0) then
3261 c For Gaussian-type Urestr
3263 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3265 c For Lorentzian-type Urestr
3268 odleg=odleg+odleg2/constr_homology
3272 c write (iout,*) "odleg",odleg ! sum of -ln-s
3275 c For Gaussian-type Urestr
3277 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3279 do k=1,constr_homology
3280 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3281 c & *waga_dist)+min_odl
3282 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3284 if (waga_dist.ge.0.0d0) then
3285 c For Gaussian-type Urestr
3287 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3289 c For Lorentzian-type Urestr
3292 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3293 & sigma_odlir(k,ii)**2)**2)
3295 sum_sgodl=sum_sgodl+sgodl
3297 c sgodl2=sgodl2+sgodl
3298 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3299 c write(iout,*) "constr_homology=",constr_homology
3300 c write(iout,*) i, j, k, "TEST K"
3302 if (waga_dist.ge.0.0d0) then
3304 c For Gaussian-type Urestr
3306 grad_odl3=waga_homology(iset)*waga_dist
3307 & *sum_sgodl/(sum_godl*dij)
3309 c For Lorentzian-type Urestr
3312 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3313 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3314 grad_odl3=-waga_homology(iset)*waga_dist*
3315 & sum_sgodl/(constr_homology*dij)
3318 c grad_odl3=sum_sgodl/(sum_godl*dij)
3321 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3322 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3323 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3325 ccc write(iout,*) godl, sgodl, grad_odl3
3327 c grad_odl=grad_odl+grad_odl3
3330 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3331 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3332 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3333 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3334 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3335 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3336 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3337 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3338 c if (i.eq.25.and.j.eq.27) then
3339 c write(iout,*) "jik",jik,"i",i,"j",j
3340 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3341 c write(iout,*) "grad_odl3",grad_odl3
3342 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3343 c write(iout,*) "ggodl",ggodl
3344 c write(iout,*) "ghpbc(",jik,i,")",
3345 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3350 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3351 ccc & dLOG(odleg2),"-odleg=", -odleg
3353 enddo ! ii-loop for dist
3355 write(iout,*) "------- dist restrs end -------"
3356 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3357 c & waga_d.eq.1.0d0) call sum_gradient
3359 c Pseudo-energy and gradient from dihedral-angle restraints from
3360 c homology templates
3361 c write (iout,*) "End of distance loop"
3364 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3366 write(iout,*) "------- dih restrs start -------"
3367 do i=idihconstr_start_homo,idihconstr_end_homo
3368 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3371 do i=idihconstr_start_homo,idihconstr_end_homo
3373 c betai=beta(i,i+1,i+2,i+3)
3375 c write (iout,*) "betai =",betai
3376 do k=1,constr_homology
3377 dih_diff(k)=pinorm(dih(k,i)-betai)
3378 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3379 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3380 c & -(6.28318-dih_diff(i,k))
3381 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3382 c & 6.28318+dih_diff(i,k)
3384 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3385 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3388 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3391 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3392 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3394 write (iout,*) "i",i," betai",betai," kat2",kat2
3395 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3397 if (kat2.le.1.0d-14) cycle
3398 kat=kat-dLOG(kat2/constr_homology)
3399 c write (iout,*) "kat",kat ! sum of -ln-s
3401 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3402 ccc & dLOG(kat2), "-kat=", -kat
3405 c ----------------------------------------------------------------------
3407 c ----------------------------------------------------------------------
3411 do k=1,constr_homology
3412 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3413 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3414 sum_sgdih=sum_sgdih+sgdih
3416 c grad_dih3=sum_sgdih/sum_gdih
3417 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3419 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3420 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3421 ccc & gloc(nphi+i-3,icg)
3422 gloc(i,icg)=gloc(i,icg)+grad_dih3
3424 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3426 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3427 ccc & gloc(nphi+i-3,icg)
3429 enddo ! i-loop for dih
3431 write(iout,*) "------- dih restrs end -------"
3434 c Pseudo-energy and gradient for theta angle restraints from
3435 c homology templates
3436 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3440 c For constr_homology reference structures (FP)
3442 c Uconst_back_tot=0.0d0
3445 c Econstr_back legacy
3448 c do i=ithet_start,ithet_end
3451 c do i=loc_start,loc_end
3454 duscdiffx(j,i)=0.0d0
3460 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3461 c write (iout,*) "waga_theta",waga_theta
3462 if (waga_theta.gt.0.0d0) then
3464 write (iout,*) "usampl",usampl
3465 write(iout,*) "------- theta restrs start -------"
3466 c do i=ithet_start,ithet_end
3467 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3470 c write (iout,*) "maxres",maxres,"nres",nres
3472 do i=ithet_start,ithet_end
3475 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3477 c Deviation of theta angles wrt constr_homology ref structures
3479 utheta_i=0.0d0 ! argument of Gaussian for single k
3480 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3481 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3482 c over residues in a fragment
3483 c write (iout,*) "theta(",i,")=",theta(i)
3484 do k=1,constr_homology
3486 c dtheta_i=theta(j)-thetaref(j,iref)
3487 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3488 theta_diff(k)=thetatpl(k,i)-theta(i)
3490 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3491 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3492 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3493 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3494 c Gradient for single Gaussian restraint in subr Econstr_back
3495 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3498 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3499 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3503 c Gradient for multiple Gaussian restraint
3504 sum_gtheta=gutheta_i
3506 do k=1,constr_homology
3507 c New generalized expr for multiple Gaussian from Econstr_back
3508 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3510 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3511 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3514 c Final value of gradient using same var as in Econstr_back
3515 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3516 & *waga_homology(iset)
3517 c dutheta(i)=sum_sgtheta/sum_gtheta
3519 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3521 Eval=Eval-dLOG(gutheta_i/constr_homology)
3522 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3523 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3524 c Uconst_back=Uconst_back+utheta(i)
3525 enddo ! (i-loop for theta)
3527 write(iout,*) "------- theta restrs end -------"
3531 c Deviation of local SC geometry
3533 c Separation of two i-loops (instructed by AL - 11/3/2014)
3535 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3536 c write (iout,*) "waga_d",waga_d
3539 write(iout,*) "------- SC restrs start -------"
3540 write (iout,*) "Initial duscdiff,duscdiffx"
3541 do i=loc_start,loc_end
3542 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3543 & (duscdiffx(jik,i),jik=1,3)
3546 do i=loc_start,loc_end
3547 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3548 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3549 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3550 c write(iout,*) "xxtab, yytab, zztab"
3551 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3552 do k=1,constr_homology
3554 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3555 c Original sign inverted for calc of gradients (s. Econstr_back)
3556 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3557 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3558 c write(iout,*) "dxx, dyy, dzz"
3559 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3561 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3562 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3563 c uscdiffk(k)=usc_diff(i)
3564 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3565 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3566 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3567 c & xxref(j),yyref(j),zzref(j)
3572 c Generalized expression for multiple Gaussian acc to that for a single
3573 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3575 c Original implementation
3576 c sum_guscdiff=guscdiff(i)
3578 c sum_sguscdiff=0.0d0
3579 c do k=1,constr_homology
3580 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3581 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3582 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3585 c Implementation of new expressions for gradient (Jan. 2015)
3587 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3589 do k=1,constr_homology
3591 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3592 c before. Now the drivatives should be correct
3594 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3595 c Original sign inverted for calc of gradients (s. Econstr_back)
3596 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3597 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3599 c New implementation
3601 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3602 & sigma_d(k,i) ! for the grad wrt r'
3603 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3606 c New implementation
3607 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3609 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3610 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3611 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3612 duscdiff(jik,i)=duscdiff(jik,i)+
3613 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3614 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3615 duscdiffx(jik,i)=duscdiffx(jik,i)+
3616 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3617 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3620 write(iout,*) "jik",jik,"i",i
3621 write(iout,*) "dxx, dyy, dzz"
3622 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3623 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3624 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3625 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3626 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3627 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3628 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3629 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3630 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3631 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3632 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3633 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3634 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3635 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3636 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3643 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3644 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3646 c write (iout,*) i," uscdiff",uscdiff(i)
3648 c Put together deviations from local geometry
3650 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3651 c & wfrag_back(3,i,iset)*uscdiff(i)
3652 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3653 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3654 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3655 c Uconst_back=Uconst_back+usc_diff(i)
3657 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3659 c New implment: multiplied by sum_sguscdiff
3662 enddo ! (i-loop for dscdiff)
3667 write(iout,*) "------- SC restrs end -------"
3668 write (iout,*) "------ After SC loop in e_modeller ------"
3669 do i=loc_start,loc_end
3670 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3671 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3673 if (waga_theta.eq.1.0d0) then
3674 write (iout,*) "in e_modeller after SC restr end: dutheta"
3675 do i=ithet_start,ithet_end
3676 write (iout,*) i,dutheta(i)
3679 if (waga_d.eq.1.0d0) then
3680 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3682 write (iout,*) i,(duscdiff(j,i),j=1,3)
3683 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3688 c Total energy from homology restraints
3690 write (iout,*) "odleg",odleg," kat",kat
3691 write (iout,*) "odleg",odleg," kat",kat
3692 write (iout,*) "Eval",Eval," Erot",Erot
3693 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3694 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3695 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3698 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3700 c ehomology_constr=odleg+kat
3702 c For Lorentzian-type Urestr
3705 if (waga_dist.ge.0.0d0) then
3707 c For Gaussian-type Urestr
3709 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3710 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3711 c write (iout,*) "ehomology_constr=",ehomology_constr
3714 c For Lorentzian-type Urestr
3716 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3717 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3718 c write (iout,*) "ehomology_constr=",ehomology_constr
3721 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3722 & "Eval",waga_theta,eval,
3723 & "Erot",waga_d,Erot
3724 write (iout,*) "ehomology_constr",ehomology_constr
3728 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3729 747 format(a12,i4,i4,i4,f8.3,f8.3)
3730 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3731 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3732 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3733 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3735 c-----------------------------------------------------------------------
3736 subroutine ebond(estr)
3738 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3740 implicit real*8 (a-h,o-z)
3741 include 'DIMENSIONS'
3742 include 'DIMENSIONS.ZSCOPT'
3743 include 'COMMON.LOCAL'
3744 include 'COMMON.GEO'
3745 include 'COMMON.INTERACT'
3746 include 'COMMON.DERIV'
3747 include 'COMMON.VAR'
3748 include 'COMMON.CHAIN'
3749 include 'COMMON.IOUNITS'
3750 include 'COMMON.NAMES'
3751 include 'COMMON.FFIELD'
3752 include 'COMMON.CONTROL'
3753 double precision u(3),ud(3)
3754 logical :: lprn=.false.
3757 diff = vbld(i)-vbldp0
3758 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3761 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3766 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3773 diff=vbld(i+nres)-vbldsc0(1,iti)
3775 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3776 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3777 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3779 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3783 diff=vbld(i+nres)-vbldsc0(j,iti)
3784 ud(j)=aksc(j,iti)*diff
3785 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3799 uprod2=uprod2*u(k)*u(k)
3803 usumsqder=usumsqder+ud(j)*uprod2
3806 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3807 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3808 estr=estr+uprod/usum
3810 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3818 C--------------------------------------------------------------------------
3819 subroutine ebend(etheta)
3821 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3822 C angles gamma and its derivatives in consecutive thetas and gammas.
3824 implicit real*8 (a-h,o-z)
3825 include 'DIMENSIONS'
3826 include 'DIMENSIONS.ZSCOPT'
3827 include 'COMMON.LOCAL'
3828 include 'COMMON.GEO'
3829 include 'COMMON.INTERACT'
3830 include 'COMMON.DERIV'
3831 include 'COMMON.VAR'
3832 include 'COMMON.CHAIN'
3833 include 'COMMON.IOUNITS'
3834 include 'COMMON.NAMES'
3835 include 'COMMON.FFIELD'
3836 common /calcthet/ term1,term2,termm,diffak,ratak,
3837 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3838 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3839 double precision y(2),z(2)
3841 time11=dexp(-2*time)
3844 c write (iout,*) "nres",nres
3845 c write (*,'(a,i2)') 'EBEND ICG=',icg
3846 c write (iout,*) ithet_start,ithet_end
3847 do i=ithet_start,ithet_end
3848 C Zero the energy function and its derivative at 0 or pi.
3849 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3851 c if (i.gt.ithet_start .and.
3852 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3853 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3861 c if (i.lt.nres .and. itel(i).ne.0) then
3873 call proc_proc(phii,icrc)
3874 if (icrc.eq.1) phii=150.0
3888 call proc_proc(phii1,icrc)
3889 if (icrc.eq.1) phii1=150.0
3901 C Calculate the "mean" value of theta from the part of the distribution
3902 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3903 C In following comments this theta will be referred to as t_c.
3904 thet_pred_mean=0.0d0
3908 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3910 c write (iout,*) "thet_pred_mean",thet_pred_mean
3911 dthett=thet_pred_mean*ssd
3912 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3913 c write (iout,*) "thet_pred_mean",thet_pred_mean
3914 C Derivatives of the "mean" values in gamma1 and gamma2.
3915 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3916 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3917 if (theta(i).gt.pi-delta) then
3918 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3920 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3921 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3922 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3924 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3926 else if (theta(i).lt.delta) then
3927 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3928 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3929 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3931 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3932 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3935 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3938 etheta=etheta+ethetai
3939 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3940 c & rad2deg*phii,rad2deg*phii1,ethetai
3941 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3942 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3943 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3946 C Ufff.... We've done all this!!!
3949 C---------------------------------------------------------------------------
3950 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3952 implicit real*8 (a-h,o-z)
3953 include 'DIMENSIONS'
3954 include 'COMMON.LOCAL'
3955 include 'COMMON.IOUNITS'
3956 common /calcthet/ term1,term2,termm,diffak,ratak,
3957 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3958 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3959 C Calculate the contributions to both Gaussian lobes.
3960 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3961 C The "polynomial part" of the "standard deviation" of this part of
3965 sig=sig*thet_pred_mean+polthet(j,it)
3967 C Derivative of the "interior part" of the "standard deviation of the"
3968 C gamma-dependent Gaussian lobe in t_c.
3969 sigtc=3*polthet(3,it)
3971 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3974 C Set the parameters of both Gaussian lobes of the distribution.
3975 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3976 fac=sig*sig+sigc0(it)
3979 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3980 sigsqtc=-4.0D0*sigcsq*sigtc
3981 c print *,i,sig,sigtc,sigsqtc
3982 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3983 sigtc=-sigtc/(fac*fac)
3984 C Following variable is sigma(t_c)**(-2)
3985 sigcsq=sigcsq*sigcsq
3987 sig0inv=1.0D0/sig0i**2
3988 delthec=thetai-thet_pred_mean
3989 delthe0=thetai-theta0i
3990 term1=-0.5D0*sigcsq*delthec*delthec
3991 term2=-0.5D0*sig0inv*delthe0*delthe0
3992 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3993 C NaNs in taking the logarithm. We extract the largest exponent which is added
3994 C to the energy (this being the log of the distribution) at the end of energy
3995 C term evaluation for this virtual-bond angle.
3996 if (term1.gt.term2) then
3998 term2=dexp(term2-termm)
4002 term1=dexp(term1-termm)
4005 C The ratio between the gamma-independent and gamma-dependent lobes of
4006 C the distribution is a Gaussian function of thet_pred_mean too.
4007 diffak=gthet(2,it)-thet_pred_mean
4008 ratak=diffak/gthet(3,it)**2
4009 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4010 C Let's differentiate it in thet_pred_mean NOW.
4012 C Now put together the distribution terms to make complete distribution.
4013 termexp=term1+ak*term2
4014 termpre=sigc+ak*sig0i
4015 C Contribution of the bending energy from this theta is just the -log of
4016 C the sum of the contributions from the two lobes and the pre-exponential
4017 C factor. Simple enough, isn't it?
4018 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4019 C NOW the derivatives!!!
4020 C 6/6/97 Take into account the deformation.
4021 E_theta=(delthec*sigcsq*term1
4022 & +ak*delthe0*sig0inv*term2)/termexp
4023 E_tc=((sigtc+aktc*sig0i)/termpre
4024 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4025 & aktc*term2)/termexp)
4028 c-----------------------------------------------------------------------------
4029 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4030 implicit real*8 (a-h,o-z)
4031 include 'DIMENSIONS'
4032 include 'COMMON.LOCAL'
4033 include 'COMMON.IOUNITS'
4034 common /calcthet/ term1,term2,termm,diffak,ratak,
4035 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4036 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4037 delthec=thetai-thet_pred_mean
4038 delthe0=thetai-theta0i
4039 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4040 t3 = thetai-thet_pred_mean
4044 t14 = t12+t6*sigsqtc
4046 t21 = thetai-theta0i
4052 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4053 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4054 & *(-t12*t9-ak*sig0inv*t27)
4058 C--------------------------------------------------------------------------
4059 subroutine ebend(etheta)
4061 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4062 C angles gamma and its derivatives in consecutive thetas and gammas.
4063 C ab initio-derived potentials from
4064 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4066 implicit real*8 (a-h,o-z)
4067 include 'DIMENSIONS'
4068 include 'DIMENSIONS.ZSCOPT'
4069 include 'COMMON.LOCAL'
4070 include 'COMMON.GEO'
4071 include 'COMMON.INTERACT'
4072 include 'COMMON.DERIV'
4073 include 'COMMON.VAR'
4074 include 'COMMON.CHAIN'
4075 include 'COMMON.IOUNITS'
4076 include 'COMMON.NAMES'
4077 include 'COMMON.FFIELD'
4078 include 'COMMON.CONTROL'
4079 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4080 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4081 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4082 & sinph1ph2(maxdouble,maxdouble)
4083 logical lprn /.false./, lprn1 /.false./
4085 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4086 do i=ithet_start,ithet_end
4087 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4088 & (itype(i).eq.ntyp1)) cycle
4092 theti2=0.5d0*theta(i)
4093 ityp2=ithetyp(itype(i-1))
4095 coskt(k)=dcos(k*theti2)
4096 sinkt(k)=dsin(k*theti2)
4098 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4101 if (phii.ne.phii) phii=150.0
4105 ityp1=ithetyp(itype(i-2))
4107 cosph1(k)=dcos(k*phii)
4108 sinph1(k)=dsin(k*phii)
4112 ityp1=ithetyp(itype(i-2))
4118 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4121 if (phii1.ne.phii1) phii1=150.0
4126 ityp3=ithetyp(itype(i))
4128 cosph2(k)=dcos(k*phii1)
4129 sinph2(k)=dsin(k*phii1)
4134 ityp3=ithetyp(itype(i))
4140 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4141 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4143 ethetai=aa0thet(ityp1,ityp2,ityp3)
4146 ccl=cosph1(l)*cosph2(k-l)
4147 ssl=sinph1(l)*sinph2(k-l)
4148 scl=sinph1(l)*cosph2(k-l)
4149 csl=cosph1(l)*sinph2(k-l)
4150 cosph1ph2(l,k)=ccl-ssl
4151 cosph1ph2(k,l)=ccl+ssl
4152 sinph1ph2(l,k)=scl+csl
4153 sinph1ph2(k,l)=scl-csl
4157 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4158 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4159 write (iout,*) "coskt and sinkt"
4161 write (iout,*) k,coskt(k),sinkt(k)
4165 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4166 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4169 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4170 & " ethetai",ethetai
4173 write (iout,*) "cosph and sinph"
4175 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4177 write (iout,*) "cosph1ph2 and sinph2ph2"
4180 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4181 & sinph1ph2(l,k),sinph1ph2(k,l)
4184 write(iout,*) "ethetai",ethetai
4188 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4189 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4190 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4191 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4192 ethetai=ethetai+sinkt(m)*aux
4193 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4194 dephii=dephii+k*sinkt(m)*(
4195 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4196 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4197 dephii1=dephii1+k*sinkt(m)*(
4198 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4199 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4201 & write (iout,*) "m",m," k",k," bbthet",
4202 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4203 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4204 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4205 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4209 & write(iout,*) "ethetai",ethetai
4213 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4214 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4215 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4216 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4217 ethetai=ethetai+sinkt(m)*aux
4218 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4219 dephii=dephii+l*sinkt(m)*(
4220 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4221 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4222 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4223 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4224 dephii1=dephii1+(k-l)*sinkt(m)*(
4225 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4226 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4227 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4228 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4230 write (iout,*) "m",m," k",k," l",l," ffthet",
4231 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4232 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4233 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4234 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4235 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4236 & cosph1ph2(k,l)*sinkt(m),
4237 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4244 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4245 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4246 & phii1*rad2deg,ethetai
4248 etheta=etheta+ethetai
4250 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4251 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4252 gloc(nphi+i-2,icg)=wang*dethetai
4258 c-----------------------------------------------------------------------------
4259 subroutine esc(escloc)
4260 C Calculate the local energy of a side chain and its derivatives in the
4261 C corresponding virtual-bond valence angles THETA and the spherical angles
4263 implicit real*8 (a-h,o-z)
4264 include 'DIMENSIONS'
4265 include 'DIMENSIONS.ZSCOPT'
4266 include 'COMMON.GEO'
4267 include 'COMMON.LOCAL'
4268 include 'COMMON.VAR'
4269 include 'COMMON.INTERACT'
4270 include 'COMMON.DERIV'
4271 include 'COMMON.CHAIN'
4272 include 'COMMON.IOUNITS'
4273 include 'COMMON.NAMES'
4274 include 'COMMON.FFIELD'
4275 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4276 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4277 common /sccalc/ time11,time12,time112,theti,it,nlobit
4280 c write (iout,'(a)') 'ESC'
4281 do i=loc_start,loc_end
4283 if (it.eq.10) goto 1
4285 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4286 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4287 theti=theta(i+1)-pipol
4291 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4293 if (x(2).gt.pi-delta) then
4297 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4299 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4300 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4302 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4303 & ddersc0(1),dersc(1))
4304 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4305 & ddersc0(3),dersc(3))
4307 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4309 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4310 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4311 & dersc0(2),esclocbi,dersc02)
4312 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4314 call splinthet(x(2),0.5d0*delta,ss,ssd)
4319 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4321 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4322 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4324 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4326 c write (iout,*) escloci
4327 else if (x(2).lt.delta) then
4331 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4333 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4334 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4336 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4337 & ddersc0(1),dersc(1))
4338 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4339 & ddersc0(3),dersc(3))
4341 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4343 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4344 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4345 & dersc0(2),esclocbi,dersc02)
4346 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4351 call splinthet(x(2),0.5d0*delta,ss,ssd)
4353 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4355 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4356 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4358 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4359 c write (iout,*) escloci
4361 call enesc(x,escloci,dersc,ddummy,.false.)
4364 escloc=escloc+escloci
4365 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4367 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4369 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4370 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4375 C---------------------------------------------------------------------------
4376 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4377 implicit real*8 (a-h,o-z)
4378 include 'DIMENSIONS'
4379 include 'COMMON.GEO'
4380 include 'COMMON.LOCAL'
4381 include 'COMMON.IOUNITS'
4382 common /sccalc/ time11,time12,time112,theti,it,nlobit
4383 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4384 double precision contr(maxlob,-1:1)
4386 c write (iout,*) 'it=',it,' nlobit=',nlobit
4390 if (mixed) ddersc(j)=0.0d0
4394 C Because of periodicity of the dependence of the SC energy in omega we have
4395 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4396 C To avoid underflows, first compute & store the exponents.
4404 z(k)=x(k)-censc(k,j,it)
4409 Axk=Axk+gaussc(l,k,j,it)*z(l)
4415 expfac=expfac+Ax(k,j,iii)*z(k)
4423 C As in the case of ebend, we want to avoid underflows in exponentiation and
4424 C subsequent NaNs and INFs in energy calculation.
4425 C Find the largest exponent
4429 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4433 cd print *,'it=',it,' emin=',emin
4435 C Compute the contribution to SC energy and derivatives
4439 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4440 cd print *,'j=',j,' expfac=',expfac
4441 escloc_i=escloc_i+expfac
4443 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4447 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4448 & +gaussc(k,2,j,it))*expfac
4455 dersc(1)=dersc(1)/cos(theti)**2
4456 ddersc(1)=ddersc(1)/cos(theti)**2
4459 escloci=-(dlog(escloc_i)-emin)
4461 dersc(j)=dersc(j)/escloc_i
4465 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4470 C------------------------------------------------------------------------------
4471 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4472 implicit real*8 (a-h,o-z)
4473 include 'DIMENSIONS'
4474 include 'COMMON.GEO'
4475 include 'COMMON.LOCAL'
4476 include 'COMMON.IOUNITS'
4477 common /sccalc/ time11,time12,time112,theti,it,nlobit
4478 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4479 double precision contr(maxlob)
4490 z(k)=x(k)-censc(k,j,it)
4496 Axk=Axk+gaussc(l,k,j,it)*z(l)
4502 expfac=expfac+Ax(k,j)*z(k)
4507 C As in the case of ebend, we want to avoid underflows in exponentiation and
4508 C subsequent NaNs and INFs in energy calculation.
4509 C Find the largest exponent
4512 if (emin.gt.contr(j)) emin=contr(j)
4516 C Compute the contribution to SC energy and derivatives
4520 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4521 escloc_i=escloc_i+expfac
4523 dersc(k)=dersc(k)+Ax(k,j)*expfac
4525 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4526 & +gaussc(1,2,j,it))*expfac
4530 dersc(1)=dersc(1)/cos(theti)**2
4531 dersc12=dersc12/cos(theti)**2
4532 escloci=-(dlog(escloc_i)-emin)
4534 dersc(j)=dersc(j)/escloc_i
4536 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4540 c----------------------------------------------------------------------------------
4541 subroutine esc(escloc)
4542 C Calculate the local energy of a side chain and its derivatives in the
4543 C corresponding virtual-bond valence angles THETA and the spherical angles
4544 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4545 C added by Urszula Kozlowska. 07/11/2007
4547 implicit real*8 (a-h,o-z)
4548 include 'DIMENSIONS'
4549 include 'DIMENSIONS.ZSCOPT'
4550 include 'COMMON.GEO'
4551 include 'COMMON.LOCAL'
4552 include 'COMMON.VAR'
4553 include 'COMMON.SCROT'
4554 include 'COMMON.INTERACT'
4555 include 'COMMON.DERIV'
4556 include 'COMMON.CHAIN'
4557 include 'COMMON.IOUNITS'
4558 include 'COMMON.NAMES'
4559 include 'COMMON.FFIELD'
4560 include 'COMMON.CONTROL'
4561 include 'COMMON.VECTORS'
4562 double precision x_prime(3),y_prime(3),z_prime(3)
4563 & , sumene,dsc_i,dp2_i,x(65),
4564 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4565 & de_dxx,de_dyy,de_dzz,de_dt
4566 double precision s1_t,s1_6_t,s2_t,s2_6_t
4568 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4569 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4570 & dt_dCi(3),dt_dCi1(3)
4571 common /sccalc/ time11,time12,time112,theti,it,nlobit
4574 do i=loc_start,loc_end
4575 costtab(i+1) =dcos(theta(i+1))
4576 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4577 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4578 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4579 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4580 cosfac=dsqrt(cosfac2)
4581 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4582 sinfac=dsqrt(sinfac2)
4584 if (it.eq.10) goto 1
4586 C Compute the axes of tghe local cartesian coordinates system; store in
4587 c x_prime, y_prime and z_prime
4594 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4595 C & dc_norm(3,i+nres)
4597 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4598 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4601 z_prime(j) = -uz(j,i-1)
4604 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4605 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4606 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4607 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4608 c & " xy",scalar(x_prime(1),y_prime(1)),
4609 c & " xz",scalar(x_prime(1),z_prime(1)),
4610 c & " yy",scalar(y_prime(1),y_prime(1)),
4611 c & " yz",scalar(y_prime(1),z_prime(1)),
4612 c & " zz",scalar(z_prime(1),z_prime(1))
4614 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4615 C to local coordinate system. Store in xx, yy, zz.
4621 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4622 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4623 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4630 C Compute the energy of the ith side cbain
4632 c write (2,*) "xx",xx," yy",yy," zz",zz
4635 x(j) = sc_parmin(j,it)
4638 Cc diagnostics - remove later
4640 yy1 = dsin(alph(2))*dcos(omeg(2))
4641 zz1 = -dsin(alph(2))*dsin(omeg(2))
4642 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4643 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4645 C," --- ", xx_w,yy_w,zz_w
4648 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4649 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4651 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4652 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4654 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4655 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4656 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4657 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4658 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4660 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4661 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4662 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4663 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4664 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4666 dsc_i = 0.743d0+x(61)
4668 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4669 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4670 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4671 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4672 s1=(1+x(63))/(0.1d0 + dscp1)
4673 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4674 s2=(1+x(65))/(0.1d0 + dscp2)
4675 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4676 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4677 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4678 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4680 c & dscp1,dscp2,sumene
4681 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4682 escloc = escloc + sumene
4683 c write (2,*) "escloc",escloc
4684 if (.not. calc_grad) goto 1
4688 C This section to check the numerical derivatives of the energy of ith side
4689 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4690 C #define DEBUG in the code to turn it on.
4692 write (2,*) "sumene =",sumene
4696 write (2,*) xx,yy,zz
4697 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4698 de_dxx_num=(sumenep-sumene)/aincr
4700 write (2,*) "xx+ sumene from enesc=",sumenep
4703 write (2,*) xx,yy,zz
4704 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4705 de_dyy_num=(sumenep-sumene)/aincr
4707 write (2,*) "yy+ sumene from enesc=",sumenep
4710 write (2,*) xx,yy,zz
4711 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4712 de_dzz_num=(sumenep-sumene)/aincr
4714 write (2,*) "zz+ sumene from enesc=",sumenep
4715 costsave=cost2tab(i+1)
4716 sintsave=sint2tab(i+1)
4717 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4718 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4719 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4720 de_dt_num=(sumenep-sumene)/aincr
4721 write (2,*) " t+ sumene from enesc=",sumenep
4722 cost2tab(i+1)=costsave
4723 sint2tab(i+1)=sintsave
4724 C End of diagnostics section.
4727 C Compute the gradient of esc
4729 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4730 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4731 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4732 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4733 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4734 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4735 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4736 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4737 pom1=(sumene3*sint2tab(i+1)+sumene1)
4738 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4739 pom2=(sumene4*cost2tab(i+1)+sumene2)
4740 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4741 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4742 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4743 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4745 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4746 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4747 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4749 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4750 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4751 & +(pom1+pom2)*pom_dx
4753 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4756 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4757 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4758 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4760 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4761 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4762 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4763 & +x(59)*zz**2 +x(60)*xx*zz
4764 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4765 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4766 & +(pom1-pom2)*pom_dy
4768 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4771 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4772 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4773 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4774 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4775 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4776 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4777 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4778 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4780 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4783 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4784 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4785 & +pom1*pom_dt1+pom2*pom_dt2
4787 write(2,*), "de_dt = ", de_dt,de_dt_num
4791 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4792 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4793 cosfac2xx=cosfac2*xx
4794 sinfac2yy=sinfac2*yy
4796 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4798 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4800 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4801 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4802 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4803 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4804 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4805 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4806 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4807 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4808 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4809 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4813 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4814 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4817 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4818 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4819 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4821 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4822 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4826 dXX_Ctab(k,i)=dXX_Ci(k)
4827 dXX_C1tab(k,i)=dXX_Ci1(k)
4828 dYY_Ctab(k,i)=dYY_Ci(k)
4829 dYY_C1tab(k,i)=dYY_Ci1(k)
4830 dZZ_Ctab(k,i)=dZZ_Ci(k)
4831 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4832 dXX_XYZtab(k,i)=dXX_XYZ(k)
4833 dYY_XYZtab(k,i)=dYY_XYZ(k)
4834 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4838 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4839 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4840 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4841 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4842 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4844 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4845 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4846 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4847 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4848 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4849 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4850 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4851 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4853 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4854 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4856 C to check gradient call subroutine check_grad
4863 c------------------------------------------------------------------------------
4864 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4866 C This procedure calculates two-body contact function g(rij) and its derivative:
4869 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4872 C where x=(rij-r0ij)/delta
4874 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4877 double precision rij,r0ij,eps0ij,fcont,fprimcont
4878 double precision x,x2,x4,delta
4882 if (x.lt.-1.0D0) then
4885 else if (x.le.1.0D0) then
4888 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4889 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4896 c------------------------------------------------------------------------------
4897 subroutine splinthet(theti,delta,ss,ssder)
4898 implicit real*8 (a-h,o-z)
4899 include 'DIMENSIONS'
4900 include 'DIMENSIONS.ZSCOPT'
4901 include 'COMMON.VAR'
4902 include 'COMMON.GEO'
4905 if (theti.gt.pipol) then
4906 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4908 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4913 c------------------------------------------------------------------------------
4914 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4916 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4917 double precision ksi,ksi2,ksi3,a1,a2,a3
4918 a1=fprim0*delta/(f1-f0)
4924 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4925 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4928 c------------------------------------------------------------------------------
4929 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4931 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4932 double precision ksi,ksi2,ksi3,a1,a2,a3
4937 a2=3*(f1x-f0x)-2*fprim0x*delta
4938 a3=fprim0x*delta-2*(f1x-f0x)
4939 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4942 C-----------------------------------------------------------------------------
4944 C-----------------------------------------------------------------------------
4945 subroutine etor(etors,edihcnstr,fact)
4946 implicit real*8 (a-h,o-z)
4947 include 'DIMENSIONS'
4948 include 'DIMENSIONS.ZSCOPT'
4949 include 'COMMON.VAR'
4950 include 'COMMON.GEO'
4951 include 'COMMON.LOCAL'
4952 include 'COMMON.TORSION'
4953 include 'COMMON.INTERACT'
4954 include 'COMMON.DERIV'
4955 include 'COMMON.CHAIN'
4956 include 'COMMON.NAMES'
4957 include 'COMMON.IOUNITS'
4958 include 'COMMON.FFIELD'
4959 include 'COMMON.TORCNSTR'
4961 C Set lprn=.true. for debugging
4965 do i=iphi_start,iphi_end
4966 itori=itortyp(itype(i-2))
4967 itori1=itortyp(itype(i-1))
4970 C Proline-Proline pair is a special case...
4971 if (itori.eq.3 .and. itori1.eq.3) then
4972 if (phii.gt.-dwapi3) then
4974 fac=1.0D0/(1.0D0-cosphi)
4975 etorsi=v1(1,3,3)*fac
4976 etorsi=etorsi+etorsi
4977 etors=etors+etorsi-v1(1,3,3)
4978 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4981 v1ij=v1(j+1,itori,itori1)
4982 v2ij=v2(j+1,itori,itori1)
4985 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4986 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4990 v1ij=v1(j,itori,itori1)
4991 v2ij=v2(j,itori,itori1)
4994 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4995 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4999 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5000 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5001 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5002 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5003 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5005 ! 6/20/98 - dihedral angle constraints
5008 itori=idih_constr(i)
5011 if (difi.gt.drange(i)) then
5013 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5014 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5015 else if (difi.lt.-drange(i)) then
5017 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5018 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5020 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5021 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5023 ! write (iout,*) 'edihcnstr',edihcnstr
5026 c------------------------------------------------------------------------------
5028 subroutine etor(etors,edihcnstr,fact)
5029 implicit real*8 (a-h,o-z)
5030 include 'DIMENSIONS'
5031 include 'DIMENSIONS.ZSCOPT'
5032 include 'COMMON.VAR'
5033 include 'COMMON.GEO'
5034 include 'COMMON.LOCAL'
5035 include 'COMMON.TORSION'
5036 include 'COMMON.INTERACT'
5037 include 'COMMON.DERIV'
5038 include 'COMMON.CHAIN'
5039 include 'COMMON.NAMES'
5040 include 'COMMON.IOUNITS'
5041 include 'COMMON.FFIELD'
5042 include 'COMMON.TORCNSTR'
5044 C Set lprn=.true. for debugging
5048 do i=iphi_start,iphi_end
5049 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5050 itori=itortyp(itype(i-2))
5051 itori1=itortyp(itype(i-1))
5054 C Regular cosine and sine terms
5055 do j=1,nterm(itori,itori1)
5056 v1ij=v1(j,itori,itori1)
5057 v2ij=v2(j,itori,itori1)
5060 etors=etors+v1ij*cosphi+v2ij*sinphi
5061 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5065 C E = SUM ----------------------------------- - v1
5066 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5068 cosphi=dcos(0.5d0*phii)
5069 sinphi=dsin(0.5d0*phii)
5070 do j=1,nlor(itori,itori1)
5071 vl1ij=vlor1(j,itori,itori1)
5072 vl2ij=vlor2(j,itori,itori1)
5073 vl3ij=vlor3(j,itori,itori1)
5074 pom=vl2ij*cosphi+vl3ij*sinphi
5075 pom1=1.0d0/(pom*pom+1.0d0)
5076 etors=etors+vl1ij*pom1
5078 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5080 C Subtract the constant term
5081 etors=etors-v0(itori,itori1)
5083 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5084 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5085 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5086 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5087 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5090 ! 6/20/98 - dihedral angle constraints
5093 itori=idih_constr(i)
5095 difi=pinorm(phii-phi0(i))
5097 if (difi.gt.drange(i)) then
5099 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5100 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5101 edihi=0.25d0*ftors*difi**4
5102 else if (difi.lt.-drange(i)) then
5104 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5105 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5106 edihi=0.25d0*ftors*difi**4
5110 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5112 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5113 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5115 ! write (iout,*) 'edihcnstr',edihcnstr
5118 c----------------------------------------------------------------------------
5119 subroutine etor_d(etors_d,fact2)
5120 C 6/23/01 Compute double torsional energy
5121 implicit real*8 (a-h,o-z)
5122 include 'DIMENSIONS'
5123 include 'DIMENSIONS.ZSCOPT'
5124 include 'COMMON.VAR'
5125 include 'COMMON.GEO'
5126 include 'COMMON.LOCAL'
5127 include 'COMMON.TORSION'
5128 include 'COMMON.INTERACT'
5129 include 'COMMON.DERIV'
5130 include 'COMMON.CHAIN'
5131 include 'COMMON.NAMES'
5132 include 'COMMON.IOUNITS'
5133 include 'COMMON.FFIELD'
5134 include 'COMMON.TORCNSTR'
5136 C Set lprn=.true. for debugging
5140 do i=iphi_start,iphi_end-1
5141 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5143 itori=itortyp(itype(i-2))
5144 itori1=itortyp(itype(i-1))
5145 itori2=itortyp(itype(i))
5150 C Regular cosine and sine terms
5151 do j=1,ntermd_1(itori,itori1,itori2)
5152 v1cij=v1c(1,j,itori,itori1,itori2)
5153 v1sij=v1s(1,j,itori,itori1,itori2)
5154 v2cij=v1c(2,j,itori,itori1,itori2)
5155 v2sij=v1s(2,j,itori,itori1,itori2)
5156 cosphi1=dcos(j*phii)
5157 sinphi1=dsin(j*phii)
5158 cosphi2=dcos(j*phii1)
5159 sinphi2=dsin(j*phii1)
5160 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5161 & v2cij*cosphi2+v2sij*sinphi2
5162 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5163 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5165 do k=2,ntermd_2(itori,itori1,itori2)
5167 v1cdij = v2c(k,l,itori,itori1,itori2)
5168 v2cdij = v2c(l,k,itori,itori1,itori2)
5169 v1sdij = v2s(k,l,itori,itori1,itori2)
5170 v2sdij = v2s(l,k,itori,itori1,itori2)
5171 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5172 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5173 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5174 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5175 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5176 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5177 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5178 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5179 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5180 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5183 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5184 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5190 c------------------------------------------------------------------------------
5191 subroutine eback_sc_corr(esccor)
5192 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5193 c conformational states; temporarily implemented as differences
5194 c between UNRES torsional potentials (dependent on three types of
5195 c residues) and the torsional potentials dependent on all 20 types
5196 c of residues computed from AM1 energy surfaces of terminally-blocked
5197 c amino-acid residues.
5198 implicit real*8 (a-h,o-z)
5199 include 'DIMENSIONS'
5200 include 'DIMENSIONS.ZSCOPT'
5201 include 'COMMON.VAR'
5202 include 'COMMON.GEO'
5203 include 'COMMON.LOCAL'
5204 include 'COMMON.TORSION'
5205 include 'COMMON.SCCOR'
5206 include 'COMMON.INTERACT'
5207 include 'COMMON.DERIV'
5208 include 'COMMON.CHAIN'
5209 include 'COMMON.NAMES'
5210 include 'COMMON.IOUNITS'
5211 include 'COMMON.FFIELD'
5212 include 'COMMON.CONTROL'
5214 C Set lprn=.true. for debugging
5217 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5219 do i=itau_start,itau_end
5221 isccori=isccortyp(itype(i-2))
5222 isccori1=isccortyp(itype(i-1))
5224 cccc Added 9 May 2012
5225 cc Tauangle is torsional engle depending on the value of first digit
5226 c(see comment below)
5227 cc Omicron is flat angle depending on the value of first digit
5228 c(see comment below)
5231 do intertyp=1,3 !intertyp
5232 cc Added 09 May 2012 (Adasko)
5233 cc Intertyp means interaction type of backbone mainchain correlation:
5234 c 1 = SC...Ca...Ca...Ca
5235 c 2 = Ca...Ca...Ca...SC
5236 c 3 = SC...Ca...Ca...SCi
5238 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5239 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5240 & (itype(i-1).eq.21)))
5241 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5242 & .or.(itype(i-2).eq.21)))
5243 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5244 & (itype(i-1).eq.21)))) cycle
5245 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5246 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5248 do j=1,nterm_sccor(isccori,isccori1)
5249 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5250 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5251 cosphi=dcos(j*tauangle(intertyp,i))
5252 sinphi=dsin(j*tauangle(intertyp,i))
5253 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5254 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5256 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5257 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5258 c &gloc_sc(intertyp,i-3,icg)
5260 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5261 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5262 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5263 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5264 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5268 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5272 c------------------------------------------------------------------------------
5273 subroutine multibody(ecorr)
5274 C This subroutine calculates multi-body contributions to energy following
5275 C the idea of Skolnick et al. If side chains I and J make a contact and
5276 C at the same time side chains I+1 and J+1 make a contact, an extra
5277 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5278 implicit real*8 (a-h,o-z)
5279 include 'DIMENSIONS'
5280 include 'COMMON.IOUNITS'
5281 include 'COMMON.DERIV'
5282 include 'COMMON.INTERACT'
5283 include 'COMMON.CONTACTS'
5284 double precision gx(3),gx1(3)
5287 C Set lprn=.true. for debugging
5291 write (iout,'(a)') 'Contact function values:'
5293 write (iout,'(i2,20(1x,i2,f10.5))')
5294 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5309 num_conti=num_cont(i)
5310 num_conti1=num_cont(i1)
5315 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5316 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5317 cd & ' ishift=',ishift
5318 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5319 C The system gains extra energy.
5320 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5321 endif ! j1==j+-ishift
5330 c------------------------------------------------------------------------------
5331 double precision function esccorr(i,j,k,l,jj,kk)
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)
5343 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5344 C Calculate the multi-body contribution to energy.
5345 C Calculate multi-body contributions to the gradient.
5346 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5347 cd & k,l,(gacont(m,kk,k),m=1,3)
5349 gx(m) =ekl*gacont(m,jj,i)
5350 gx1(m)=eij*gacont(m,kk,k)
5351 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5352 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5353 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5354 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5358 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5363 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5369 c------------------------------------------------------------------------------
5371 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5372 implicit real*8 (a-h,o-z)
5373 include 'DIMENSIONS'
5374 integer dimen1,dimen2,atom,indx
5375 double precision buffer(dimen1,dimen2)
5376 double precision zapas
5377 common /contacts_hb/ zapas(3,20,maxres,7),
5378 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5379 & num_cont_hb(maxres),jcont_hb(20,maxres)
5380 num_kont=num_cont_hb(atom)
5384 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5387 buffer(i,indx+22)=facont_hb(i,atom)
5388 buffer(i,indx+23)=ees0p(i,atom)
5389 buffer(i,indx+24)=ees0m(i,atom)
5390 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5392 buffer(1,indx+26)=dfloat(num_kont)
5395 c------------------------------------------------------------------------------
5396 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5397 implicit real*8 (a-h,o-z)
5398 include 'DIMENSIONS'
5399 integer dimen1,dimen2,atom,indx
5400 double precision buffer(dimen1,dimen2)
5401 double precision zapas
5402 common /contacts_hb/ zapas(3,20,maxres,7),
5403 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5404 & num_cont_hb(maxres),jcont_hb(20,maxres)
5405 num_kont=buffer(1,indx+26)
5406 num_kont_old=num_cont_hb(atom)
5407 num_cont_hb(atom)=num_kont+num_kont_old
5412 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5415 facont_hb(ii,atom)=buffer(i,indx+22)
5416 ees0p(ii,atom)=buffer(i,indx+23)
5417 ees0m(ii,atom)=buffer(i,indx+24)
5418 jcont_hb(ii,atom)=buffer(i,indx+25)
5422 c------------------------------------------------------------------------------
5424 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5425 C This subroutine calculates multi-body contributions to hydrogen-bonding
5426 implicit real*8 (a-h,o-z)
5427 include 'DIMENSIONS'
5428 include 'DIMENSIONS.ZSCOPT'
5429 include 'COMMON.IOUNITS'
5431 include 'COMMON.INFO'
5433 include 'COMMON.FFIELD'
5434 include 'COMMON.DERIV'
5435 include 'COMMON.INTERACT'
5436 include 'COMMON.CONTACTS'
5438 parameter (max_cont=maxconts)
5439 parameter (max_dim=2*(8*3+2))
5440 parameter (msglen1=max_cont*max_dim*4)
5441 parameter (msglen2=2*msglen1)
5442 integer source,CorrelType,CorrelID,Error
5443 double precision buffer(max_cont,max_dim)
5445 double precision gx(3),gx1(3)
5448 C Set lprn=.true. for debugging
5453 if (fgProcs.le.1) goto 30
5455 write (iout,'(a)') 'Contact function values:'
5457 write (iout,'(2i3,50(1x,i2,f5.2))')
5458 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5459 & j=1,num_cont_hb(i))
5462 C Caution! Following code assumes that electrostatic interactions concerning
5463 C a given atom are split among at most two processors!
5473 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5476 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5477 if (MyRank.gt.0) then
5478 C Send correlation contributions to the preceding processor
5480 nn=num_cont_hb(iatel_s)
5481 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5482 cd write (iout,*) 'The BUFFER array:'
5484 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5486 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5488 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5489 C Clear the contacts of the atom passed to the neighboring processor
5490 nn=num_cont_hb(iatel_s+1)
5492 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5494 num_cont_hb(iatel_s)=0
5496 cd write (iout,*) 'Processor ',MyID,MyRank,
5497 cd & ' is sending correlation contribution to processor',MyID-1,
5498 cd & ' msglen=',msglen
5499 cd write (*,*) 'Processor ',MyID,MyRank,
5500 cd & ' is sending correlation contribution to processor',MyID-1,
5501 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5502 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5503 cd write (iout,*) 'Processor ',MyID,
5504 cd & ' has sent correlation contribution to processor',MyID-1,
5505 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5506 cd write (*,*) 'Processor ',MyID,
5507 cd & ' has sent correlation contribution to processor',MyID-1,
5508 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5510 endif ! (MyRank.gt.0)
5514 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5515 if (MyRank.lt.fgProcs-1) then
5516 C Receive correlation contributions from the next processor
5518 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5519 cd write (iout,*) 'Processor',MyID,
5520 cd & ' is receiving correlation contribution from processor',MyID+1,
5521 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5522 cd write (*,*) 'Processor',MyID,
5523 cd & ' is receiving correlation contribution from processor',MyID+1,
5524 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5526 do while (nbytes.le.0)
5527 call mp_probe(MyID+1,CorrelType,nbytes)
5529 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5530 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5531 cd write (iout,*) 'Processor',MyID,
5532 cd & ' has received correlation contribution from processor',MyID+1,
5533 cd & ' msglen=',msglen,' nbytes=',nbytes
5534 cd write (iout,*) 'The received BUFFER array:'
5536 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5538 if (msglen.eq.msglen1) then
5539 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5540 else if (msglen.eq.msglen2) then
5541 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5542 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5545 & 'ERROR!!!! message length changed while processing correlations.'
5547 & 'ERROR!!!! message length changed while processing correlations.'
5548 call mp_stopall(Error)
5549 endif ! msglen.eq.msglen1
5550 endif ! MyRank.lt.fgProcs-1
5557 write (iout,'(a)') 'Contact function values:'
5559 write (iout,'(2i3,50(1x,i2,f5.2))')
5560 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5561 & j=1,num_cont_hb(i))
5565 C Remove the loop below after debugging !!!
5572 C Calculate the local-electrostatic correlation terms
5573 do i=iatel_s,iatel_e+1
5575 num_conti=num_cont_hb(i)
5576 num_conti1=num_cont_hb(i+1)
5581 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5582 c & ' jj=',jj,' kk=',kk
5583 if (j1.eq.j+1 .or. j1.eq.j-1) then
5584 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5585 C The system gains extra energy.
5586 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5588 else if (j1.eq.j) then
5589 C Contacts I-J and I-(J+1) occur simultaneously.
5590 C The system loses extra energy.
5591 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5596 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5597 c & ' jj=',jj,' kk=',kk
5599 C Contacts I-J and (I+1)-J occur simultaneously.
5600 C The system loses extra energy.
5601 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5608 c------------------------------------------------------------------------------
5609 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5611 C This subroutine calculates multi-body contributions to hydrogen-bonding
5612 implicit real*8 (a-h,o-z)
5613 include 'DIMENSIONS'
5614 include 'DIMENSIONS.ZSCOPT'
5615 include 'COMMON.IOUNITS'
5617 include 'COMMON.INFO'
5619 include 'COMMON.FFIELD'
5620 include 'COMMON.DERIV'
5621 include 'COMMON.INTERACT'
5622 include 'COMMON.CONTACTS'
5624 parameter (max_cont=maxconts)
5625 parameter (max_dim=2*(8*3+2))
5626 parameter (msglen1=max_cont*max_dim*4)
5627 parameter (msglen2=2*msglen1)
5628 integer source,CorrelType,CorrelID,Error
5629 double precision buffer(max_cont,max_dim)
5631 double precision gx(3),gx1(3)
5634 C Set lprn=.true. for debugging
5640 if (fgProcs.le.1) goto 30
5642 write (iout,'(a)') 'Contact function values:'
5644 write (iout,'(2i3,50(1x,i2,f5.2))')
5645 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5646 & j=1,num_cont_hb(i))
5649 C Caution! Following code assumes that electrostatic interactions concerning
5650 C a given atom are split among at most two processors!
5660 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5663 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5664 if (MyRank.gt.0) then
5665 C Send correlation contributions to the preceding processor
5667 nn=num_cont_hb(iatel_s)
5668 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5669 cd write (iout,*) 'The BUFFER array:'
5671 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5673 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5675 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5676 C Clear the contacts of the atom passed to the neighboring processor
5677 nn=num_cont_hb(iatel_s+1)
5679 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5681 num_cont_hb(iatel_s)=0
5683 cd write (iout,*) 'Processor ',MyID,MyRank,
5684 cd & ' is sending correlation contribution to processor',MyID-1,
5685 cd & ' msglen=',msglen
5686 cd write (*,*) 'Processor ',MyID,MyRank,
5687 cd & ' is sending correlation contribution to processor',MyID-1,
5688 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5689 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5690 cd write (iout,*) 'Processor ',MyID,
5691 cd & ' has sent correlation contribution to processor',MyID-1,
5692 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5693 cd write (*,*) 'Processor ',MyID,
5694 cd & ' has sent correlation contribution to processor',MyID-1,
5695 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5697 endif ! (MyRank.gt.0)
5701 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5702 if (MyRank.lt.fgProcs-1) then
5703 C Receive correlation contributions from the next processor
5705 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5706 cd write (iout,*) 'Processor',MyID,
5707 cd & ' is receiving correlation contribution from processor',MyID+1,
5708 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5709 cd write (*,*) 'Processor',MyID,
5710 cd & ' is receiving correlation contribution from processor',MyID+1,
5711 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5713 do while (nbytes.le.0)
5714 call mp_probe(MyID+1,CorrelType,nbytes)
5716 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5717 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5718 cd write (iout,*) 'Processor',MyID,
5719 cd & ' has received correlation contribution from processor',MyID+1,
5720 cd & ' msglen=',msglen,' nbytes=',nbytes
5721 cd write (iout,*) 'The received BUFFER array:'
5723 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5725 if (msglen.eq.msglen1) then
5726 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5727 else if (msglen.eq.msglen2) then
5728 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5729 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5732 & 'ERROR!!!! message length changed while processing correlations.'
5734 & 'ERROR!!!! message length changed while processing correlations.'
5735 call mp_stopall(Error)
5736 endif ! msglen.eq.msglen1
5737 endif ! MyRank.lt.fgProcs-1
5744 write (iout,'(a)') 'Contact function values:'
5746 write (iout,'(2i3,50(1x,i2,f5.2))')
5747 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5748 & j=1,num_cont_hb(i))
5754 C Remove the loop below after debugging !!!
5761 C Calculate the dipole-dipole interaction energies
5762 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5763 do i=iatel_s,iatel_e+1
5764 num_conti=num_cont_hb(i)
5771 C Calculate the local-electrostatic correlation terms
5772 do i=iatel_s,iatel_e+1
5774 num_conti=num_cont_hb(i)
5775 num_conti1=num_cont_hb(i+1)
5780 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5781 c & ' jj=',jj,' kk=',kk
5782 if (j1.eq.j+1 .or. j1.eq.j-1) then
5783 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5784 C The system gains extra energy.
5786 sqd1=dsqrt(d_cont(jj,i))
5787 sqd2=dsqrt(d_cont(kk,i1))
5788 sred_geom = sqd1*sqd2
5789 IF (sred_geom.lt.cutoff_corr) THEN
5790 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5792 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5793 c & ' jj=',jj,' kk=',kk
5794 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5795 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5797 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5798 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5801 cd write (iout,*) 'sred_geom=',sred_geom,
5802 cd & ' ekont=',ekont,' fprim=',fprimcont
5803 call calc_eello(i,j,i+1,j1,jj,kk)
5804 if (wcorr4.gt.0.0d0)
5805 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5806 if (wcorr5.gt.0.0d0)
5807 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5808 c print *,"wcorr5",ecorr5
5809 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5810 cd write(2,*)'ijkl',i,j,i+1,j1
5811 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5812 & .or. wturn6.eq.0.0d0))then
5813 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5814 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5815 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5816 cd & 'ecorr6=',ecorr6
5817 cd write (iout,'(4e15.5)') sred_geom,
5818 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5819 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5820 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5821 else if (wturn6.gt.0.0d0
5822 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5823 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5824 eturn6=eturn6+eello_turn6(i,jj,kk)
5825 cd write (2,*) 'multibody_eello:eturn6',eturn6
5829 else if (j1.eq.j) then
5830 C Contacts I-J and I-(J+1) occur simultaneously.
5831 C The system loses extra energy.
5832 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5837 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5838 c & ' jj=',jj,' kk=',kk
5840 C Contacts I-J and (I+1)-J occur simultaneously.
5841 C The system loses extra energy.
5842 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5849 c------------------------------------------------------------------------------
5850 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5851 implicit real*8 (a-h,o-z)
5852 include 'DIMENSIONS'
5853 include 'COMMON.IOUNITS'
5854 include 'COMMON.DERIV'
5855 include 'COMMON.INTERACT'
5856 include 'COMMON.CONTACTS'
5857 double precision gx(3),gx1(3)
5867 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5868 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5869 C Following 4 lines for diagnostics.
5874 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5876 c write (iout,*)'Contacts have occurred for peptide groups',
5877 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5878 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5879 C Calculate the multi-body contribution to energy.
5880 ecorr=ecorr+ekont*ees
5882 C Calculate multi-body contributions to the gradient.
5884 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5885 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5886 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5887 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5888 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5889 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5890 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5891 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5892 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5893 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5894 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5895 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5896 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5897 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5901 gradcorr(ll,m)=gradcorr(ll,m)+
5902 & ees*ekl*gacont_hbr(ll,jj,i)-
5903 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5904 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5909 gradcorr(ll,m)=gradcorr(ll,m)+
5910 & ees*eij*gacont_hbr(ll,kk,k)-
5911 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5912 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5919 C---------------------------------------------------------------------------
5920 subroutine dipole(i,j,jj)
5921 implicit real*8 (a-h,o-z)
5922 include 'DIMENSIONS'
5923 include 'DIMENSIONS.ZSCOPT'
5924 include 'COMMON.IOUNITS'
5925 include 'COMMON.CHAIN'
5926 include 'COMMON.FFIELD'
5927 include 'COMMON.DERIV'
5928 include 'COMMON.INTERACT'
5929 include 'COMMON.CONTACTS'
5930 include 'COMMON.TORSION'
5931 include 'COMMON.VAR'
5932 include 'COMMON.GEO'
5933 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5935 iti1 = itortyp(itype(i+1))
5936 if (j.lt.nres-1) then
5937 itj1 = itortyp(itype(j+1))
5942 dipi(iii,1)=Ub2(iii,i)
5943 dipderi(iii)=Ub2der(iii,i)
5944 dipi(iii,2)=b1(iii,iti1)
5945 dipj(iii,1)=Ub2(iii,j)
5946 dipderj(iii)=Ub2der(iii,j)
5947 dipj(iii,2)=b1(iii,itj1)
5951 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5954 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5957 if (.not.calc_grad) return
5962 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5966 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5971 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5972 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5974 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5976 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5978 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5982 C---------------------------------------------------------------------------
5983 subroutine calc_eello(i,j,k,l,jj,kk)
5985 C This subroutine computes matrices and vectors needed to calculate
5986 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5988 implicit real*8 (a-h,o-z)
5989 include 'DIMENSIONS'
5990 include 'DIMENSIONS.ZSCOPT'
5991 include 'COMMON.IOUNITS'
5992 include 'COMMON.CHAIN'
5993 include 'COMMON.DERIV'
5994 include 'COMMON.INTERACT'
5995 include 'COMMON.CONTACTS'
5996 include 'COMMON.TORSION'
5997 include 'COMMON.VAR'
5998 include 'COMMON.GEO'
5999 include 'COMMON.FFIELD'
6000 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6001 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6004 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6005 cd & ' jj=',jj,' kk=',kk
6006 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6009 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6010 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6013 call transpose2(aa1(1,1),aa1t(1,1))
6014 call transpose2(aa2(1,1),aa2t(1,1))
6017 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6018 & aa1tder(1,1,lll,kkk))
6019 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6020 & aa2tder(1,1,lll,kkk))
6024 C parallel orientation of the two CA-CA-CA frames.
6026 iti=itortyp(itype(i))
6030 itk1=itortyp(itype(k+1))
6031 itj=itortyp(itype(j))
6032 if (l.lt.nres-1) then
6033 itl1=itortyp(itype(l+1))
6037 C A1 kernel(j+1) A2T
6039 cd write (iout,'(3f10.5,5x,3f10.5)')
6040 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6042 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6043 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6044 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6045 C Following matrices are needed only for 6-th order cumulants
6046 IF (wcorr6.gt.0.0d0) THEN
6047 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6048 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6049 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6050 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6051 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6052 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6053 & ADtEAderx(1,1,1,1,1,1))
6055 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6056 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6057 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6058 & ADtEA1derx(1,1,1,1,1,1))
6060 C End 6-th order cumulants
6063 cd write (2,*) 'In calc_eello6'
6065 cd write (2,*) 'iii=',iii
6067 cd write (2,*) 'kkk=',kkk
6069 cd write (2,'(3(2f10.5),5x)')
6070 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6075 call transpose2(EUgder(1,1,k),auxmat(1,1))
6076 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6077 call transpose2(EUg(1,1,k),auxmat(1,1))
6078 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6079 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6083 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6084 & EAEAderx(1,1,lll,kkk,iii,1))
6088 C A1T kernel(i+1) A2
6089 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6090 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6091 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6092 C Following matrices are needed only for 6-th order cumulants
6093 IF (wcorr6.gt.0.0d0) THEN
6094 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6095 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6096 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6097 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6098 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6099 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6100 & ADtEAderx(1,1,1,1,1,2))
6101 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6102 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6103 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6104 & ADtEA1derx(1,1,1,1,1,2))
6106 C End 6-th order cumulants
6107 call transpose2(EUgder(1,1,l),auxmat(1,1))
6108 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6109 call transpose2(EUg(1,1,l),auxmat(1,1))
6110 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6111 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6115 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6116 & EAEAderx(1,1,lll,kkk,iii,2))
6121 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6122 C They are needed only when the fifth- or the sixth-order cumulants are
6124 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6125 call transpose2(AEA(1,1,1),auxmat(1,1))
6126 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6127 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6128 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6129 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6130 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6131 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6132 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6133 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6134 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6135 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6136 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6137 call transpose2(AEA(1,1,2),auxmat(1,1))
6138 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6139 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6140 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6141 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6142 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6143 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6144 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6145 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6146 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6147 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6148 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6149 C Calculate the Cartesian derivatives of the vectors.
6153 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6154 call matvec2(auxmat(1,1),b1(1,iti),
6155 & AEAb1derx(1,lll,kkk,iii,1,1))
6156 call matvec2(auxmat(1,1),Ub2(1,i),
6157 & AEAb2derx(1,lll,kkk,iii,1,1))
6158 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6159 & AEAb1derx(1,lll,kkk,iii,2,1))
6160 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6161 & AEAb2derx(1,lll,kkk,iii,2,1))
6162 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6163 call matvec2(auxmat(1,1),b1(1,itj),
6164 & AEAb1derx(1,lll,kkk,iii,1,2))
6165 call matvec2(auxmat(1,1),Ub2(1,j),
6166 & AEAb2derx(1,lll,kkk,iii,1,2))
6167 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6168 & AEAb1derx(1,lll,kkk,iii,2,2))
6169 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6170 & AEAb2derx(1,lll,kkk,iii,2,2))
6177 C Antiparallel orientation of the two CA-CA-CA frames.
6179 iti=itortyp(itype(i))
6183 itk1=itortyp(itype(k+1))
6184 itl=itortyp(itype(l))
6185 itj=itortyp(itype(j))
6186 if (j.lt.nres-1) then
6187 itj1=itortyp(itype(j+1))
6191 C A2 kernel(j-1)T A1T
6192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6193 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6194 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6195 C Following matrices are needed only for 6-th order cumulants
6196 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6197 & j.eq.i+4 .and. l.eq.i+3)) THEN
6198 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6199 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6200 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6201 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6202 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6203 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6204 & ADtEAderx(1,1,1,1,1,1))
6205 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6206 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6207 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6208 & ADtEA1derx(1,1,1,1,1,1))
6210 C End 6-th order cumulants
6211 call transpose2(EUgder(1,1,k),auxmat(1,1))
6212 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6213 call transpose2(EUg(1,1,k),auxmat(1,1))
6214 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6215 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6219 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6220 & EAEAderx(1,1,lll,kkk,iii,1))
6224 C A2T kernel(i+1)T A1
6225 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6226 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6227 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6228 C Following matrices are needed only for 6-th order cumulants
6229 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6230 & j.eq.i+4 .and. l.eq.i+3)) THEN
6231 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6232 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6233 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6234 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6235 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6236 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6237 & ADtEAderx(1,1,1,1,1,2))
6238 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6239 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6240 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6241 & ADtEA1derx(1,1,1,1,1,2))
6243 C End 6-th order cumulants
6244 call transpose2(EUgder(1,1,j),auxmat(1,1))
6245 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6246 call transpose2(EUg(1,1,j),auxmat(1,1))
6247 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6248 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6252 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6253 & EAEAderx(1,1,lll,kkk,iii,2))
6258 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6259 C They are needed only when the fifth- or the sixth-order cumulants are
6261 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6262 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6263 call transpose2(AEA(1,1,1),auxmat(1,1))
6264 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6265 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6266 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6267 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6268 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6269 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6270 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6271 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6272 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6273 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6274 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6275 call transpose2(AEA(1,1,2),auxmat(1,1))
6276 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6277 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6278 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6279 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6280 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6281 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6282 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6283 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6284 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6285 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6286 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6287 C Calculate the Cartesian derivatives of the vectors.
6291 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6292 call matvec2(auxmat(1,1),b1(1,iti),
6293 & AEAb1derx(1,lll,kkk,iii,1,1))
6294 call matvec2(auxmat(1,1),Ub2(1,i),
6295 & AEAb2derx(1,lll,kkk,iii,1,1))
6296 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6297 & AEAb1derx(1,lll,kkk,iii,2,1))
6298 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6299 & AEAb2derx(1,lll,kkk,iii,2,1))
6300 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6301 call matvec2(auxmat(1,1),b1(1,itl),
6302 & AEAb1derx(1,lll,kkk,iii,1,2))
6303 call matvec2(auxmat(1,1),Ub2(1,l),
6304 & AEAb2derx(1,lll,kkk,iii,1,2))
6305 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6306 & AEAb1derx(1,lll,kkk,iii,2,2))
6307 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6308 & AEAb2derx(1,lll,kkk,iii,2,2))
6317 C---------------------------------------------------------------------------
6318 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6319 & KK,KKderg,AKA,AKAderg,AKAderx)
6323 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6324 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6325 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6330 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6332 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6335 cd if (lprn) write (2,*) 'In kernel'
6337 cd if (lprn) write (2,*) 'kkk=',kkk
6339 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6340 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6342 cd write (2,*) 'lll=',lll
6343 cd write (2,*) 'iii=1'
6345 cd write (2,'(3(2f10.5),5x)')
6346 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6349 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6350 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6352 cd write (2,*) 'lll=',lll
6353 cd write (2,*) 'iii=2'
6355 cd write (2,'(3(2f10.5),5x)')
6356 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6363 C---------------------------------------------------------------------------
6364 double precision function eello4(i,j,k,l,jj,kk)
6365 implicit real*8 (a-h,o-z)
6366 include 'DIMENSIONS'
6367 include 'DIMENSIONS.ZSCOPT'
6368 include 'COMMON.IOUNITS'
6369 include 'COMMON.CHAIN'
6370 include 'COMMON.DERIV'
6371 include 'COMMON.INTERACT'
6372 include 'COMMON.CONTACTS'
6373 include 'COMMON.TORSION'
6374 include 'COMMON.VAR'
6375 include 'COMMON.GEO'
6376 double precision pizda(2,2),ggg1(3),ggg2(3)
6377 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6381 cd print *,'eello4:',i,j,k,l,jj,kk
6382 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6383 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6384 cold eij=facont_hb(jj,i)
6385 cold ekl=facont_hb(kk,k)
6387 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6389 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6390 gcorr_loc(k-1)=gcorr_loc(k-1)
6391 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6393 gcorr_loc(l-1)=gcorr_loc(l-1)
6394 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6396 gcorr_loc(j-1)=gcorr_loc(j-1)
6397 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6402 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6403 & -EAEAderx(2,2,lll,kkk,iii,1)
6404 cd derx(lll,kkk,iii)=0.0d0
6408 cd gcorr_loc(l-1)=0.0d0
6409 cd gcorr_loc(j-1)=0.0d0
6410 cd gcorr_loc(k-1)=0.0d0
6412 cd write (iout,*)'Contacts have occurred for peptide groups',
6413 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6414 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6415 if (j.lt.nres-1) then
6422 if (l.lt.nres-1) then
6430 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6431 ggg1(ll)=eel4*g_contij(ll,1)
6432 ggg2(ll)=eel4*g_contij(ll,2)
6433 ghalf=0.5d0*ggg1(ll)
6435 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6436 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6437 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6438 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6439 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6440 ghalf=0.5d0*ggg2(ll)
6442 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6443 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6444 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6445 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6450 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6451 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6456 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6457 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6463 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6468 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6472 cd write (2,*) iii,gcorr_loc(iii)
6476 cd write (2,*) 'ekont',ekont
6477 cd write (iout,*) 'eello4',ekont*eel4
6480 C---------------------------------------------------------------------------
6481 double precision function eello5(i,j,k,l,jj,kk)
6482 implicit real*8 (a-h,o-z)
6483 include 'DIMENSIONS'
6484 include 'DIMENSIONS.ZSCOPT'
6485 include 'COMMON.IOUNITS'
6486 include 'COMMON.CHAIN'
6487 include 'COMMON.DERIV'
6488 include 'COMMON.INTERACT'
6489 include 'COMMON.CONTACTS'
6490 include 'COMMON.TORSION'
6491 include 'COMMON.VAR'
6492 include 'COMMON.GEO'
6493 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6494 double precision ggg1(3),ggg2(3)
6495 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6500 C /l\ / \ \ / \ / \ / C
6501 C / \ / \ \ / \ / \ / C
6502 C j| o |l1 | o | o| o | | o |o C
6503 C \ |/k\| |/ \| / |/ \| |/ \| C
6504 C \i/ \ / \ / / \ / \ C
6506 C (I) (II) (III) (IV) C
6508 C eello5_1 eello5_2 eello5_3 eello5_4 C
6510 C Antiparallel chains C
6513 C /j\ / \ \ / \ / \ / C
6514 C / \ / \ \ / \ / \ / C
6515 C j1| o |l | o | o| o | | o |o C
6516 C \ |/k\| |/ \| / |/ \| |/ \| C
6517 C \i/ \ / \ / / \ / \ C
6519 C (I) (II) (III) (IV) C
6521 C eello5_1 eello5_2 eello5_3 eello5_4 C
6523 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6525 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6526 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6531 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6533 itk=itortyp(itype(k))
6534 itl=itortyp(itype(l))
6535 itj=itortyp(itype(j))
6540 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6541 cd & eel5_3_num,eel5_4_num)
6545 derx(lll,kkk,iii)=0.0d0
6549 cd eij=facont_hb(jj,i)
6550 cd ekl=facont_hb(kk,k)
6552 cd write (iout,*)'Contacts have occurred for peptide groups',
6553 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6555 C Contribution from the graph I.
6556 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6557 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6558 call transpose2(EUg(1,1,k),auxmat(1,1))
6559 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6560 vv(1)=pizda(1,1)-pizda(2,2)
6561 vv(2)=pizda(1,2)+pizda(2,1)
6562 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6563 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6565 C Explicit gradient in virtual-dihedral angles.
6566 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6567 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6568 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6569 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6570 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6571 vv(1)=pizda(1,1)-pizda(2,2)
6572 vv(2)=pizda(1,2)+pizda(2,1)
6573 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6574 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6575 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6576 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6577 vv(1)=pizda(1,1)-pizda(2,2)
6578 vv(2)=pizda(1,2)+pizda(2,1)
6580 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6581 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6582 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6584 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6585 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6586 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6588 C Cartesian gradient
6592 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6594 vv(1)=pizda(1,1)-pizda(2,2)
6595 vv(2)=pizda(1,2)+pizda(2,1)
6596 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6597 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6598 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6605 C Contribution from graph II
6606 call transpose2(EE(1,1,itk),auxmat(1,1))
6607 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6608 vv(1)=pizda(1,1)+pizda(2,2)
6609 vv(2)=pizda(2,1)-pizda(1,2)
6610 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6611 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6613 C Explicit gradient in virtual-dihedral angles.
6614 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6615 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6616 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6617 vv(1)=pizda(1,1)+pizda(2,2)
6618 vv(2)=pizda(2,1)-pizda(1,2)
6620 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6621 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6622 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6624 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6625 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6626 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6628 C Cartesian gradient
6632 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6634 vv(1)=pizda(1,1)+pizda(2,2)
6635 vv(2)=pizda(2,1)-pizda(1,2)
6636 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6637 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6638 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6647 C Parallel orientation
6648 C Contribution from graph III
6649 call transpose2(EUg(1,1,l),auxmat(1,1))
6650 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6651 vv(1)=pizda(1,1)-pizda(2,2)
6652 vv(2)=pizda(1,2)+pizda(2,1)
6653 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6654 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6656 C Explicit gradient in virtual-dihedral angles.
6657 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6658 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6659 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6660 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6661 vv(1)=pizda(1,1)-pizda(2,2)
6662 vv(2)=pizda(1,2)+pizda(2,1)
6663 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6664 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6665 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6666 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6667 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6668 vv(1)=pizda(1,1)-pizda(2,2)
6669 vv(2)=pizda(1,2)+pizda(2,1)
6670 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6671 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6672 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6673 C Cartesian gradient
6677 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6679 vv(1)=pizda(1,1)-pizda(2,2)
6680 vv(2)=pizda(1,2)+pizda(2,1)
6681 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6682 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6683 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6689 C Contribution from graph IV
6691 call transpose2(EE(1,1,itl),auxmat(1,1))
6692 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6693 vv(1)=pizda(1,1)+pizda(2,2)
6694 vv(2)=pizda(2,1)-pizda(1,2)
6695 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6696 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6698 C Explicit gradient in virtual-dihedral angles.
6699 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6700 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6701 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6702 vv(1)=pizda(1,1)+pizda(2,2)
6703 vv(2)=pizda(2,1)-pizda(1,2)
6704 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6705 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6706 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6707 C Cartesian gradient
6711 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6713 vv(1)=pizda(1,1)+pizda(2,2)
6714 vv(2)=pizda(2,1)-pizda(1,2)
6715 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6716 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6717 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6723 C Antiparallel orientation
6724 C Contribution from graph III
6726 call transpose2(EUg(1,1,j),auxmat(1,1))
6727 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6728 vv(1)=pizda(1,1)-pizda(2,2)
6729 vv(2)=pizda(1,2)+pizda(2,1)
6730 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6731 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6733 C Explicit gradient in virtual-dihedral angles.
6734 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6735 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6736 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6737 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6738 vv(1)=pizda(1,1)-pizda(2,2)
6739 vv(2)=pizda(1,2)+pizda(2,1)
6740 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6741 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6742 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6743 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6744 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6745 vv(1)=pizda(1,1)-pizda(2,2)
6746 vv(2)=pizda(1,2)+pizda(2,1)
6747 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6748 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6749 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6750 C Cartesian gradient
6754 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6756 vv(1)=pizda(1,1)-pizda(2,2)
6757 vv(2)=pizda(1,2)+pizda(2,1)
6758 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6759 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6760 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6766 C Contribution from graph IV
6768 call transpose2(EE(1,1,itj),auxmat(1,1))
6769 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6770 vv(1)=pizda(1,1)+pizda(2,2)
6771 vv(2)=pizda(2,1)-pizda(1,2)
6772 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6773 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6775 C Explicit gradient in virtual-dihedral angles.
6776 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6777 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6778 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6779 vv(1)=pizda(1,1)+pizda(2,2)
6780 vv(2)=pizda(2,1)-pizda(1,2)
6781 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6782 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6783 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6784 C Cartesian gradient
6788 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6790 vv(1)=pizda(1,1)+pizda(2,2)
6791 vv(2)=pizda(2,1)-pizda(1,2)
6792 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6793 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6794 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6801 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6802 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6803 cd write (2,*) 'ijkl',i,j,k,l
6804 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6805 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6807 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6808 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6809 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6810 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6812 if (j.lt.nres-1) then
6819 if (l.lt.nres-1) then
6829 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6831 ggg1(ll)=eel5*g_contij(ll,1)
6832 ggg2(ll)=eel5*g_contij(ll,2)
6833 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6834 ghalf=0.5d0*ggg1(ll)
6836 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6837 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6838 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6839 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6840 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6841 ghalf=0.5d0*ggg2(ll)
6843 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6844 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6845 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6846 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6851 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6852 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6857 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6858 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6864 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6869 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6873 cd write (2,*) iii,g_corr5_loc(iii)
6877 cd write (2,*) 'ekont',ekont
6878 cd write (iout,*) 'eello5',ekont*eel5
6881 c--------------------------------------------------------------------------
6882 double precision function eello6(i,j,k,l,jj,kk)
6883 implicit real*8 (a-h,o-z)
6884 include 'DIMENSIONS'
6885 include 'DIMENSIONS.ZSCOPT'
6886 include 'COMMON.IOUNITS'
6887 include 'COMMON.CHAIN'
6888 include 'COMMON.DERIV'
6889 include 'COMMON.INTERACT'
6890 include 'COMMON.CONTACTS'
6891 include 'COMMON.TORSION'
6892 include 'COMMON.VAR'
6893 include 'COMMON.GEO'
6894 include 'COMMON.FFIELD'
6895 double precision ggg1(3),ggg2(3)
6896 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6901 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6909 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6910 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6914 derx(lll,kkk,iii)=0.0d0
6918 cd eij=facont_hb(jj,i)
6919 cd ekl=facont_hb(kk,k)
6925 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6926 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6927 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6928 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6929 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6930 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6932 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6933 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6934 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6935 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6936 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6937 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6941 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6943 C If turn contributions are considered, they will be handled separately.
6944 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6945 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6946 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6947 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6948 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6949 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6950 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6953 if (j.lt.nres-1) then
6960 if (l.lt.nres-1) then
6968 ggg1(ll)=eel6*g_contij(ll,1)
6969 ggg2(ll)=eel6*g_contij(ll,2)
6970 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6971 ghalf=0.5d0*ggg1(ll)
6973 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6974 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6975 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6976 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6977 ghalf=0.5d0*ggg2(ll)
6978 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6980 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6981 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6982 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6983 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6988 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6989 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6994 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6995 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7001 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7006 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7010 cd write (2,*) iii,g_corr6_loc(iii)
7014 cd write (2,*) 'ekont',ekont
7015 cd write (iout,*) 'eello6',ekont*eel6
7018 c--------------------------------------------------------------------------
7019 double precision function eello6_graph1(i,j,k,l,imat,swap)
7020 implicit real*8 (a-h,o-z)
7021 include 'DIMENSIONS'
7022 include 'DIMENSIONS.ZSCOPT'
7023 include 'COMMON.IOUNITS'
7024 include 'COMMON.CHAIN'
7025 include 'COMMON.DERIV'
7026 include 'COMMON.INTERACT'
7027 include 'COMMON.CONTACTS'
7028 include 'COMMON.TORSION'
7029 include 'COMMON.VAR'
7030 include 'COMMON.GEO'
7031 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7035 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7037 C Parallel Antiparallel C
7043 C \ j|/k\| / \ |/k\|l / C
7048 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7049 itk=itortyp(itype(k))
7050 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7051 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7052 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7053 call transpose2(EUgC(1,1,k),auxmat(1,1))
7054 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7055 vv1(1)=pizda1(1,1)-pizda1(2,2)
7056 vv1(2)=pizda1(1,2)+pizda1(2,1)
7057 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7058 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7059 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7060 s5=scalar2(vv(1),Dtobr2(1,i))
7061 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7062 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7063 if (.not. calc_grad) return
7064 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7065 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7066 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7067 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7068 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7069 & +scalar2(vv(1),Dtobr2der(1,i)))
7070 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7071 vv1(1)=pizda1(1,1)-pizda1(2,2)
7072 vv1(2)=pizda1(1,2)+pizda1(2,1)
7073 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7074 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7076 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7077 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7078 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7079 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7080 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7082 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7083 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7084 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7085 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7086 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7088 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7089 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7090 vv1(1)=pizda1(1,1)-pizda1(2,2)
7091 vv1(2)=pizda1(1,2)+pizda1(2,1)
7092 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7093 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7094 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7095 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7104 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7105 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7106 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7107 call transpose2(EUgC(1,1,k),auxmat(1,1))
7108 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7110 vv1(1)=pizda1(1,1)-pizda1(2,2)
7111 vv1(2)=pizda1(1,2)+pizda1(2,1)
7112 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7113 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7114 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7115 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7116 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7117 s5=scalar2(vv(1),Dtobr2(1,i))
7118 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7124 c----------------------------------------------------------------------------
7125 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7126 implicit real*8 (a-h,o-z)
7127 include 'DIMENSIONS'
7128 include 'DIMENSIONS.ZSCOPT'
7129 include 'COMMON.IOUNITS'
7130 include 'COMMON.CHAIN'
7131 include 'COMMON.DERIV'
7132 include 'COMMON.INTERACT'
7133 include 'COMMON.CONTACTS'
7134 include 'COMMON.TORSION'
7135 include 'COMMON.VAR'
7136 include 'COMMON.GEO'
7138 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7139 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7142 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7144 C Parallel Antiparallel C
7150 C \ j|/k\| \ |/k\|l C
7155 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7156 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7157 C AL 7/4/01 s1 would occur in the sixth-order moment,
7158 C but not in a cluster cumulant
7160 s1=dip(1,jj,i)*dip(1,kk,k)
7162 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7163 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7164 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7165 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7166 call transpose2(EUg(1,1,k),auxmat(1,1))
7167 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7168 vv(1)=pizda(1,1)-pizda(2,2)
7169 vv(2)=pizda(1,2)+pizda(2,1)
7170 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7171 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7173 eello6_graph2=-(s1+s2+s3+s4)
7175 eello6_graph2=-(s2+s3+s4)
7178 if (.not. calc_grad) return
7179 C Derivatives in gamma(i-1)
7182 s1=dipderg(1,jj,i)*dip(1,kk,k)
7184 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7185 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7186 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7187 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7189 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7191 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7193 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7195 C Derivatives in gamma(k-1)
7197 s1=dip(1,jj,i)*dipderg(1,kk,k)
7199 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7200 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7201 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7202 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7203 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7204 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7205 vv(1)=pizda(1,1)-pizda(2,2)
7206 vv(2)=pizda(1,2)+pizda(2,1)
7207 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7209 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7211 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7213 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7214 C Derivatives in gamma(j-1) or gamma(l-1)
7217 s1=dipderg(3,jj,i)*dip(1,kk,k)
7219 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7220 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7221 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7222 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7223 vv(1)=pizda(1,1)-pizda(2,2)
7224 vv(2)=pizda(1,2)+pizda(2,1)
7225 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7228 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7230 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7233 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7234 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7236 C Derivatives in gamma(l-1) or gamma(j-1)
7239 s1=dip(1,jj,i)*dipderg(3,kk,k)
7241 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7242 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7243 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7244 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7245 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7246 vv(1)=pizda(1,1)-pizda(2,2)
7247 vv(2)=pizda(1,2)+pizda(2,1)
7248 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7251 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7253 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7256 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7257 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7259 C Cartesian derivatives.
7261 write (2,*) 'In eello6_graph2'
7263 write (2,*) 'iii=',iii
7265 write (2,*) 'kkk=',kkk
7267 write (2,'(3(2f10.5),5x)')
7268 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7278 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7280 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7283 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7285 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7286 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7288 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7289 call transpose2(EUg(1,1,k),auxmat(1,1))
7290 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7292 vv(1)=pizda(1,1)-pizda(2,2)
7293 vv(2)=pizda(1,2)+pizda(2,1)
7294 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7295 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7297 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7299 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7302 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7304 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7311 c----------------------------------------------------------------------------
7312 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7313 implicit real*8 (a-h,o-z)
7314 include 'DIMENSIONS'
7315 include 'DIMENSIONS.ZSCOPT'
7316 include 'COMMON.IOUNITS'
7317 include 'COMMON.CHAIN'
7318 include 'COMMON.DERIV'
7319 include 'COMMON.INTERACT'
7320 include 'COMMON.CONTACTS'
7321 include 'COMMON.TORSION'
7322 include 'COMMON.VAR'
7323 include 'COMMON.GEO'
7324 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7326 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7328 C Parallel Antiparallel C
7334 C j|/k\| / |/k\|l / C
7339 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7341 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7342 C energy moment and not to the cluster cumulant.
7343 iti=itortyp(itype(i))
7344 if (j.lt.nres-1) then
7345 itj1=itortyp(itype(j+1))
7349 itk=itortyp(itype(k))
7350 itk1=itortyp(itype(k+1))
7351 if (l.lt.nres-1) then
7352 itl1=itortyp(itype(l+1))
7357 s1=dip(4,jj,i)*dip(4,kk,k)
7359 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7360 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7361 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7362 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7363 call transpose2(EE(1,1,itk),auxmat(1,1))
7364 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7365 vv(1)=pizda(1,1)+pizda(2,2)
7366 vv(2)=pizda(2,1)-pizda(1,2)
7367 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7368 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7370 eello6_graph3=-(s1+s2+s3+s4)
7372 eello6_graph3=-(s2+s3+s4)
7375 if (.not. calc_grad) return
7376 C Derivatives in gamma(k-1)
7377 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7378 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7379 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7380 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7381 C Derivatives in gamma(l-1)
7382 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7383 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7384 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7385 vv(1)=pizda(1,1)+pizda(2,2)
7386 vv(2)=pizda(2,1)-pizda(1,2)
7387 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7388 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7389 C Cartesian derivatives.
7395 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7397 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7400 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7402 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7403 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7405 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7406 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7408 vv(1)=pizda(1,1)+pizda(2,2)
7409 vv(2)=pizda(2,1)-pizda(1,2)
7410 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7412 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7414 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7417 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7421 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7427 c----------------------------------------------------------------------------
7428 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7429 implicit real*8 (a-h,o-z)
7430 include 'DIMENSIONS'
7431 include 'DIMENSIONS.ZSCOPT'
7432 include 'COMMON.IOUNITS'
7433 include 'COMMON.CHAIN'
7434 include 'COMMON.DERIV'
7435 include 'COMMON.INTERACT'
7436 include 'COMMON.CONTACTS'
7437 include 'COMMON.TORSION'
7438 include 'COMMON.VAR'
7439 include 'COMMON.GEO'
7440 include 'COMMON.FFIELD'
7441 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7442 & auxvec1(2),auxmat1(2,2)
7444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7446 C Parallel Antiparallel C
7452 C \ j|/k\| \ |/k\|l C
7457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7459 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7460 C energy moment and not to the cluster cumulant.
7461 cd write (2,*) 'eello_graph4: wturn6',wturn6
7462 iti=itortyp(itype(i))
7463 itj=itortyp(itype(j))
7464 if (j.lt.nres-1) then
7465 itj1=itortyp(itype(j+1))
7469 itk=itortyp(itype(k))
7470 if (k.lt.nres-1) then
7471 itk1=itortyp(itype(k+1))
7475 itl=itortyp(itype(l))
7476 if (l.lt.nres-1) then
7477 itl1=itortyp(itype(l+1))
7481 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7482 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7483 cd & ' itl',itl,' itl1',itl1
7486 s1=dip(3,jj,i)*dip(3,kk,k)
7488 s1=dip(2,jj,j)*dip(2,kk,l)
7491 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7492 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7494 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7495 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7497 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7498 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7500 call transpose2(EUg(1,1,k),auxmat(1,1))
7501 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7502 vv(1)=pizda(1,1)-pizda(2,2)
7503 vv(2)=pizda(2,1)+pizda(1,2)
7504 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7505 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7507 eello6_graph4=-(s1+s2+s3+s4)
7509 eello6_graph4=-(s2+s3+s4)
7511 if (.not. calc_grad) return
7512 C Derivatives in gamma(i-1)
7516 s1=dipderg(2,jj,i)*dip(3,kk,k)
7518 s1=dipderg(4,jj,j)*dip(2,kk,l)
7521 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7523 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7524 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7526 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7527 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7529 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7530 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7531 cd write (2,*) 'turn6 derivatives'
7533 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7535 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7539 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7541 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7545 C Derivatives in gamma(k-1)
7548 s1=dip(3,jj,i)*dipderg(2,kk,k)
7550 s1=dip(2,jj,j)*dipderg(4,kk,l)
7553 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7554 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7556 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7557 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7559 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7560 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7562 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7563 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7564 vv(1)=pizda(1,1)-pizda(2,2)
7565 vv(2)=pizda(2,1)+pizda(1,2)
7566 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7567 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7569 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7571 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7575 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7577 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7580 C Derivatives in gamma(j-1) or gamma(l-1)
7581 if (l.eq.j+1 .and. l.gt.1) then
7582 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7583 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7584 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7585 vv(1)=pizda(1,1)-pizda(2,2)
7586 vv(2)=pizda(2,1)+pizda(1,2)
7587 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7588 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7589 else if (j.gt.1) then
7590 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7591 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7592 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7593 vv(1)=pizda(1,1)-pizda(2,2)
7594 vv(2)=pizda(2,1)+pizda(1,2)
7595 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7596 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7597 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7599 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7602 C Cartesian derivatives.
7609 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7611 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7615 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7617 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7621 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7623 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7625 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7626 & b1(1,itj1),auxvec(1))
7627 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7629 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7630 & b1(1,itl1),auxvec(1))
7631 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7633 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(2,1)+pizda(1,2)
7637 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7639 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7641 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7644 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7647 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7650 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7652 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7654 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7658 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7660 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7663 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7665 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7673 c----------------------------------------------------------------------------
7674 double precision function eello_turn6(i,jj,kk)
7675 implicit real*8 (a-h,o-z)
7676 include 'DIMENSIONS'
7677 include 'DIMENSIONS.ZSCOPT'
7678 include 'COMMON.IOUNITS'
7679 include 'COMMON.CHAIN'
7680 include 'COMMON.DERIV'
7681 include 'COMMON.INTERACT'
7682 include 'COMMON.CONTACTS'
7683 include 'COMMON.TORSION'
7684 include 'COMMON.VAR'
7685 include 'COMMON.GEO'
7686 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7687 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7689 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7690 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7691 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7692 C the respective energy moment and not to the cluster cumulant.
7697 iti=itortyp(itype(i))
7698 itk=itortyp(itype(k))
7699 itk1=itortyp(itype(k+1))
7700 itl=itortyp(itype(l))
7701 itj=itortyp(itype(j))
7702 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7703 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7704 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7709 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7711 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7715 derx_turn(lll,kkk,iii)=0.0d0
7722 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7724 cd write (2,*) 'eello6_5',eello6_5
7726 call transpose2(AEA(1,1,1),auxmat(1,1))
7727 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7728 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7729 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7733 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7734 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7735 s2 = scalar2(b1(1,itk),vtemp1(1))
7737 call transpose2(AEA(1,1,2),atemp(1,1))
7738 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7739 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7740 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7744 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7745 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7746 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7748 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7749 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7750 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7751 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7752 ss13 = scalar2(b1(1,itk),vtemp4(1))
7753 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7757 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7763 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7765 C Derivatives in gamma(i+2)
7767 call transpose2(AEA(1,1,1),auxmatd(1,1))
7768 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7769 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7770 call transpose2(AEAderg(1,1,2),atempd(1,1))
7771 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7772 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7776 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7777 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7778 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7784 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7785 C Derivatives in gamma(i+3)
7787 call transpose2(AEA(1,1,1),auxmatd(1,1))
7788 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7789 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7790 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7794 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7795 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7796 s2d = scalar2(b1(1,itk),vtemp1d(1))
7798 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7799 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7801 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7803 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7804 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7805 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7815 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7816 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7818 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7819 & -0.5d0*ekont*(s2d+s12d)
7821 C Derivatives in gamma(i+4)
7822 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7823 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7824 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7826 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7827 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7828 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7838 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7840 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7842 C Derivatives in gamma(i+5)
7844 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7845 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7846 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7850 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7851 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7852 s2d = scalar2(b1(1,itk),vtemp1d(1))
7854 call transpose2(AEA(1,1,2),atempd(1,1))
7855 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7856 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7860 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7861 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7863 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7864 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7865 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7875 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7876 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7878 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7879 & -0.5d0*ekont*(s2d+s12d)
7881 C Cartesian derivatives
7886 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7887 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7888 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7892 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7893 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7895 s2d = scalar2(b1(1,itk),vtemp1d(1))
7897 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7898 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7899 s8d = -(atempd(1,1)+atempd(2,2))*
7900 & scalar2(cc(1,1,itl),vtemp2(1))
7904 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7906 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7907 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7914 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7917 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7921 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7922 & - 0.5d0*(s8d+s12d)
7924 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7933 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7935 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7936 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7937 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7938 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7939 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7941 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7942 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7943 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7947 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7948 cd & 16*eel_turn6_num
7950 if (j.lt.nres-1) then
7957 if (l.lt.nres-1) then
7965 ggg1(ll)=eel_turn6*g_contij(ll,1)
7966 ggg2(ll)=eel_turn6*g_contij(ll,2)
7967 ghalf=0.5d0*ggg1(ll)
7969 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7970 & +ekont*derx_turn(ll,2,1)
7971 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7972 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7973 & +ekont*derx_turn(ll,4,1)
7974 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7975 ghalf=0.5d0*ggg2(ll)
7977 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7978 & +ekont*derx_turn(ll,2,2)
7979 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7980 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7981 & +ekont*derx_turn(ll,4,2)
7982 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7987 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7992 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7998 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8003 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8007 cd write (2,*) iii,g_corr6_loc(iii)
8010 eello_turn6=ekont*eel_turn6
8011 cd write (2,*) 'ekont',ekont
8012 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8015 crc-------------------------------------------------
8016 SUBROUTINE MATVEC2(A1,V1,V2)
8017 implicit real*8 (a-h,o-z)
8018 include 'DIMENSIONS'
8019 DIMENSION A1(2,2),V1(2),V2(2)
8023 c 3 VI=VI+A1(I,K)*V1(K)
8027 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8028 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8033 C---------------------------------------
8034 SUBROUTINE MATMAT2(A1,A2,A3)
8035 implicit real*8 (a-h,o-z)
8036 include 'DIMENSIONS'
8037 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8038 c DIMENSION AI3(2,2)
8042 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8048 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8049 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8050 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8051 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8059 c-------------------------------------------------------------------------
8060 double precision function scalar2(u,v)
8062 double precision u(2),v(2)
8065 scalar2=u(1)*v(1)+u(2)*v(2)
8069 C-----------------------------------------------------------------------------
8071 subroutine transpose2(a,at)
8073 double precision a(2,2),at(2,2)
8080 c--------------------------------------------------------------------------
8081 subroutine transpose(n,a,at)
8084 double precision a(n,n),at(n,n)
8092 C---------------------------------------------------------------------------
8093 subroutine prodmat3(a1,a2,kk,transp,prod)
8096 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8098 crc double precision auxmat(2,2),prod_(2,2)
8101 crc call transpose2(kk(1,1),auxmat(1,1))
8102 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8103 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8105 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8106 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8107 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8108 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8109 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8110 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8111 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8112 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8115 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8116 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8118 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8119 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8120 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8121 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8122 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8123 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8124 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8125 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8128 c call transpose2(a2(1,1),a2t(1,1))
8131 crc print *,((prod_(i,j),i=1,2),j=1,2)
8132 crc print *,((prod(i,j),i=1,2),j=1,2)
8136 C-----------------------------------------------------------------------------
8137 double precision function scalar(u,v)
8139 double precision u(3),v(3)