1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
11 cMS$ATTRIBUTES C :: proc_proc
14 include 'COMMON.IOUNITS'
15 double precision energia(0:max_ene),energia1(0:max_ene+1)
21 include 'COMMON.FFIELD'
22 include 'COMMON.DERIV'
23 include 'COMMON.INTERACT'
24 include 'COMMON.SBRIDGE'
25 include 'COMMON.CHAIN'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
64 C Calculate the disulfide-bridge and other energy and the contributions
65 C from other distance constraints.
66 cd print *,'Calling EHPB'
68 cd print *,'EHPB exitted succesfully.'
70 C Calculate the virtual-bond-angle energy.
73 cd print *,'Bend energy finished.'
75 C Calculate the SC local energy.
78 cd print *,'SCLOC energy finished.'
80 C Calculate the virtual-bond torsional energy.
82 cd print *,'nterm=',nterm
83 call etor(etors,edihcnstr,fact(1))
85 C 6/23/01 Calculate double-torsional energy
87 call etor_d(etors_d,fact(2))
89 C 21/5/07 Calculate local sicdechain correlation energy
91 call eback_sc_corr(esccor)
93 C 12/1/95 Multi-body terms
97 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
98 & .or. wturn6.gt.0.0d0) then
99 c print *,"calling multibody_eello"
100 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
101 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
102 c print *,ecorr,ecorr5,ecorr6,eturn6
109 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
110 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
112 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
113 if (constr_homology.ge.1) then
114 call e_modeller(ehomology_constr)
116 ehomology_constr=0.0d0
119 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
120 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
122 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
124 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
125 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
126 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
127 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
128 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
129 & +wbond*estr+wsccor*fact(1)*esccor
131 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
132 & +welec*fact(1)*(ees+evdw1)
133 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
134 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
135 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
136 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
137 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
138 & +wbond*estr+wsccor*fact(1)*esccor
143 energia(2)=evdw2-evdw2_14
160 energia(8)=eello_turn3
161 energia(9)=eello_turn4
170 energia(20)=edihcnstr
172 energia(22)=ehomology_constr
176 if (isnan(etot).ne.0) energia(0)=1.0d+99
178 if (isnan(etot)) energia(0)=1.0d+99
183 idumm=proc_proc(etot,i)
185 call proc_proc(etot,i)
187 if(i.eq.1)energia(0)=1.0d+99
193 call enerprint(energia,fact)
197 C Sum up the components of the Cartesian gradient.
202 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
203 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
205 & wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 & +wliptran*gliptranc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(2)*gsccorx(j,i)
223 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
224 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
226 & wcorr*fact(3)*gradcorr(j,i)+
227 & wel_loc*fact(2)*gel_loc(j,i)+
228 & wturn3*fact(2)*gcorr3_turn(j,i)+
229 & wturn4*fact(3)*gcorr4_turn(j,i)+
230 & wcorr5*fact(4)*gradcorr5(j,i)+
231 & wcorr6*fact(5)*gradcorr6(j,i)+
232 & wturn6*fact(5)*gcorr6_turn(j,i)+
233 & wsccor*fact(2)*gsccorc(j,i)
234 & +wliptran*gliptranc(j,i)
235 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
237 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
238 & wsccor*fact(1)*gsccorx(j,i)
239 & +wliptran*gliptranx(j,i)
246 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
247 & +wcorr5*fact(4)*g_corr5_loc(i)
248 & +wcorr6*fact(5)*g_corr6_loc(i)
249 & +wturn4*fact(3)*gel_loc_turn4(i)
250 & +wturn3*fact(2)*gel_loc_turn3(i)
251 & +wturn6*fact(5)*gel_loc_turn6(i)
252 & +wel_loc*fact(2)*gel_loc_loc(i)
253 c & +wsccor*fact(1)*gsccor_loc(i)
254 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
257 if (dyn_ss) call dyn_set_nss
260 C------------------------------------------------------------------------
261 subroutine enerprint(energia,fact)
262 implicit real*8 (a-h,o-z)
264 include 'DIMENSIONS.ZSCOPT'
265 include 'COMMON.IOUNITS'
266 include 'COMMON.FFIELD'
267 include 'COMMON.SBRIDGE'
268 double precision energia(0:max_ene),fact(6)
270 evdw=energia(1)+fact(6)*energia(21)
272 evdw2=energia(2)+energia(17)
284 eello_turn3=energia(8)
285 eello_turn4=energia(9)
286 eello_turn6=energia(10)
293 edihcnstr=energia(20)
295 ehomology_constr=energia(22)
297 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
299 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
300 & etors_d,wtor_d*fact(2),ehpb,wstrain,
301 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
302 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
303 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
304 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,etot
305 10 format (/'Virtual-chain energies:'//
306 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
307 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
308 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
309 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
310 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
311 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
312 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
313 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
314 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
315 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
316 & ' (SS bridges & dist. cnstr.)'/
317 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
320 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
321 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
322 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
323 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
324 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
325 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
326 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
327 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
328 & 'ETOT= ',1pE16.6,' (total)')
330 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
331 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
332 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
333 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
334 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
335 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
336 & edihcnstr,ehomology_constr,ebr*nss,
338 10 format (/'Virtual-chain energies:'//
339 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
340 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
341 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
342 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
343 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
344 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
345 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
346 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
347 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
348 & ' (SS bridges & dist. cnstr.)'/
349 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
350 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
351 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
352 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
353 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
354 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
355 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
356 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
357 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
358 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
359 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
360 & 'ETOT= ',1pE16.6,' (total)')
364 C-----------------------------------------------------------------------
365 subroutine elj(evdw,evdw_t)
367 C This subroutine calculates the interaction energy of nonbonded side chains
368 C assuming the LJ potential of interaction.
370 implicit real*8 (a-h,o-z)
372 include 'DIMENSIONS.ZSCOPT'
373 include "DIMENSIONS.COMPAR"
374 parameter (accur=1.0d-10)
377 include 'COMMON.LOCAL'
378 include 'COMMON.CHAIN'
379 include 'COMMON.DERIV'
380 include 'COMMON.INTERACT'
381 include 'COMMON.TORSION'
382 include 'COMMON.ENEPS'
383 include 'COMMON.SBRIDGE'
384 include 'COMMON.NAMES'
385 include 'COMMON.IOUNITS'
386 include 'COMMON.CONTACTS'
390 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
393 eneps_temp(j,i)=0.0d0
400 if (itypi.eq.ntyp1) cycle
401 itypi1=iabs(itype(i+1))
408 C Calculate SC interaction energy.
411 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
412 cd & 'iend=',iend(i,iint)
413 do j=istart(i,iint),iend(i,iint)
415 if (itypj.eq.ntyp1) cycle
419 C Change 12/1/95 to calculate four-body interactions
420 rij=xj*xj+yj*yj+zj*zj
422 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
423 eps0ij=eps(itypi,itypj)
428 ij=icant(itypi,itypj)
429 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
430 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
431 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
432 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
433 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
434 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
435 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
436 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
437 if (bb.gt.0.0d0) then
444 C Calculate the components of the gradient in DC and X
446 fac=-rrij*(e1+evdwij)
451 gvdwx(k,i)=gvdwx(k,i)-gg(k)
452 gvdwx(k,j)=gvdwx(k,j)+gg(k)
456 gvdwc(l,k)=gvdwc(l,k)+gg(l)
461 C 12/1/95, revised on 5/20/97
463 C Calculate the contact function. The ith column of the array JCONT will
464 C contain the numbers of atoms that make contacts with the atom I (of numbers
465 C greater than I). The arrays FACONT and GACONT will contain the values of
466 C the contact function and its derivative.
468 C Uncomment next line, if the correlation interactions include EVDW explicitly.
469 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
470 C Uncomment next line, if the correlation interactions are contact function only
471 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
473 sigij=sigma(itypi,itypj)
474 r0ij=rs0(itypi,itypj)
476 C Check whether the SC's are not too far to make a contact.
479 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
480 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
482 if (fcont.gt.0.0D0) then
483 C If the SC-SC distance if close to sigma, apply spline.
484 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
485 cAdam & fcont1,fprimcont1)
486 cAdam fcont1=1.0d0-fcont1
487 cAdam if (fcont1.gt.0.0d0) then
488 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
489 cAdam fcont=fcont*fcont1
491 C Uncomment following 4 lines to have the geometric average of the epsilon0's
492 cga eps0ij=1.0d0/dsqrt(eps0ij)
494 cga gg(k)=gg(k)*eps0ij
496 cga eps0ij=-evdwij*eps0ij
497 C Uncomment for AL's type of SC correlation interactions.
499 num_conti=num_conti+1
501 facont(num_conti,i)=fcont*eps0ij
502 fprimcont=eps0ij*fprimcont/rij
504 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
505 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
506 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
507 C Uncomment following 3 lines for Skolnick's type of SC correlation.
508 gacont(1,num_conti,i)=-fprimcont*xj
509 gacont(2,num_conti,i)=-fprimcont*yj
510 gacont(3,num_conti,i)=-fprimcont*zj
511 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
512 cd write (iout,'(2i3,3f10.5)')
513 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
519 num_cont(i)=num_conti
524 gvdwc(j,i)=expon*gvdwc(j,i)
525 gvdwx(j,i)=expon*gvdwx(j,i)
529 C******************************************************************************
533 C To save time, the factor of EXPON has been extracted from ALL components
534 C of GVDWC and GRADX. Remember to multiply them by this factor before further
537 C******************************************************************************
540 C-----------------------------------------------------------------------------
541 subroutine eljk(evdw,evdw_t)
543 C This subroutine calculates the interaction energy of nonbonded side chains
544 C assuming the LJK potential of interaction.
546 implicit real*8 (a-h,o-z)
548 include 'DIMENSIONS.ZSCOPT'
549 include "DIMENSIONS.COMPAR"
552 include 'COMMON.LOCAL'
553 include 'COMMON.CHAIN'
554 include 'COMMON.DERIV'
555 include 'COMMON.INTERACT'
556 include 'COMMON.ENEPS'
557 include 'COMMON.IOUNITS'
558 include 'COMMON.NAMES'
563 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
566 eneps_temp(j,i)=0.0d0
573 if (itypi.eq.ntyp1) cycle
574 itypi1=iabs(itype(i+1))
579 C Calculate SC interaction energy.
582 do j=istart(i,iint),iend(i,iint)
584 if (itypj.eq.ntyp1) cycle
588 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
590 e_augm=augm(itypi,itypj)*fac_augm
593 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
594 fac=r_shift_inv**expon
598 ij=icant(itypi,itypj)
599 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
600 & /dabs(eps(itypi,itypj))
601 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
602 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
603 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
604 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
605 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
606 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
607 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
608 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
609 if (bb.gt.0.0d0) then
616 C Calculate the components of the gradient in DC and X
618 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
623 gvdwx(k,i)=gvdwx(k,i)-gg(k)
624 gvdwx(k,j)=gvdwx(k,j)+gg(k)
628 gvdwc(l,k)=gvdwc(l,k)+gg(l)
638 gvdwc(j,i)=expon*gvdwc(j,i)
639 gvdwx(j,i)=expon*gvdwx(j,i)
645 C-----------------------------------------------------------------------------
646 subroutine ebp(evdw,evdw_t)
648 C This subroutine calculates the interaction energy of nonbonded side chains
649 C assuming the Berne-Pechukas potential of interaction.
651 implicit real*8 (a-h,o-z)
653 include 'DIMENSIONS.ZSCOPT'
654 include "DIMENSIONS.COMPAR"
657 include 'COMMON.LOCAL'
658 include 'COMMON.CHAIN'
659 include 'COMMON.DERIV'
660 include 'COMMON.NAMES'
661 include 'COMMON.INTERACT'
662 include 'COMMON.ENEPS'
663 include 'COMMON.IOUNITS'
664 include 'COMMON.CALC'
666 c double precision rrsave(maxdim)
672 eneps_temp(j,i)=0.0d0
677 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
678 c if (icall.eq.0) then
686 if (itypi.eq.ntyp1) cycle
687 itypi1=iabs(itype(i+1))
691 dxi=dc_norm(1,nres+i)
692 dyi=dc_norm(2,nres+i)
693 dzi=dc_norm(3,nres+i)
694 dsci_inv=vbld_inv(i+nres)
696 C Calculate SC interaction energy.
699 do j=istart(i,iint),iend(i,iint)
702 if (itypj.eq.ntyp1) cycle
703 dscj_inv=vbld_inv(j+nres)
704 chi1=chi(itypi,itypj)
705 chi2=chi(itypj,itypi)
712 alf12=0.5D0*(alf1+alf2)
713 C For diagnostics only!!!
726 dxj=dc_norm(1,nres+j)
727 dyj=dc_norm(2,nres+j)
728 dzj=dc_norm(3,nres+j)
729 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
730 cd if (icall.eq.0) then
736 C Calculate the angle-dependent terms of energy & contributions to derivatives.
738 C Calculate whole angle-dependent part of epsilon and contributions
740 fac=(rrij*sigsq)**expon2
743 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
744 eps2der=evdwij*eps3rt
745 eps3der=evdwij*eps2rt
746 evdwij=evdwij*eps2rt*eps3rt
747 ij=icant(itypi,itypj)
748 aux=eps1*eps2rt**2*eps3rt**2
749 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
750 & /dabs(eps(itypi,itypj))
751 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
752 if (bb.gt.0.0d0) then
759 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
761 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
762 & restyp(itypi),i,restyp(itypj),j,
763 & epsi,sigm,chi1,chi2,chip1,chip2,
764 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
765 & om1,om2,om12,1.0D0/dsqrt(rrij),
768 C Calculate gradient components.
769 e1=e1*eps1*eps2rt**2*eps3rt**2
770 fac=-expon*(e1+evdwij)
773 C Calculate radial part of the gradient
777 C Calculate the angular part of the gradient and sum add the contributions
778 C to the appropriate components of the Cartesian gradient.
787 C-----------------------------------------------------------------------------
788 subroutine egb(evdw,evdw_t)
790 C This subroutine calculates the interaction energy of nonbonded side chains
791 C assuming the Gay-Berne potential of interaction.
793 implicit real*8 (a-h,o-z)
795 include 'DIMENSIONS.ZSCOPT'
796 include "DIMENSIONS.COMPAR"
799 include 'COMMON.LOCAL'
800 include 'COMMON.CHAIN'
801 include 'COMMON.DERIV'
802 include 'COMMON.NAMES'
803 include 'COMMON.INTERACT'
804 include 'COMMON.ENEPS'
805 include 'COMMON.IOUNITS'
806 include 'COMMON.CALC'
807 include 'COMMON.SBRIDGE'
810 integer icant,xshift,yshift,zshift
814 eneps_temp(j,i)=0.0d0
817 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
821 c if (icall.gt.0) lprn=.true.
825 if (itypi.eq.ntyp1) cycle
826 itypi1=iabs(itype(i+1))
830 C returning the ith atom to box
832 if (xi.lt.0) xi=xi+boxxsize
834 if (yi.lt.0) yi=yi+boxysize
836 if (zi.lt.0) zi=zi+boxzsize
837 if ((zi.gt.bordlipbot)
838 &.and.(zi.lt.bordliptop)) then
839 C the energy transfer exist
840 if (zi.lt.buflipbot) then
841 C what fraction I am in
843 & ((zi-bordlipbot)/lipbufthick)
844 C lipbufthick is thickenes of lipid buffore
845 sslipi=sscalelip(fracinbuf)
846 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
847 elseif (zi.gt.bufliptop) then
848 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
849 sslipi=sscalelip(fracinbuf)
850 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
860 dxi=dc_norm(1,nres+i)
861 dyi=dc_norm(2,nres+i)
862 dzi=dc_norm(3,nres+i)
863 dsci_inv=vbld_inv(i+nres)
865 C Calculate SC interaction energy.
868 do j=istart(i,iint),iend(i,iint)
869 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
870 call dyn_ssbond_ene(i,j,evdwij)
872 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
873 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
874 C triple bond artifac removal
875 do k=j+1,iend(i,iint)
876 C search over all next residues
877 if (dyn_ss_mask(k)) then
878 C check if they are cysteins
879 C write(iout,*) 'k=',k
880 call triple_ssbond_ene(i,j,k,evdwij)
881 C call the energy function that removes the artifical triple disulfide
882 C bond the soubroutine is located in ssMD.F
884 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
885 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
891 if (itypj.eq.ntyp1) cycle
892 dscj_inv=vbld_inv(j+nres)
893 sig0ij=sigma(itypi,itypj)
894 chi1=chi(itypi,itypj)
895 chi2=chi(itypj,itypi)
902 alf12=0.5D0*(alf1+alf2)
903 C For diagnostics only!!!
916 C returning jth atom to box
918 if (xj.lt.0) xj=xj+boxxsize
920 if (yj.lt.0) yj=yj+boxysize
922 if (zj.lt.0) zj=zj+boxzsize
923 if ((zj.gt.bordlipbot)
924 &.and.(zj.lt.bordliptop)) then
925 C the energy transfer exist
926 if (zj.lt.buflipbot) then
927 C what fraction I am in
929 & ((zj-bordlipbot)/lipbufthick)
930 C lipbufthick is thickenes of lipid buffore
931 sslipj=sscalelip(fracinbuf)
932 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
933 elseif (zj.gt.bufliptop) then
934 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
935 sslipj=sscalelip(fracinbuf)
936 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
945 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
946 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
947 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
948 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
949 C if (aa.ne.aa_aq(itypi,itypj)) then
951 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
952 C & bb_aq(itypi,itypj)-bb,
956 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
957 C checking the distance
958 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
963 C finding the closest
967 xj=xj_safe+xshift*boxxsize
968 yj=yj_safe+yshift*boxysize
969 zj=zj_safe+zshift*boxzsize
970 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
971 if(dist_temp.lt.dist_init) then
981 if (subchap.eq.1) then
991 dxj=dc_norm(1,nres+j)
992 dyj=dc_norm(2,nres+j)
993 dzj=dc_norm(3,nres+j)
994 c write (iout,*) i,j,xj,yj,zj
995 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
997 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
998 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
999 if (sss.le.0.0) cycle
1000 C Calculate angle-dependent terms of energy and contributions to their
1005 sig=sig0ij*dsqrt(sigsq)
1006 rij_shift=1.0D0/rij-sig+sig0ij
1007 C I hate to put IF's in the loops, but here don't have another choice!!!!
1008 if (rij_shift.le.0.0D0) then
1013 c---------------------------------------------------------------
1014 rij_shift=1.0D0/rij_shift
1015 fac=rij_shift**expon
1018 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1019 eps2der=evdwij*eps3rt
1020 eps3der=evdwij*eps2rt
1021 evdwij=evdwij*eps2rt*eps3rt
1023 evdw=evdw+evdwij*sss
1025 evdw_t=evdw_t+evdwij*sss
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1029 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1030 & /dabs(eps(itypi,itypj))
1031 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1032 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1033 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1034 c & aux*e2/eps(itypi,itypj)
1036 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1040 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1041 & restyp(itypi),i,restyp(itypj),j,
1042 & epsi,sigm,chi1,chi2,chip1,chip2,
1043 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1044 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1046 write (iout,*) "partial sum", evdw, evdw_t
1051 C Calculate gradient components.
1052 e1=e1*eps1*eps2rt**2*eps3rt**2
1053 fac=-expon*(e1+evdwij)*rij_shift
1056 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1057 C Calculate the radial part of the gradient
1061 C Calculate angular part of the gradient.
1064 C write(iout,*) "partial sum", evdw, evdw_t
1071 C-----------------------------------------------------------------------------
1072 subroutine egbv(evdw,evdw_t)
1074 C This subroutine calculates the interaction energy of nonbonded side chains
1075 C assuming the Gay-Berne-Vorobjev potential of interaction.
1077 implicit real*8 (a-h,o-z)
1078 include 'DIMENSIONS'
1079 include 'DIMENSIONS.ZSCOPT'
1080 include "DIMENSIONS.COMPAR"
1081 include 'COMMON.GEO'
1082 include 'COMMON.VAR'
1083 include 'COMMON.LOCAL'
1084 include 'COMMON.CHAIN'
1085 include 'COMMON.DERIV'
1086 include 'COMMON.NAMES'
1087 include 'COMMON.INTERACT'
1088 include 'COMMON.ENEPS'
1089 include 'COMMON.IOUNITS'
1090 include 'COMMON.CALC'
1091 common /srutu/ icall
1097 eneps_temp(j,i)=0.0d0
1102 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1105 c if (icall.gt.0) lprn=.true.
1107 do i=iatsc_s,iatsc_e
1108 itypi=iabs(itype(i))
1109 if (itypi.eq.ntyp1) cycle
1110 itypi1=iabs(itype(i+1))
1114 dxi=dc_norm(1,nres+i)
1115 dyi=dc_norm(2,nres+i)
1116 dzi=dc_norm(3,nres+i)
1117 dsci_inv=vbld_inv(i+nres)
1119 C Calculate SC interaction energy.
1121 do iint=1,nint_gr(i)
1122 do j=istart(i,iint),iend(i,iint)
1124 itypj=iabs(itype(j))
1125 if (itypj.eq.ntyp1) cycle
1126 dscj_inv=vbld_inv(j+nres)
1127 sig0ij=sigma(itypi,itypj)
1128 r0ij=r0(itypi,itypj)
1129 chi1=chi(itypi,itypj)
1130 chi2=chi(itypj,itypi)
1137 alf12=0.5D0*(alf1+alf2)
1138 C For diagnostics only!!!
1151 dxj=dc_norm(1,nres+j)
1152 dyj=dc_norm(2,nres+j)
1153 dzj=dc_norm(3,nres+j)
1154 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1156 C Calculate angle-dependent terms of energy and contributions to their
1160 sig=sig0ij*dsqrt(sigsq)
1161 rij_shift=1.0D0/rij-sig+r0ij
1162 C I hate to put IF's in the loops, but here don't have another choice!!!!
1163 if (rij_shift.le.0.0D0) then
1168 c---------------------------------------------------------------
1169 rij_shift=1.0D0/rij_shift
1170 fac=rij_shift**expon
1173 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1174 eps2der=evdwij*eps3rt
1175 eps3der=evdwij*eps2rt
1176 fac_augm=rrij**expon
1177 e_augm=augm(itypi,itypj)*fac_augm
1178 evdwij=evdwij*eps2rt*eps3rt
1179 if (bb.gt.0.0d0) then
1180 evdw=evdw+evdwij+e_augm
1182 evdw_t=evdw_t+evdwij+e_augm
1184 ij=icant(itypi,itypj)
1185 aux=eps1*eps2rt**2*eps3rt**2
1186 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1187 & /dabs(eps(itypi,itypj))
1188 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1189 c eneps_temp(ij)=eneps_temp(ij)
1190 c & +(evdwij+e_augm)/eps(itypi,itypj)
1192 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1193 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1194 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1195 c & restyp(itypi),i,restyp(itypj),j,
1196 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1197 c & chi1,chi2,chip1,chip2,
1198 c & eps1,eps2rt**2,eps3rt**2,
1199 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1203 C Calculate gradient components.
1204 e1=e1*eps1*eps2rt**2*eps3rt**2
1205 fac=-expon*(e1+evdwij)*rij_shift
1207 fac=rij*fac-2*expon*rrij*e_augm
1208 C Calculate the radial part of the gradient
1212 C Calculate angular part of the gradient.
1220 C-----------------------------------------------------------------------------
1221 subroutine sc_angular
1222 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1223 C om12. Called by ebp, egb, and egbv.
1225 include 'COMMON.CALC'
1229 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1230 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1231 om12=dxi*dxj+dyi*dyj+dzi*dzj
1233 C Calculate eps1(om12) and its derivative in om12
1234 faceps1=1.0D0-om12*chiom12
1235 faceps1_inv=1.0D0/faceps1
1236 eps1=dsqrt(faceps1_inv)
1237 C Following variable is eps1*deps1/dom12
1238 eps1_om12=faceps1_inv*chiom12
1239 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1244 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1245 sigsq=1.0D0-facsig*faceps1_inv
1246 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1247 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1248 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1249 C Calculate eps2 and its derivatives in om1, om2, and om12.
1252 chipom12=chip12*om12
1253 facp=1.0D0-om12*chipom12
1255 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1256 C Following variable is the square root of eps2
1257 eps2rt=1.0D0-facp1*facp_inv
1258 C Following three variables are the derivatives of the square root of eps
1259 C in om1, om2, and om12.
1260 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1261 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1262 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1263 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1264 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1265 C Calculate whole angle-dependent part of epsilon and contributions
1266 C to its derivatives
1269 C----------------------------------------------------------------------------
1271 implicit real*8 (a-h,o-z)
1272 include 'DIMENSIONS'
1273 include 'DIMENSIONS.ZSCOPT'
1274 include 'COMMON.CHAIN'
1275 include 'COMMON.DERIV'
1276 include 'COMMON.CALC'
1277 double precision dcosom1(3),dcosom2(3)
1278 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1279 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1280 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1281 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1283 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1284 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1287 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1290 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1291 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1292 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1293 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1294 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1295 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1298 C Calculate the components of the gradient in DC and X
1302 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1307 c------------------------------------------------------------------------------
1308 subroutine vec_and_deriv
1309 implicit real*8 (a-h,o-z)
1310 include 'DIMENSIONS'
1311 include 'DIMENSIONS.ZSCOPT'
1312 include 'COMMON.IOUNITS'
1313 include 'COMMON.GEO'
1314 include 'COMMON.VAR'
1315 include 'COMMON.LOCAL'
1316 include 'COMMON.CHAIN'
1317 include 'COMMON.VECTORS'
1318 include 'COMMON.DERIV'
1319 include 'COMMON.INTERACT'
1320 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1321 C Compute the local reference systems. For reference system (i), the
1322 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1323 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1325 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1326 if (i.eq.nres-1) then
1327 C Case of the last full residue
1328 C Compute the Z-axis
1329 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1330 costh=dcos(pi-theta(nres))
1331 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1336 C Compute the derivatives of uz
1338 uzder(2,1,1)=-dc_norm(3,i-1)
1339 uzder(3,1,1)= dc_norm(2,i-1)
1340 uzder(1,2,1)= dc_norm(3,i-1)
1342 uzder(3,2,1)=-dc_norm(1,i-1)
1343 uzder(1,3,1)=-dc_norm(2,i-1)
1344 uzder(2,3,1)= dc_norm(1,i-1)
1347 uzder(2,1,2)= dc_norm(3,i)
1348 uzder(3,1,2)=-dc_norm(2,i)
1349 uzder(1,2,2)=-dc_norm(3,i)
1351 uzder(3,2,2)= dc_norm(1,i)
1352 uzder(1,3,2)= dc_norm(2,i)
1353 uzder(2,3,2)=-dc_norm(1,i)
1356 C Compute the Y-axis
1359 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1362 C Compute the derivatives of uy
1365 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1366 & -dc_norm(k,i)*dc_norm(j,i-1)
1367 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1369 uyder(j,j,1)=uyder(j,j,1)-costh
1370 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1375 uygrad(l,k,j,i)=uyder(l,k,j)
1376 uzgrad(l,k,j,i)=uzder(l,k,j)
1380 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1381 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1382 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1383 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1387 C Compute the Z-axis
1388 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1389 costh=dcos(pi-theta(i+2))
1390 fac=1.0d0/dsqrt(1.0d0-costh*costh)
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)
1415 C Compute the Y-axis
1418 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1421 C Compute the derivatives of uy
1424 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1425 & -dc_norm(k,i)*dc_norm(j,i+1)
1426 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1428 uyder(j,j,1)=uyder(j,j,1)-costh
1429 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1434 uygrad(l,k,j,i)=uyder(l,k,j)
1435 uzgrad(l,k,j,i)=uzder(l,k,j)
1439 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1440 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1441 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1442 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1448 vbld_inv_temp(1)=vbld_inv(i+1)
1449 if (i.lt.nres-1) then
1450 vbld_inv_temp(2)=vbld_inv(i+2)
1452 vbld_inv_temp(2)=vbld_inv(i)
1457 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1458 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1466 C-----------------------------------------------------------------------------
1467 subroutine vec_and_deriv_test
1468 implicit real*8 (a-h,o-z)
1469 include 'DIMENSIONS'
1470 include 'DIMENSIONS.ZSCOPT'
1471 include 'COMMON.IOUNITS'
1472 include 'COMMON.GEO'
1473 include 'COMMON.VAR'
1474 include 'COMMON.LOCAL'
1475 include 'COMMON.CHAIN'
1476 include 'COMMON.VECTORS'
1477 dimension uyder(3,3,2),uzder(3,3,2)
1478 C Compute the local reference systems. For reference system (i), the
1479 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1480 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1482 if (i.eq.nres-1) then
1483 C Case of the last full residue
1484 C Compute the Z-axis
1485 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1486 costh=dcos(pi-theta(nres))
1487 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1488 c write (iout,*) 'fac',fac,
1489 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1490 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1494 C Compute the derivatives of uz
1496 uzder(2,1,1)=-dc_norm(3,i-1)
1497 uzder(3,1,1)= dc_norm(2,i-1)
1498 uzder(1,2,1)= dc_norm(3,i-1)
1500 uzder(3,2,1)=-dc_norm(1,i-1)
1501 uzder(1,3,1)=-dc_norm(2,i-1)
1502 uzder(2,3,1)= dc_norm(1,i-1)
1505 uzder(2,1,2)= dc_norm(3,i)
1506 uzder(3,1,2)=-dc_norm(2,i)
1507 uzder(1,2,2)=-dc_norm(3,i)
1509 uzder(3,2,2)= dc_norm(1,i)
1510 uzder(1,3,2)= dc_norm(2,i)
1511 uzder(2,3,2)=-dc_norm(1,i)
1513 C Compute the Y-axis
1515 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1518 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1519 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1520 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1522 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1525 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1526 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1529 c write (iout,*) 'facy',facy,
1530 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1531 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1533 uy(k,i)=facy*uy(k,i)
1535 C Compute the derivatives of uy
1538 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1539 & -dc_norm(k,i)*dc_norm(j,i-1)
1540 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1542 c uyder(j,j,1)=uyder(j,j,1)-costh
1543 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1544 uyder(j,j,1)=uyder(j,j,1)
1545 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1546 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1552 uygrad(l,k,j,i)=uyder(l,k,j)
1553 uzgrad(l,k,j,i)=uzder(l,k,j)
1557 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1558 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1559 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1560 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1563 C Compute the Z-axis
1564 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1565 costh=dcos(pi-theta(i+2))
1566 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1567 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1571 C Compute the derivatives of uz
1573 uzder(2,1,1)=-dc_norm(3,i+1)
1574 uzder(3,1,1)= dc_norm(2,i+1)
1575 uzder(1,2,1)= dc_norm(3,i+1)
1577 uzder(3,2,1)=-dc_norm(1,i+1)
1578 uzder(1,3,1)=-dc_norm(2,i+1)
1579 uzder(2,3,1)= dc_norm(1,i+1)
1582 uzder(2,1,2)= dc_norm(3,i)
1583 uzder(3,1,2)=-dc_norm(2,i)
1584 uzder(1,2,2)=-dc_norm(3,i)
1586 uzder(3,2,2)= dc_norm(1,i)
1587 uzder(1,3,2)= dc_norm(2,i)
1588 uzder(2,3,2)=-dc_norm(1,i)
1590 C Compute the Y-axis
1592 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1593 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1594 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1596 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1599 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1600 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1603 c write (iout,*) 'facy',facy,
1604 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1605 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1607 uy(k,i)=facy*uy(k,i)
1609 C Compute the derivatives of uy
1612 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1613 & -dc_norm(k,i)*dc_norm(j,i+1)
1614 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1616 c uyder(j,j,1)=uyder(j,j,1)-costh
1617 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1618 uyder(j,j,1)=uyder(j,j,1)
1619 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1620 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1626 uygrad(l,k,j,i)=uyder(l,k,j)
1627 uzgrad(l,k,j,i)=uzder(l,k,j)
1631 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1632 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1633 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1634 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1641 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1642 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1649 C-----------------------------------------------------------------------------
1650 subroutine check_vecgrad
1651 implicit real*8 (a-h,o-z)
1652 include 'DIMENSIONS'
1653 include 'DIMENSIONS.ZSCOPT'
1654 include 'COMMON.IOUNITS'
1655 include 'COMMON.GEO'
1656 include 'COMMON.VAR'
1657 include 'COMMON.LOCAL'
1658 include 'COMMON.CHAIN'
1659 include 'COMMON.VECTORS'
1660 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1661 dimension uyt(3,maxres),uzt(3,maxres)
1662 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1663 double precision delta /1.0d-7/
1666 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1667 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1668 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1669 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1670 cd & (dc_norm(if90,i),if90=1,3)
1671 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1672 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1673 cd write(iout,'(a)')
1679 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1680 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1693 cd write (iout,*) 'i=',i
1695 erij(k)=dc_norm(k,i)
1699 dc_norm(k,i)=erij(k)
1701 dc_norm(j,i)=dc_norm(j,i)+delta
1702 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1704 c dc_norm(k,i)=dc_norm(k,i)/fac
1706 c write (iout,*) (dc_norm(k,i),k=1,3)
1707 c write (iout,*) (erij(k),k=1,3)
1710 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1711 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1712 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1713 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1715 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1716 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1717 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1720 dc_norm(k,i)=erij(k)
1723 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1724 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1725 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1726 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1727 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1728 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1729 cd write (iout,'(a)')
1734 C--------------------------------------------------------------------------
1735 subroutine set_matrices
1736 implicit real*8 (a-h,o-z)
1737 include 'DIMENSIONS'
1738 include 'DIMENSIONS.ZSCOPT'
1739 include 'COMMON.IOUNITS'
1740 include 'COMMON.GEO'
1741 include 'COMMON.VAR'
1742 include 'COMMON.LOCAL'
1743 include 'COMMON.CHAIN'
1744 include 'COMMON.DERIV'
1745 include 'COMMON.INTERACT'
1746 include 'COMMON.CONTACTS'
1747 include 'COMMON.TORSION'
1748 include 'COMMON.VECTORS'
1749 include 'COMMON.FFIELD'
1750 double precision auxvec(2),auxmat(2,2)
1752 C Compute the virtual-bond-torsional-angle dependent quantities needed
1753 C to calculate the el-loc multibody terms of various order.
1756 if (i .lt. nres+1) then
1793 if (i .gt. 3 .and. i .lt. nres+1) then
1794 obrot_der(1,i-2)=-sin1
1795 obrot_der(2,i-2)= cos1
1796 Ugder(1,1,i-2)= sin1
1797 Ugder(1,2,i-2)=-cos1
1798 Ugder(2,1,i-2)=-cos1
1799 Ugder(2,2,i-2)=-sin1
1802 obrot2_der(1,i-2)=-dwasin2
1803 obrot2_der(2,i-2)= dwacos2
1804 Ug2der(1,1,i-2)= dwasin2
1805 Ug2der(1,2,i-2)=-dwacos2
1806 Ug2der(2,1,i-2)=-dwacos2
1807 Ug2der(2,2,i-2)=-dwasin2
1809 obrot_der(1,i-2)=0.0d0
1810 obrot_der(2,i-2)=0.0d0
1811 Ugder(1,1,i-2)=0.0d0
1812 Ugder(1,2,i-2)=0.0d0
1813 Ugder(2,1,i-2)=0.0d0
1814 Ugder(2,2,i-2)=0.0d0
1815 obrot2_der(1,i-2)=0.0d0
1816 obrot2_der(2,i-2)=0.0d0
1817 Ug2der(1,1,i-2)=0.0d0
1818 Ug2der(1,2,i-2)=0.0d0
1819 Ug2der(2,1,i-2)=0.0d0
1820 Ug2der(2,2,i-2)=0.0d0
1822 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1823 if (itype(i-2).le.ntyp) then
1824 iti = itortyp(itype(i-2))
1831 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1832 if (itype(i-1).le.ntyp) then
1833 iti1 = itortyp(itype(i-1))
1840 cd write (iout,*) '*******i',i,' iti1',iti
1841 cd write (iout,*) 'b1',b1(:,iti)
1842 cd write (iout,*) 'b2',b2(:,iti)
1843 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1844 c print *,"itilde1 i iti iti1",i,iti,iti1
1845 if (i .gt. iatel_s+2) then
1846 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1847 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1848 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1849 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1850 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1851 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1852 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1862 DtUg2(l,k,i-2)=0.0d0
1866 c print *,"itilde2 i iti iti1",i,iti,iti1
1867 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1868 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1869 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1870 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1871 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1872 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1873 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1874 c print *,"itilde3 i iti iti1",i,iti,iti1
1876 muder(k,i-2)=Ub2der(k,i-2)
1878 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1879 if (itype(i-1).le.ntyp) then
1880 iti1 = itortyp(itype(i-1))
1888 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1890 C Vectors and matrices dependent on a single virtual-bond dihedral.
1891 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1892 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1893 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1894 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1895 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1896 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1897 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1898 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1899 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1900 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1901 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1903 C Matrices dependent on two consecutive virtual-bond dihedrals.
1904 C The order of matrices is from left to right.
1906 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1907 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1908 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1909 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1910 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1911 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1912 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1913 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1916 cd iti = itortyp(itype(i))
1919 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1920 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1925 C--------------------------------------------------------------------------
1926 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1928 C This subroutine calculates the average interaction energy and its gradient
1929 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1930 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1931 C The potential depends both on the distance of peptide-group centers and on
1932 C the orientation of the CA-CA virtual bonds.
1934 implicit real*8 (a-h,o-z)
1935 include 'DIMENSIONS'
1936 include 'DIMENSIONS.ZSCOPT'
1937 include 'DIMENSIONS.FREE'
1938 include 'COMMON.CONTROL'
1939 include 'COMMON.IOUNITS'
1940 include 'COMMON.GEO'
1941 include 'COMMON.VAR'
1942 include 'COMMON.LOCAL'
1943 include 'COMMON.CHAIN'
1944 include 'COMMON.DERIV'
1945 include 'COMMON.INTERACT'
1946 include 'COMMON.CONTACTS'
1947 include 'COMMON.TORSION'
1948 include 'COMMON.VECTORS'
1949 include 'COMMON.FFIELD'
1950 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1951 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1952 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1953 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1954 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1955 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1956 double precision scal_el /0.5d0/
1958 C 13-go grudnia roku pamietnego...
1959 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1960 & 0.0d0,1.0d0,0.0d0,
1961 & 0.0d0,0.0d0,1.0d0/
1962 cd write(iout,*) 'In EELEC'
1964 cd write(iout,*) 'Type',i
1965 cd write(iout,*) 'B1',B1(:,i)
1966 cd write(iout,*) 'B2',B2(:,i)
1967 cd write(iout,*) 'CC',CC(:,:,i)
1968 cd write(iout,*) 'DD',DD(:,:,i)
1969 cd write(iout,*) 'EE',EE(:,:,i)
1971 cd call check_vecgrad
1973 if (icheckgrad.eq.1) then
1975 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1977 dc_norm(k,i)=dc(k,i)*fac
1979 c write (iout,*) 'i',i,' fac',fac
1982 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1983 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1984 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1985 cd if (wel_loc.gt.0.0d0) then
1986 if (icheckgrad.eq.1) then
1987 call vec_and_deriv_test
1994 cd write (iout,*) 'i=',i
1996 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1999 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2000 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2013 cd print '(a)','Enter EELEC'
2014 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2016 gel_loc_loc(i)=0.0d0
2019 do i=iatel_s,iatel_e
2020 cAna if (i.le.1) cycle
2021 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2022 cAna & .or. ((i+2).gt.nres)
2023 cAna & .or. ((i-1).le.0)
2024 cAna & .or. itype(i+2).eq.ntyp1
2025 cAna & .or. itype(i-1).eq.ntyp1
2028 if (itel(i).eq.0) goto 1215
2032 dx_normi=dc_norm(1,i)
2033 dy_normi=dc_norm(2,i)
2034 dz_normi=dc_norm(3,i)
2035 xmedi=c(1,i)+0.5d0*dxi
2036 ymedi=c(2,i)+0.5d0*dyi
2037 zmedi=c(3,i)+0.5d0*dzi
2038 xmedi=mod(xmedi,boxxsize)
2039 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2040 ymedi=mod(ymedi,boxysize)
2041 if (ymedi.lt.0) ymedi=ymedi+boxysize
2042 zmedi=mod(zmedi,boxzsize)
2043 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2045 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2046 do j=ielstart(i),ielend(i)
2047 cAna if (j.le.1) cycle
2048 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2049 cAna & .or.((j+2).gt.nres)
2050 cAna & .or.((j-1).le.0)
2051 cAna & .or.itype(j+2).eq.ntyp1
2052 cAna & .or.itype(j-1).eq.ntyp1
2054 if (itel(j).eq.0) goto 1216
2058 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2059 aaa=app(iteli,itelj)
2060 bbb=bpp(iteli,itelj)
2061 C Diagnostics only!!!
2067 ael6i=ael6(iteli,itelj)
2068 ael3i=ael3(iteli,itelj)
2072 dx_normj=dc_norm(1,j)
2073 dy_normj=dc_norm(2,j)
2074 dz_normj=dc_norm(3,j)
2079 if (xj.lt.0) xj=xj+boxxsize
2081 if (yj.lt.0) yj=yj+boxysize
2083 if (zj.lt.0) zj=zj+boxzsize
2084 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2092 xj=xj_safe+xshift*boxxsize
2093 yj=yj_safe+yshift*boxysize
2094 zj=zj_safe+zshift*boxzsize
2095 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2096 if(dist_temp.lt.dist_init) then
2106 if (isubchap.eq.1) then
2115 rij=xj*xj+yj*yj+zj*zj
2116 sss=sscale(sqrt(rij))
2117 sssgrad=sscagrad(sqrt(rij))
2123 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2124 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2125 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2126 fac=cosa-3.0D0*cosb*cosg
2128 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2129 if (j.eq.i+2) ev1=scal_el*ev1
2134 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2137 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2138 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2139 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2141 evdw1=evdw1+evdwij*sss
2142 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2143 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2144 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2145 cd & xmedi,ymedi,zmedi,xj,yj,zj
2147 C Calculate contributions to the Cartesian gradient.
2150 facvdw=-6*rrmij*(ev1+evdwij)*sss
2151 facel=-3*rrmij*(el1+eesij)
2158 * Radial derivatives. First process both termini of the fragment (i,j)
2165 gelc(k,i)=gelc(k,i)+ghalf
2166 gelc(k,j)=gelc(k,j)+ghalf
2169 * Loop over residues i+1 thru j-1.
2173 gelc(l,k)=gelc(l,k)+ggg(l)
2181 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2182 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2185 * Loop over residues i+1 thru j-1.
2189 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2196 fac=-3*rrmij*(facvdw+facvdw+facel)
2202 * Radial derivatives. First process both termini of the fragment (i,j)
2209 gelc(k,i)=gelc(k,i)+ghalf
2210 gelc(k,j)=gelc(k,j)+ghalf
2213 * Loop over residues i+1 thru j-1.
2217 gelc(l,k)=gelc(l,k)+ggg(l)
2224 ecosa=2.0D0*fac3*fac1+fac4
2227 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2228 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2230 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2231 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2233 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2234 cd & (dcosg(k),k=1,3)
2236 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2240 gelc(k,i)=gelc(k,i)+ghalf
2241 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2242 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2243 gelc(k,j)=gelc(k,j)+ghalf
2244 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2245 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2249 gelc(l,k)=gelc(l,k)+ggg(l)
2254 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2255 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2256 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2258 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2259 C energy of a peptide unit is assumed in the form of a second-order
2260 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2261 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2262 C are computed for EVERY pair of non-contiguous peptide groups.
2264 if (j.lt.nres-1) then
2275 muij(kkk)=mu(k,i)*mu(l,j)
2278 cd write (iout,*) 'EELEC: i',i,' j',j
2279 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2280 cd write(iout,*) 'muij',muij
2281 ury=scalar(uy(1,i),erij)
2282 urz=scalar(uz(1,i),erij)
2283 vry=scalar(uy(1,j),erij)
2284 vrz=scalar(uz(1,j),erij)
2285 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2286 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2287 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2288 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2289 C For diagnostics only
2294 fac=dsqrt(-ael6i)*r3ij
2295 cd write (2,*) 'fac=',fac
2296 C For diagnostics only
2302 cd write (iout,'(4i5,4f10.5)')
2303 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2304 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2305 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2306 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2307 cd write (iout,'(4f10.5)')
2308 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2309 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2310 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2311 cd write (iout,'(2i3,9f10.5/)') i,j,
2312 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2314 C Derivatives of the elements of A in virtual-bond vectors
2315 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2322 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2323 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2324 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2325 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2326 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2327 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2328 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2329 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2330 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2331 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2332 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2333 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2343 C Compute radial contributions to the gradient
2365 C Add the contributions coming from er
2368 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2369 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2370 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2371 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2374 C Derivatives in DC(i)
2375 ghalf1=0.5d0*agg(k,1)
2376 ghalf2=0.5d0*agg(k,2)
2377 ghalf3=0.5d0*agg(k,3)
2378 ghalf4=0.5d0*agg(k,4)
2379 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2380 & -3.0d0*uryg(k,2)*vry)+ghalf1
2381 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2382 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2383 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2384 & -3.0d0*urzg(k,2)*vry)+ghalf3
2385 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2386 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2387 C Derivatives in DC(i+1)
2388 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2389 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2390 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2391 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2392 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2393 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2394 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2395 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2396 C Derivatives in DC(j)
2397 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2398 & -3.0d0*vryg(k,2)*ury)+ghalf1
2399 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2400 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2401 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2402 & -3.0d0*vryg(k,2)*urz)+ghalf3
2403 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2404 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2405 C Derivatives in DC(j+1) or DC(nres-1)
2406 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2407 & -3.0d0*vryg(k,3)*ury)
2408 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2409 & -3.0d0*vrzg(k,3)*ury)
2410 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2411 & -3.0d0*vryg(k,3)*urz)
2412 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2413 & -3.0d0*vrzg(k,3)*urz)
2418 C Derivatives in DC(i+1)
2419 cd aggi1(k,1)=agg(k,1)
2420 cd aggi1(k,2)=agg(k,2)
2421 cd aggi1(k,3)=agg(k,3)
2422 cd aggi1(k,4)=agg(k,4)
2423 C Derivatives in DC(j)
2428 C Derivatives in DC(j+1)
2433 if (j.eq.nres-1 .and. i.lt.j-2) then
2435 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2436 cd aggj1(k,l)=agg(k,l)
2442 C Check the loc-el terms by numerical integration
2452 aggi(k,l)=-aggi(k,l)
2453 aggi1(k,l)=-aggi1(k,l)
2454 aggj(k,l)=-aggj(k,l)
2455 aggj1(k,l)=-aggj1(k,l)
2458 if (j.lt.nres-1) then
2464 aggi(k,l)=-aggi(k,l)
2465 aggi1(k,l)=-aggi1(k,l)
2466 aggj(k,l)=-aggj(k,l)
2467 aggj1(k,l)=-aggj1(k,l)
2478 aggi(k,l)=-aggi(k,l)
2479 aggi1(k,l)=-aggi1(k,l)
2480 aggj(k,l)=-aggj(k,l)
2481 aggj1(k,l)=-aggj1(k,l)
2487 IF (wel_loc.gt.0.0d0) THEN
2488 C Contribution to the local-electrostatic energy coming from the i-j pair
2489 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2491 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2492 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2493 eel_loc=eel_loc+eel_loc_ij
2494 C Partial derivatives in virtual-bond dihedral angles gamma
2497 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2498 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2499 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2500 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2501 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2502 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2503 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2504 cd write(iout,*) 'agg ',agg
2505 cd write(iout,*) 'aggi ',aggi
2506 cd write(iout,*) 'aggi1',aggi1
2507 cd write(iout,*) 'aggj ',aggj
2508 cd write(iout,*) 'aggj1',aggj1
2510 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2512 ggg(l)=agg(l,1)*muij(1)+
2513 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2517 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2520 C Remaining derivatives of eello
2522 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2523 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2524 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2525 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2526 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2527 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2528 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2529 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2533 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2534 C Contributions from turns
2539 call eturn34(i,j,eello_turn3,eello_turn4)
2541 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2542 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2544 C Calculate the contact function. The ith column of the array JCONT will
2545 C contain the numbers of atoms that make contacts with the atom I (of numbers
2546 C greater than I). The arrays FACONT and GACONT will contain the values of
2547 C the contact function and its derivative.
2548 c r0ij=1.02D0*rpp(iteli,itelj)
2549 c r0ij=1.11D0*rpp(iteli,itelj)
2550 r0ij=2.20D0*rpp(iteli,itelj)
2551 c r0ij=1.55D0*rpp(iteli,itelj)
2552 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2553 if (fcont.gt.0.0D0) then
2554 num_conti=num_conti+1
2555 if (num_conti.gt.maxconts) then
2556 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2557 & ' will skip next contacts for this conf.'
2559 jcont_hb(num_conti,i)=j
2560 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2561 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2562 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2564 d_cont(num_conti,i)=rij
2565 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2566 C --- Electrostatic-interaction matrix ---
2567 a_chuj(1,1,num_conti,i)=a22
2568 a_chuj(1,2,num_conti,i)=a23
2569 a_chuj(2,1,num_conti,i)=a32
2570 a_chuj(2,2,num_conti,i)=a33
2571 C --- Gradient of rij
2573 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2576 c a_chuj(1,1,num_conti,i)=-0.61d0
2577 c a_chuj(1,2,num_conti,i)= 0.4d0
2578 c a_chuj(2,1,num_conti,i)= 0.65d0
2579 c a_chuj(2,2,num_conti,i)= 0.50d0
2580 c else if (i.eq.2) then
2581 c a_chuj(1,1,num_conti,i)= 0.0d0
2582 c a_chuj(1,2,num_conti,i)= 0.0d0
2583 c a_chuj(2,1,num_conti,i)= 0.0d0
2584 c a_chuj(2,2,num_conti,i)= 0.0d0
2586 C --- and its gradients
2587 cd write (iout,*) 'i',i,' j',j
2589 cd write (iout,*) 'iii 1 kkk',kkk
2590 cd write (iout,*) agg(kkk,:)
2593 cd write (iout,*) 'iii 2 kkk',kkk
2594 cd write (iout,*) aggi(kkk,:)
2597 cd write (iout,*) 'iii 3 kkk',kkk
2598 cd write (iout,*) aggi1(kkk,:)
2601 cd write (iout,*) 'iii 4 kkk',kkk
2602 cd write (iout,*) aggj(kkk,:)
2605 cd write (iout,*) 'iii 5 kkk',kkk
2606 cd write (iout,*) aggj1(kkk,:)
2613 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2614 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2615 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2616 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2617 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2619 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2625 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2626 C Calculate contact energies
2628 wij=cosa-3.0D0*cosb*cosg
2631 c fac3=dsqrt(-ael6i)/r0ij**3
2632 fac3=dsqrt(-ael6i)*r3ij
2633 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2634 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2636 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2637 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2638 C Diagnostics. Comment out or remove after debugging!
2639 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2640 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2641 c ees0m(num_conti,i)=0.0D0
2643 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2644 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2645 facont_hb(num_conti,i)=fcont
2647 C Angular derivatives of the contact function
2648 ees0pij1=fac3/ees0pij
2649 ees0mij1=fac3/ees0mij
2650 fac3p=-3.0D0*fac3*rrmij
2651 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2652 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2654 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2655 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2656 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2657 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2658 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2659 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2660 ecosap=ecosa1+ecosa2
2661 ecosbp=ecosb1+ecosb2
2662 ecosgp=ecosg1+ecosg2
2663 ecosam=ecosa1-ecosa2
2664 ecosbm=ecosb1-ecosb2
2665 ecosgm=ecosg1-ecosg2
2674 fprimcont=fprimcont/rij
2675 cd facont_hb(num_conti,i)=1.0D0
2676 C Following line is for diagnostics.
2679 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2680 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2683 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2684 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2686 gggp(1)=gggp(1)+ees0pijp*xj
2687 gggp(2)=gggp(2)+ees0pijp*yj
2688 gggp(3)=gggp(3)+ees0pijp*zj
2689 gggm(1)=gggm(1)+ees0mijp*xj
2690 gggm(2)=gggm(2)+ees0mijp*yj
2691 gggm(3)=gggm(3)+ees0mijp*zj
2692 C Derivatives due to the contact function
2693 gacont_hbr(1,num_conti,i)=fprimcont*xj
2694 gacont_hbr(2,num_conti,i)=fprimcont*yj
2695 gacont_hbr(3,num_conti,i)=fprimcont*zj
2697 ghalfp=0.5D0*gggp(k)
2698 ghalfm=0.5D0*gggm(k)
2699 gacontp_hb1(k,num_conti,i)=ghalfp
2700 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2701 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2702 gacontp_hb2(k,num_conti,i)=ghalfp
2703 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2704 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2705 gacontp_hb3(k,num_conti,i)=gggp(k)
2706 gacontm_hb1(k,num_conti,i)=ghalfm
2707 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2708 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2709 gacontm_hb2(k,num_conti,i)=ghalfm
2710 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2711 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2712 gacontm_hb3(k,num_conti,i)=gggm(k)
2715 C Diagnostics. Comment out or remove after debugging!
2717 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2718 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2719 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2720 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2721 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2722 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2725 endif ! num_conti.le.maxconts
2730 num_cont_hb(i)=num_conti
2734 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2735 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2737 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2738 ccc eel_loc=eel_loc+eello_turn3
2741 C-----------------------------------------------------------------------------
2742 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2743 C Third- and fourth-order contributions from turns
2744 implicit real*8 (a-h,o-z)
2745 include 'DIMENSIONS'
2746 include 'DIMENSIONS.ZSCOPT'
2747 include 'COMMON.IOUNITS'
2748 include 'COMMON.GEO'
2749 include 'COMMON.VAR'
2750 include 'COMMON.LOCAL'
2751 include 'COMMON.CHAIN'
2752 include 'COMMON.DERIV'
2753 include 'COMMON.INTERACT'
2754 include 'COMMON.CONTACTS'
2755 include 'COMMON.TORSION'
2756 include 'COMMON.VECTORS'
2757 include 'COMMON.FFIELD'
2759 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2760 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2761 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2762 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2763 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2764 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2766 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2767 C changes suggested by Ana to avoid out of bounds
2768 C & .or.((i+5).gt.nres)
2769 C & .or.((i-1).le.0)
2770 C end of changes suggested by Ana
2771 & .or. itype(i+2).eq.ntyp1
2772 & .or. itype(i+3).eq.ntyp1
2773 C & .or. itype(i+5).eq.ntyp1
2774 C & .or. itype(i).eq.ntyp1
2775 C & .or. itype(i-1).eq.ntyp1
2778 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2780 C Third-order contributions
2787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2788 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2789 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2790 call transpose2(auxmat(1,1),auxmat1(1,1))
2791 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2792 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2793 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2794 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2795 cd & ' eello_turn3_num',4*eello_turn3_num
2797 C Derivatives in gamma(i)
2798 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2799 call transpose2(auxmat2(1,1),pizda(1,1))
2800 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2801 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2802 C Derivatives in gamma(i+1)
2803 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2804 call transpose2(auxmat2(1,1),pizda(1,1))
2805 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2806 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2807 & +0.5d0*(pizda(1,1)+pizda(2,2))
2808 C Cartesian derivatives
2810 a_temp(1,1)=aggi(l,1)
2811 a_temp(1,2)=aggi(l,2)
2812 a_temp(2,1)=aggi(l,3)
2813 a_temp(2,2)=aggi(l,4)
2814 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2815 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2816 & +0.5d0*(pizda(1,1)+pizda(2,2))
2817 a_temp(1,1)=aggi1(l,1)
2818 a_temp(1,2)=aggi1(l,2)
2819 a_temp(2,1)=aggi1(l,3)
2820 a_temp(2,2)=aggi1(l,4)
2821 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2822 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2823 & +0.5d0*(pizda(1,1)+pizda(2,2))
2824 a_temp(1,1)=aggj(l,1)
2825 a_temp(1,2)=aggj(l,2)
2826 a_temp(2,1)=aggj(l,3)
2827 a_temp(2,2)=aggj(l,4)
2828 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2829 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2830 & +0.5d0*(pizda(1,1)+pizda(2,2))
2831 a_temp(1,1)=aggj1(l,1)
2832 a_temp(1,2)=aggj1(l,2)
2833 a_temp(2,1)=aggj1(l,3)
2834 a_temp(2,2)=aggj1(l,4)
2835 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2836 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2837 & +0.5d0*(pizda(1,1)+pizda(2,2))
2841 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2842 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2843 C changes suggested by Ana to avoid out of bounds
2844 C & .or.((i+5).gt.nres)
2845 C & .or.((i-1).le.0)
2846 C end of changes suggested by Ana
2847 & .or. itype(i+3).eq.ntyp1
2848 & .or. itype(i+4).eq.ntyp1
2849 C & .or. itype(i+5).eq.ntyp1
2850 & .or. itype(i).eq.ntyp1
2851 C & .or. itype(i-1).eq.ntyp1
2853 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2855 C Fourth-order contributions
2863 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2864 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2865 iti1=itortyp(itype(i+1))
2866 iti2=itortyp(itype(i+2))
2867 iti3=itortyp(itype(i+3))
2868 call transpose2(EUg(1,1,i+1),e1t(1,1))
2869 call transpose2(Eug(1,1,i+2),e2t(1,1))
2870 call transpose2(Eug(1,1,i+3),e3t(1,1))
2871 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2872 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2873 s1=scalar2(b1(1,iti2),auxvec(1))
2874 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2875 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2876 s2=scalar2(b1(1,iti1),auxvec(1))
2877 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2878 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2879 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2880 eello_turn4=eello_turn4-(s1+s2+s3)
2881 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2882 cd & ' eello_turn4_num',8*eello_turn4_num
2883 C Derivatives in gamma(i)
2885 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2886 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2887 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2888 s1=scalar2(b1(1,iti2),auxvec(1))
2889 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2890 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2891 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2892 C Derivatives in gamma(i+1)
2893 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2894 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2895 s2=scalar2(b1(1,iti1),auxvec(1))
2896 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2897 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2898 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2899 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2900 C Derivatives in gamma(i+2)
2901 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2902 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2903 s1=scalar2(b1(1,iti2),auxvec(1))
2904 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2905 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2906 s2=scalar2(b1(1,iti1),auxvec(1))
2907 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2908 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2910 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2911 C Cartesian derivatives
2912 C Derivatives of this turn contributions in DC(i+2)
2913 if (j.lt.nres-1) then
2915 a_temp(1,1)=agg(l,1)
2916 a_temp(1,2)=agg(l,2)
2917 a_temp(2,1)=agg(l,3)
2918 a_temp(2,2)=agg(l,4)
2919 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2920 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2921 s1=scalar2(b1(1,iti2),auxvec(1))
2922 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2923 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2924 s2=scalar2(b1(1,iti1),auxvec(1))
2925 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2926 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2927 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2929 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2932 C Remaining derivatives of this turn contribution
2934 a_temp(1,1)=aggi(l,1)
2935 a_temp(1,2)=aggi(l,2)
2936 a_temp(2,1)=aggi(l,3)
2937 a_temp(2,2)=aggi(l,4)
2938 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2939 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2940 s1=scalar2(b1(1,iti2),auxvec(1))
2941 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2942 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2943 s2=scalar2(b1(1,iti1),auxvec(1))
2944 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2945 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2946 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2947 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2948 a_temp(1,1)=aggi1(l,1)
2949 a_temp(1,2)=aggi1(l,2)
2950 a_temp(2,1)=aggi1(l,3)
2951 a_temp(2,2)=aggi1(l,4)
2952 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2953 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2954 s1=scalar2(b1(1,iti2),auxvec(1))
2955 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2956 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2957 s2=scalar2(b1(1,iti1),auxvec(1))
2958 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2959 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2960 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2961 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2962 a_temp(1,1)=aggj(l,1)
2963 a_temp(1,2)=aggj(l,2)
2964 a_temp(2,1)=aggj(l,3)
2965 a_temp(2,2)=aggj(l,4)
2966 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2967 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2968 s1=scalar2(b1(1,iti2),auxvec(1))
2969 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2970 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2971 s2=scalar2(b1(1,iti1),auxvec(1))
2972 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2973 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2974 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2975 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2976 a_temp(1,1)=aggj1(l,1)
2977 a_temp(1,2)=aggj1(l,2)
2978 a_temp(2,1)=aggj1(l,3)
2979 a_temp(2,2)=aggj1(l,4)
2980 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2981 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2982 s1=scalar2(b1(1,iti2),auxvec(1))
2983 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2984 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2985 s2=scalar2(b1(1,iti1),auxvec(1))
2986 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2987 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2988 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2989 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2996 C-----------------------------------------------------------------------------
2997 subroutine vecpr(u,v,w)
2998 implicit real*8(a-h,o-z)
2999 dimension u(3),v(3),w(3)
3000 w(1)=u(2)*v(3)-u(3)*v(2)
3001 w(2)=-u(1)*v(3)+u(3)*v(1)
3002 w(3)=u(1)*v(2)-u(2)*v(1)
3005 C-----------------------------------------------------------------------------
3006 subroutine unormderiv(u,ugrad,unorm,ungrad)
3007 C This subroutine computes the derivatives of a normalized vector u, given
3008 C the derivatives computed without normalization conditions, ugrad. Returns
3011 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3012 double precision vec(3)
3013 double precision scalar
3015 c write (2,*) 'ugrad',ugrad
3018 vec(i)=scalar(ugrad(1,i),u(1))
3020 c write (2,*) 'vec',vec
3023 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3026 c write (2,*) 'ungrad',ungrad
3029 C-----------------------------------------------------------------------------
3030 subroutine escp(evdw2,evdw2_14)
3032 C This subroutine calculates the excluded-volume interaction energy between
3033 C peptide-group centers and side chains and its gradient in virtual-bond and
3034 C side-chain vectors.
3036 implicit real*8 (a-h,o-z)
3037 include 'DIMENSIONS'
3038 include 'DIMENSIONS.ZSCOPT'
3039 include 'COMMON.GEO'
3040 include 'COMMON.VAR'
3041 include 'COMMON.LOCAL'
3042 include 'COMMON.CHAIN'
3043 include 'COMMON.DERIV'
3044 include 'COMMON.INTERACT'
3045 include 'COMMON.FFIELD'
3046 include 'COMMON.IOUNITS'
3050 cd print '(a)','Enter ESCP'
3051 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3052 c & ' scal14',scal14
3053 do i=iatscp_s,iatscp_e
3054 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3056 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3057 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3058 if (iteli.eq.0) goto 1225
3059 xi=0.5D0*(c(1,i)+c(1,i+1))
3060 yi=0.5D0*(c(2,i)+c(2,i+1))
3061 zi=0.5D0*(c(3,i)+c(3,i+1))
3062 C Returning the ith atom to box
3064 if (xi.lt.0) xi=xi+boxxsize
3066 if (yi.lt.0) yi=yi+boxysize
3068 if (zi.lt.0) zi=zi+boxzsize
3069 do iint=1,nscp_gr(i)
3071 do j=iscpstart(i,iint),iscpend(i,iint)
3072 itypj=iabs(itype(j))
3073 if (itypj.eq.ntyp1) cycle
3074 C Uncomment following three lines for SC-p interactions
3078 C Uncomment following three lines for Ca-p interactions
3082 C returning the jth atom to box
3084 if (xj.lt.0) xj=xj+boxxsize
3086 if (yj.lt.0) yj=yj+boxysize
3088 if (zj.lt.0) zj=zj+boxzsize
3089 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3094 C Finding the closest jth atom
3098 xj=xj_safe+xshift*boxxsize
3099 yj=yj_safe+yshift*boxysize
3100 zj=zj_safe+zshift*boxzsize
3101 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3102 if(dist_temp.lt.dist_init) then
3112 if (subchap.eq.1) then
3121 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3122 C sss is scaling function for smoothing the cutoff gradient otherwise
3123 C the gradient would not be continuouse
3124 sss=sscale(1.0d0/(dsqrt(rrij)))
3125 if (sss.le.0.0d0) cycle
3126 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3128 e1=fac*fac*aad(itypj,iteli)
3129 e2=fac*bad(itypj,iteli)
3130 if (iabs(j-i) .le. 2) then
3133 evdw2_14=evdw2_14+(e1+e2)*sss
3136 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3137 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3138 c & bad(itypj,iteli)
3139 evdw2=evdw2+evdwij*sss
3142 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3144 fac=-(evdwij+e1)*rrij*sss
3145 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3150 cd write (iout,*) 'j<i'
3151 C Uncomment following three lines for SC-p interactions
3153 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3156 cd write (iout,*) 'j>i'
3159 C Uncomment following line for SC-p interactions
3160 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3164 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3168 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3169 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3172 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3182 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3183 gradx_scp(j,i)=expon*gradx_scp(j,i)
3186 C******************************************************************************
3190 C To save time the factor EXPON has been extracted from ALL components
3191 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3194 C******************************************************************************
3197 C--------------------------------------------------------------------------
3198 subroutine edis(ehpb)
3200 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3202 implicit real*8 (a-h,o-z)
3203 include 'DIMENSIONS'
3204 include 'DIMENSIONS.ZSCOPT'
3205 include 'DIMENSIONS.FREE'
3206 include 'COMMON.SBRIDGE'
3207 include 'COMMON.CHAIN'
3208 include 'COMMON.DERIV'
3209 include 'COMMON.VAR'
3210 include 'COMMON.INTERACT'
3211 include 'COMMON.CONTROL'
3212 include 'COMMON.IOUNITS'
3215 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3216 cd print *,'link_start=',link_start,' link_end=',link_end
3217 C write(iout,*) link_end, "link_end"
3218 if (link_end.eq.0) return
3219 do i=link_start,link_end
3220 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3221 C CA-CA distance used in regularization of structure.
3224 C iii and jjj point to the residues for which the distance is assigned.
3225 if (ii.gt.nres) then
3232 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3233 C distance and angle dependent SS bond potential.
3234 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3235 C & iabs(itype(jjj)).eq.1) then
3236 C write(iout,*) constr_dist,"const"
3237 if (.not.dyn_ss .and. i.le.nss) then
3238 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3239 & iabs(itype(jjj)).eq.1) then
3240 call ssbond_ene(iii,jjj,eij)
3243 else if (ii.gt.nres .and. jj.gt.nres) then
3244 c Restraints from contact prediction
3246 if (constr_dist.eq.11) then
3247 C ehpb=ehpb+fordepth(i)**4.0d0
3248 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3249 ehpb=ehpb+fordepth(i)**4.0d0
3250 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3251 fac=fordepth(i)**4.0d0
3252 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3253 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3254 C & ehpb,fordepth(i),dd
3255 C write(iout,*) ehpb,"atu?"
3257 C fac=fordepth(i)**4.0d0
3258 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3260 if (dhpb1(i).gt.0.0d0) then
3261 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3262 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3263 c write (iout,*) "beta nmr",
3264 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3268 C Get the force constant corresponding to this distance.
3270 C Calculate the contribution to energy.
3271 ehpb=ehpb+waga*rdis*rdis
3272 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3274 C Evaluate gradient.
3277 endif !end dhpb1(i).gt.0
3278 endif !end const_dist=11
3280 ggg(j)=fac*(c(j,jj)-c(j,ii))
3283 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3284 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3287 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3288 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3291 C write(iout,*) "before"
3293 C write(iout,*) "after",dd
3294 if (constr_dist.eq.11) then
3295 ehpb=ehpb+fordepth(i)**4.0d0
3296 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3297 fac=fordepth(i)**4.0d0
3298 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3299 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3300 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3301 C print *,ehpb,"tu?"
3302 C write(iout,*) ehpb,"btu?",
3303 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3304 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3305 C & ehpb,fordepth(i),dd
3307 if (dhpb1(i).gt.0.0d0) then
3308 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3309 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3310 c write (iout,*) "alph nmr",
3311 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3314 C Get the force constant corresponding to this distance.
3316 C Calculate the contribution to energy.
3317 ehpb=ehpb+waga*rdis*rdis
3318 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3320 C Evaluate gradient.
3327 ggg(j)=fac*(c(j,jj)-c(j,ii))
3329 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3330 C If this is a SC-SC distance, we need to calculate the contributions to the
3331 C Cartesian gradient in the SC vectors (ghpbx).
3334 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3335 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3340 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3345 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3348 C--------------------------------------------------------------------------
3349 subroutine ssbond_ene(i,j,eij)
3351 C Calculate the distance and angle dependent SS-bond potential energy
3352 C using a free-energy function derived based on RHF/6-31G** ab initio
3353 C calculations of diethyl disulfide.
3355 C A. Liwo and U. Kozlowska, 11/24/03
3357 implicit real*8 (a-h,o-z)
3358 include 'DIMENSIONS'
3359 include 'DIMENSIONS.ZSCOPT'
3360 include 'COMMON.SBRIDGE'
3361 include 'COMMON.CHAIN'
3362 include 'COMMON.DERIV'
3363 include 'COMMON.LOCAL'
3364 include 'COMMON.INTERACT'
3365 include 'COMMON.VAR'
3366 include 'COMMON.IOUNITS'
3367 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3368 itypi=iabs(itype(i))
3372 dxi=dc_norm(1,nres+i)
3373 dyi=dc_norm(2,nres+i)
3374 dzi=dc_norm(3,nres+i)
3375 dsci_inv=dsc_inv(itypi)
3376 itypj=iabs(itype(j))
3377 dscj_inv=dsc_inv(itypj)
3381 dxj=dc_norm(1,nres+j)
3382 dyj=dc_norm(2,nres+j)
3383 dzj=dc_norm(3,nres+j)
3384 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3389 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3390 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3391 om12=dxi*dxj+dyi*dyj+dzi*dzj
3393 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3394 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3400 deltat12=om2-om1+2.0d0
3402 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3403 & +akct*deltad*deltat12
3404 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3405 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3406 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3407 c & " deltat12",deltat12," eij",eij
3408 ed=2*akcm*deltad+akct*deltat12
3410 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3411 eom1=-2*akth*deltat1-pom1-om2*pom2
3412 eom2= 2*akth*deltat2+pom1-om1*pom2
3415 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3418 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3419 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3420 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3421 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3424 C Calculate the components of the gradient in DC and X
3428 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3433 C--------------------------------------------------------------------------
3434 c MODELLER restraint function
3435 subroutine e_modeller(ehomology_constr)
3436 implicit real*8 (a-h,o-z)
3437 include 'DIMENSIONS'
3438 include 'DIMENSIONS.ZSCOPT'
3439 include 'DIMENSIONS.FREE'
3440 integer nnn, i, j, k, ki, irec, l
3441 integer katy, odleglosci, test7
3442 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3443 real*8 distance(max_template),distancek(max_template),
3444 & min_odl,godl(max_template),dih_diff(max_template)
3447 c FP - 30/10/2014 Temporary specifications for homology restraints
3449 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3451 double precision, dimension (maxres) :: guscdiff,usc_diff
3452 double precision, dimension (max_template) ::
3453 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3456 include 'COMMON.SBRIDGE'
3457 include 'COMMON.CHAIN'
3458 include 'COMMON.GEO'
3459 include 'COMMON.DERIV'
3460 include 'COMMON.LOCAL'
3461 include 'COMMON.INTERACT'
3462 include 'COMMON.VAR'
3463 include 'COMMON.IOUNITS'
3464 include 'COMMON.CONTROL'
3465 include 'COMMON.HOMRESTR'
3467 include 'COMMON.SETUP'
3468 include 'COMMON.NAMES'
3471 distancek(i)=9999999.9
3476 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3478 C AL 5/2/14 - Introduce list of restraints
3479 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3481 write(iout,*) "------- dist restrs start -------"
3483 do ii = link_start_homo,link_end_homo
3487 c write (iout,*) "dij(",i,j,") =",dij
3488 do k=1,constr_homology
3489 if(.not.l_homo(k,ii)) cycle
3490 distance(k)=odl(k,ii)-dij
3491 c write (iout,*) "distance(",k,") =",distance(k)
3493 c For Gaussian-type Urestr
3495 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3496 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3497 c write (iout,*) "distancek(",k,") =",distancek(k)
3498 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3500 c For Lorentzian-type Urestr
3502 if (waga_dist.lt.0.0d0) then
3503 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3504 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3505 & (distance(k)**2+sigma_odlir(k,ii)**2))
3509 c min_odl=minval(distancek)
3510 do kk=1,constr_homology
3511 if(l_homo(kk,ii)) then
3512 min_odl=distancek(kk)
3516 do kk=1,constr_homology
3517 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3518 & min_odl=distancek(kk)
3520 c write (iout,* )"min_odl",min_odl
3522 write (iout,*) "ij dij",i,j,dij
3523 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3524 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3525 write (iout,* )"min_odl",min_odl
3528 do k=1,constr_homology
3529 c Nie wiem po co to liczycie jeszcze raz!
3530 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3531 c & (2*(sigma_odl(i,j,k))**2))
3532 if(.not.l_homo(k,ii)) cycle
3533 if (waga_dist.ge.0.0d0) then
3535 c For Gaussian-type Urestr
3537 godl(k)=dexp(-distancek(k)+min_odl)
3538 odleg2=odleg2+godl(k)
3540 c For Lorentzian-type Urestr
3543 odleg2=odleg2+distancek(k)
3546 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3547 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3548 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3549 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3552 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3553 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3555 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3556 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3558 if (waga_dist.ge.0.0d0) then
3560 c For Gaussian-type Urestr
3562 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3564 c For Lorentzian-type Urestr
3567 odleg=odleg+odleg2/constr_homology
3571 c write (iout,*) "odleg",odleg ! sum of -ln-s
3574 c For Gaussian-type Urestr
3576 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3578 do k=1,constr_homology
3579 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3580 c & *waga_dist)+min_odl
3581 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3583 if(.not.l_homo(k,ii)) cycle
3584 if (waga_dist.ge.0.0d0) then
3585 c For Gaussian-type Urestr
3587 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3589 c For Lorentzian-type Urestr
3592 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3593 & sigma_odlir(k,ii)**2)**2)
3595 sum_sgodl=sum_sgodl+sgodl
3597 c sgodl2=sgodl2+sgodl
3598 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3599 c write(iout,*) "constr_homology=",constr_homology
3600 c write(iout,*) i, j, k, "TEST K"
3602 if (waga_dist.ge.0.0d0) then
3604 c For Gaussian-type Urestr
3606 grad_odl3=waga_homology(iset)*waga_dist
3607 & *sum_sgodl/(sum_godl*dij)
3609 c For Lorentzian-type Urestr
3612 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3613 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3614 grad_odl3=-waga_homology(iset)*waga_dist*
3615 & sum_sgodl/(constr_homology*dij)
3618 c grad_odl3=sum_sgodl/(sum_godl*dij)
3621 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3622 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3623 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3625 ccc write(iout,*) godl, sgodl, grad_odl3
3627 c grad_odl=grad_odl+grad_odl3
3630 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3631 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3632 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3633 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3634 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3635 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3636 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3637 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3638 c if (i.eq.25.and.j.eq.27) then
3639 c write(iout,*) "jik",jik,"i",i,"j",j
3640 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3641 c write(iout,*) "grad_odl3",grad_odl3
3642 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3643 c write(iout,*) "ggodl",ggodl
3644 c write(iout,*) "ghpbc(",jik,i,")",
3645 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3650 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3651 ccc & dLOG(odleg2),"-odleg=", -odleg
3653 enddo ! ii-loop for dist
3655 write(iout,*) "------- dist restrs end -------"
3656 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3657 c & waga_d.eq.1.0d0) call sum_gradient
3659 c Pseudo-energy and gradient from dihedral-angle restraints from
3660 c homology templates
3661 c write (iout,*) "End of distance loop"
3664 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3666 write(iout,*) "------- dih restrs start -------"
3667 do i=idihconstr_start_homo,idihconstr_end_homo
3668 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3671 do i=idihconstr_start_homo,idihconstr_end_homo
3673 c betai=beta(i,i+1,i+2,i+3)
3675 c write (iout,*) "betai =",betai
3676 do k=1,constr_homology
3677 dih_diff(k)=pinorm(dih(k,i)-betai)
3678 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3679 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3680 c & -(6.28318-dih_diff(i,k))
3681 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3682 c & 6.28318+dih_diff(i,k)
3684 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3685 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3688 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3691 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3692 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3694 write (iout,*) "i",i," betai",betai," kat2",kat2
3695 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3697 if (kat2.le.1.0d-14) cycle
3698 kat=kat-dLOG(kat2/constr_homology)
3699 c write (iout,*) "kat",kat ! sum of -ln-s
3701 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3702 ccc & dLOG(kat2), "-kat=", -kat
3705 c ----------------------------------------------------------------------
3707 c ----------------------------------------------------------------------
3711 do k=1,constr_homology
3712 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3713 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3714 sum_sgdih=sum_sgdih+sgdih
3716 c grad_dih3=sum_sgdih/sum_gdih
3717 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3719 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3720 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3721 ccc & gloc(nphi+i-3,icg)
3722 gloc(i,icg)=gloc(i,icg)+grad_dih3
3724 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3726 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3727 ccc & gloc(nphi+i-3,icg)
3729 enddo ! i-loop for dih
3731 write(iout,*) "------- dih restrs end -------"
3734 c Pseudo-energy and gradient for theta angle restraints from
3735 c homology templates
3736 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3740 c For constr_homology reference structures (FP)
3742 c Uconst_back_tot=0.0d0
3745 c Econstr_back legacy
3748 c do i=ithet_start,ithet_end
3751 c do i=loc_start,loc_end
3754 duscdiffx(j,i)=0.0d0
3760 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3761 c write (iout,*) "waga_theta",waga_theta
3762 if (waga_theta.gt.0.0d0) then
3764 write (iout,*) "usampl",usampl
3765 write(iout,*) "------- theta restrs start -------"
3766 c do i=ithet_start,ithet_end
3767 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3770 c write (iout,*) "maxres",maxres,"nres",nres
3772 do i=ithet_start,ithet_end
3775 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3777 c Deviation of theta angles wrt constr_homology ref structures
3779 utheta_i=0.0d0 ! argument of Gaussian for single k
3780 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3781 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3782 c over residues in a fragment
3783 c write (iout,*) "theta(",i,")=",theta(i)
3784 do k=1,constr_homology
3786 c dtheta_i=theta(j)-thetaref(j,iref)
3787 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3788 theta_diff(k)=thetatpl(k,i)-theta(i)
3790 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3791 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3792 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3793 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3794 c Gradient for single Gaussian restraint in subr Econstr_back
3795 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3798 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3799 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3803 c Gradient for multiple Gaussian restraint
3804 sum_gtheta=gutheta_i
3806 do k=1,constr_homology
3807 c New generalized expr for multiple Gaussian from Econstr_back
3808 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3810 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3811 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3814 c Final value of gradient using same var as in Econstr_back
3815 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3816 & *waga_homology(iset)
3817 c dutheta(i)=sum_sgtheta/sum_gtheta
3819 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3821 Eval=Eval-dLOG(gutheta_i/constr_homology)
3822 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3823 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3824 c Uconst_back=Uconst_back+utheta(i)
3825 enddo ! (i-loop for theta)
3827 write(iout,*) "------- theta restrs end -------"
3831 c Deviation of local SC geometry
3833 c Separation of two i-loops (instructed by AL - 11/3/2014)
3835 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3836 c write (iout,*) "waga_d",waga_d
3839 write(iout,*) "------- SC restrs start -------"
3840 write (iout,*) "Initial duscdiff,duscdiffx"
3841 do i=loc_start,loc_end
3842 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3843 & (duscdiffx(jik,i),jik=1,3)
3846 do i=loc_start,loc_end
3847 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3848 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3849 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3850 c write(iout,*) "xxtab, yytab, zztab"
3851 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3852 do k=1,constr_homology
3854 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3855 c Original sign inverted for calc of gradients (s. Econstr_back)
3856 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3857 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3858 c write(iout,*) "dxx, dyy, dzz"
3859 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3861 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3862 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3863 c uscdiffk(k)=usc_diff(i)
3864 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3865 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3866 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3867 c & xxref(j),yyref(j),zzref(j)
3872 c Generalized expression for multiple Gaussian acc to that for a single
3873 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3875 c Original implementation
3876 c sum_guscdiff=guscdiff(i)
3878 c sum_sguscdiff=0.0d0
3879 c do k=1,constr_homology
3880 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3881 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3882 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3885 c Implementation of new expressions for gradient (Jan. 2015)
3887 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3889 do k=1,constr_homology
3891 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3892 c before. Now the drivatives should be correct
3894 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3895 c Original sign inverted for calc of gradients (s. Econstr_back)
3896 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3897 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3899 c New implementation
3901 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3902 & sigma_d(k,i) ! for the grad wrt r'
3903 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3906 c New implementation
3907 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3909 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3910 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3911 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3912 duscdiff(jik,i)=duscdiff(jik,i)+
3913 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3914 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3915 duscdiffx(jik,i)=duscdiffx(jik,i)+
3916 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3917 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3920 write(iout,*) "jik",jik,"i",i
3921 write(iout,*) "dxx, dyy, dzz"
3922 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3923 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3924 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3925 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3926 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3927 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3928 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3929 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3930 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3931 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3932 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3933 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3934 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3935 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3936 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3943 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3944 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3946 c write (iout,*) i," uscdiff",uscdiff(i)
3948 c Put together deviations from local geometry
3950 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3951 c & wfrag_back(3,i,iset)*uscdiff(i)
3952 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3953 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3954 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3955 c Uconst_back=Uconst_back+usc_diff(i)
3957 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3959 c New implment: multiplied by sum_sguscdiff
3962 enddo ! (i-loop for dscdiff)
3967 write(iout,*) "------- SC restrs end -------"
3968 write (iout,*) "------ After SC loop in e_modeller ------"
3969 do i=loc_start,loc_end
3970 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3971 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3973 if (waga_theta.eq.1.0d0) then
3974 write (iout,*) "in e_modeller after SC restr end: dutheta"
3975 do i=ithet_start,ithet_end
3976 write (iout,*) i,dutheta(i)
3979 if (waga_d.eq.1.0d0) then
3980 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3982 write (iout,*) i,(duscdiff(j,i),j=1,3)
3983 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3988 c Total energy from homology restraints
3990 write (iout,*) "odleg",odleg," kat",kat
3991 write (iout,*) "odleg",odleg," kat",kat
3992 write (iout,*) "Eval",Eval," Erot",Erot
3993 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3994 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3995 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3998 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4000 c ehomology_constr=odleg+kat
4002 c For Lorentzian-type Urestr
4005 if (waga_dist.ge.0.0d0) then
4007 c For Gaussian-type Urestr
4009 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4010 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4011 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4012 & waga_theta*Eval+waga_d*Erot
4013 c write (iout,*) "ehomology_constr=",ehomology_constr
4016 c For Lorentzian-type Urestr
4018 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4019 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4020 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4021 & waga_theta*Eval+waga_d*Erot
4022 c write (iout,*) "ehomology_constr=",ehomology_constr
4025 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4026 & "Eval",waga_theta,eval,
4027 & "Erot",waga_d,Erot
4028 write (iout,*) "ehomology_constr",ehomology_constr
4032 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4033 747 format(a12,i4,i4,i4,f8.3,f8.3)
4034 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4035 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4036 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4037 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4039 c-----------------------------------------------------------------------
4040 subroutine ebond(estr)
4042 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4044 implicit real*8 (a-h,o-z)
4045 include 'DIMENSIONS'
4046 include 'DIMENSIONS.ZSCOPT'
4047 include 'DIMENSIONS.FREE'
4048 include 'COMMON.LOCAL'
4049 include 'COMMON.GEO'
4050 include 'COMMON.INTERACT'
4051 include 'COMMON.DERIV'
4052 include 'COMMON.VAR'
4053 include 'COMMON.CHAIN'
4054 include 'COMMON.IOUNITS'
4055 include 'COMMON.NAMES'
4056 include 'COMMON.FFIELD'
4057 include 'COMMON.CONTROL'
4058 logical energy_dec /.false./
4059 double precision u(3),ud(3)
4061 C write (iout,*) "distchainmax",distchainmax
4063 c write (iout,*) "distchainmax",distchainmax
4065 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4066 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4068 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4069 C & *dc(j,i-1)/vbld(i)
4071 C if (energy_dec) write(iout,*)
4072 C & "estr1",i,vbld(i),distchainmax,
4073 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4075 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4076 diff = vbld(i)-vbldpDUM
4077 C write(iout,*) i,diff
4079 diff = vbld(i)-vbldp0
4080 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4084 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4087 C write (iout,'(a7,i5,4f7.3)')
4088 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4090 estr=0.5d0*AKP*estr+estr1
4092 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4096 if (iti.ne.10 .and. iti.ne.ntyp1) then
4099 diff=vbld(i+nres)-vbldsc0(1,iti)
4100 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4101 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4102 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4104 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4108 diff=vbld(i+nres)-vbldsc0(j,iti)
4109 ud(j)=aksc(j,iti)*diff
4110 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4124 uprod2=uprod2*u(k)*u(k)
4128 usumsqder=usumsqder+ud(j)*uprod2
4130 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4131 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4132 estr=estr+uprod/usum
4134 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4142 C--------------------------------------------------------------------------
4143 subroutine ebend(etheta)
4145 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4146 C angles gamma and its derivatives in consecutive thetas and gammas.
4148 implicit real*8 (a-h,o-z)
4149 include 'DIMENSIONS'
4150 include 'DIMENSIONS.ZSCOPT'
4151 include 'COMMON.LOCAL'
4152 include 'COMMON.GEO'
4153 include 'COMMON.INTERACT'
4154 include 'COMMON.DERIV'
4155 include 'COMMON.VAR'
4156 include 'COMMON.CHAIN'
4157 include 'COMMON.IOUNITS'
4158 include 'COMMON.NAMES'
4159 include 'COMMON.FFIELD'
4160 common /calcthet/ term1,term2,termm,diffak,ratak,
4161 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4162 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4163 double precision y(2),z(2)
4165 time11=dexp(-2*time)
4168 c write (iout,*) "nres",nres
4169 c write (*,'(a,i2)') 'EBEND ICG=',icg
4170 c write (iout,*) ithet_start,ithet_end
4171 do i=ithet_start,ithet_end
4172 C if (itype(i-1).eq.ntyp1) cycle
4174 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4175 & .or.itype(i).eq.ntyp1) cycle
4176 C Zero the energy function and its derivative at 0 or pi.
4177 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4179 ichir1=isign(1,itype(i-2))
4180 ichir2=isign(1,itype(i))
4181 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4182 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4183 if (itype(i-1).eq.10) then
4184 itype1=isign(10,itype(i-2))
4185 ichir11=isign(1,itype(i-2))
4186 ichir12=isign(1,itype(i-2))
4187 itype2=isign(10,itype(i))
4188 ichir21=isign(1,itype(i))
4189 ichir22=isign(1,itype(i))
4196 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4200 c call proc_proc(phii,icrc)
4201 if (icrc.eq.1) phii=150.0
4212 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4216 c call proc_proc(phii1,icrc)
4217 if (icrc.eq.1) phii1=150.0
4229 C Calculate the "mean" value of theta from the part of the distribution
4230 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4231 C In following comments this theta will be referred to as t_c.
4232 thet_pred_mean=0.0d0
4234 athetk=athet(k,it,ichir1,ichir2)
4235 bthetk=bthet(k,it,ichir1,ichir2)
4237 athetk=athet(k,itype1,ichir11,ichir12)
4238 bthetk=bthet(k,itype2,ichir21,ichir22)
4240 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4242 c write (iout,*) "thet_pred_mean",thet_pred_mean
4243 dthett=thet_pred_mean*ssd
4244 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4245 c write (iout,*) "thet_pred_mean",thet_pred_mean
4246 C Derivatives of the "mean" values in gamma1 and gamma2.
4247 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4248 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4249 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4250 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4252 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4253 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4254 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4255 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4257 if (theta(i).gt.pi-delta) then
4258 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4260 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4261 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4262 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4264 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4266 else if (theta(i).lt.delta) then
4267 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4268 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4269 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4271 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4272 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4275 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4278 etheta=etheta+ethetai
4279 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4280 c & 'ebend',i,ethetai,theta(i),itype(i)
4281 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4282 c & rad2deg*phii,rad2deg*phii1,ethetai
4283 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4284 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4285 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4289 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4290 do i=1,ntheta_constr
4291 itheta=itheta_constr(i)
4292 thetiii=theta(itheta)
4293 difi=pinorm(thetiii-theta_constr0(i))
4294 if (difi.gt.theta_drange(i)) then
4295 difi=difi-theta_drange(i)
4296 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4297 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4298 & +for_thet_constr(i)*difi**3
4299 else if (difi.lt.-drange(i)) then
4301 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4302 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4303 & +for_thet_constr(i)*difi**3
4307 C if (energy_dec) then
4308 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4309 C & i,itheta,rad2deg*thetiii,
4310 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4311 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4312 C & gloc(itheta+nphi-2,icg)
4315 C Ufff.... We've done all this!!!
4318 C---------------------------------------------------------------------------
4319 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4321 implicit real*8 (a-h,o-z)
4322 include 'DIMENSIONS'
4323 include 'COMMON.LOCAL'
4324 include 'COMMON.IOUNITS'
4325 common /calcthet/ term1,term2,termm,diffak,ratak,
4326 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4327 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4328 C Calculate the contributions to both Gaussian lobes.
4329 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4330 C The "polynomial part" of the "standard deviation" of this part of
4334 sig=sig*thet_pred_mean+polthet(j,it)
4336 C Derivative of the "interior part" of the "standard deviation of the"
4337 C gamma-dependent Gaussian lobe in t_c.
4338 sigtc=3*polthet(3,it)
4340 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4343 C Set the parameters of both Gaussian lobes of the distribution.
4344 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4345 fac=sig*sig+sigc0(it)
4348 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4349 sigsqtc=-4.0D0*sigcsq*sigtc
4350 c print *,i,sig,sigtc,sigsqtc
4351 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4352 sigtc=-sigtc/(fac*fac)
4353 C Following variable is sigma(t_c)**(-2)
4354 sigcsq=sigcsq*sigcsq
4356 sig0inv=1.0D0/sig0i**2
4357 delthec=thetai-thet_pred_mean
4358 delthe0=thetai-theta0i
4359 term1=-0.5D0*sigcsq*delthec*delthec
4360 term2=-0.5D0*sig0inv*delthe0*delthe0
4361 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4362 C NaNs in taking the logarithm. We extract the largest exponent which is added
4363 C to the energy (this being the log of the distribution) at the end of energy
4364 C term evaluation for this virtual-bond angle.
4365 if (term1.gt.term2) then
4367 term2=dexp(term2-termm)
4371 term1=dexp(term1-termm)
4374 C The ratio between the gamma-independent and gamma-dependent lobes of
4375 C the distribution is a Gaussian function of thet_pred_mean too.
4376 diffak=gthet(2,it)-thet_pred_mean
4377 ratak=diffak/gthet(3,it)**2
4378 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4379 C Let's differentiate it in thet_pred_mean NOW.
4381 C Now put together the distribution terms to make complete distribution.
4382 termexp=term1+ak*term2
4383 termpre=sigc+ak*sig0i
4384 C Contribution of the bending energy from this theta is just the -log of
4385 C the sum of the contributions from the two lobes and the pre-exponential
4386 C factor. Simple enough, isn't it?
4387 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4388 C NOW the derivatives!!!
4389 C 6/6/97 Take into account the deformation.
4390 E_theta=(delthec*sigcsq*term1
4391 & +ak*delthe0*sig0inv*term2)/termexp
4392 E_tc=((sigtc+aktc*sig0i)/termpre
4393 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4394 & aktc*term2)/termexp)
4397 c-----------------------------------------------------------------------------
4398 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4399 implicit real*8 (a-h,o-z)
4400 include 'DIMENSIONS'
4401 include 'COMMON.LOCAL'
4402 include 'COMMON.IOUNITS'
4403 common /calcthet/ term1,term2,termm,diffak,ratak,
4404 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4405 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4406 delthec=thetai-thet_pred_mean
4407 delthe0=thetai-theta0i
4408 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4409 t3 = thetai-thet_pred_mean
4413 t14 = t12+t6*sigsqtc
4415 t21 = thetai-theta0i
4421 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4422 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4423 & *(-t12*t9-ak*sig0inv*t27)
4427 C--------------------------------------------------------------------------
4428 subroutine ebend(etheta)
4430 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4431 C angles gamma and its derivatives in consecutive thetas and gammas.
4432 C ab initio-derived potentials from
4433 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4435 implicit real*8 (a-h,o-z)
4436 include 'DIMENSIONS'
4437 include 'DIMENSIONS.ZSCOPT'
4438 include 'DIMENSIONS.FREE'
4439 include 'COMMON.LOCAL'
4440 include 'COMMON.GEO'
4441 include 'COMMON.INTERACT'
4442 include 'COMMON.DERIV'
4443 include 'COMMON.VAR'
4444 include 'COMMON.CHAIN'
4445 include 'COMMON.IOUNITS'
4446 include 'COMMON.NAMES'
4447 include 'COMMON.FFIELD'
4448 include 'COMMON.CONTROL'
4449 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4450 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4451 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4452 & sinph1ph2(maxdouble,maxdouble)
4453 logical lprn /.false./, lprn1 /.false./
4455 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4456 do i=ithet_start,ithet_end
4458 c print *,i,itype(i-1),itype(i),itype(i-2)
4459 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4460 & .or.(itype(i).eq.ntyp1)) cycle
4461 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4463 if (iabs(itype(i+1)).eq.20) iblock=2
4464 if (iabs(itype(i+1)).ne.20) iblock=1
4468 theti2=0.5d0*theta(i)
4469 ityp2=ithetyp((itype(i-1)))
4471 coskt(k)=dcos(k*theti2)
4472 sinkt(k)=dsin(k*theti2)
4474 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4477 if (phii.ne.phii) phii=150.0
4481 ityp1=ithetyp((itype(i-2)))
4483 cosph1(k)=dcos(k*phii)
4484 sinph1(k)=dsin(k*phii)
4488 ityp1=ithetyp(itype(i-2))
4494 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4497 if (phii1.ne.phii1) phii1=150.0
4502 ityp3=ithetyp((itype(i)))
4504 cosph2(k)=dcos(k*phii1)
4505 sinph2(k)=dsin(k*phii1)
4509 ityp3=ithetyp(itype(i))
4515 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4516 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4518 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4521 ccl=cosph1(l)*cosph2(k-l)
4522 ssl=sinph1(l)*sinph2(k-l)
4523 scl=sinph1(l)*cosph2(k-l)
4524 csl=cosph1(l)*sinph2(k-l)
4525 cosph1ph2(l,k)=ccl-ssl
4526 cosph1ph2(k,l)=ccl+ssl
4527 sinph1ph2(l,k)=scl+csl
4528 sinph1ph2(k,l)=scl-csl
4532 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4533 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4534 write (iout,*) "coskt and sinkt"
4536 write (iout,*) k,coskt(k),sinkt(k)
4540 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4541 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4544 & write (iout,*) "k",k,"
4545 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4546 & " ethetai",ethetai
4549 write (iout,*) "cosph and sinph"
4551 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4553 write (iout,*) "cosph1ph2 and sinph2ph2"
4556 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4557 & sinph1ph2(l,k),sinph1ph2(k,l)
4560 write(iout,*) "ethetai",ethetai
4564 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4565 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4566 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4567 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4568 ethetai=ethetai+sinkt(m)*aux
4569 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4570 dephii=dephii+k*sinkt(m)*(
4571 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4572 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4573 dephii1=dephii1+k*sinkt(m)*(
4574 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4575 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4577 & write (iout,*) "m",m," k",k," bbthet",
4578 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4579 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4580 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4581 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4585 & write(iout,*) "ethetai",ethetai
4589 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4590 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4591 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4592 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4593 ethetai=ethetai+sinkt(m)*aux
4594 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4595 dephii=dephii+l*sinkt(m)*(
4596 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4597 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4598 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4599 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4600 dephii1=dephii1+(k-l)*sinkt(m)*(
4601 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4602 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4603 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4604 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4606 write (iout,*) "m",m," k",k," l",l," ffthet",
4607 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4608 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4609 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4610 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4611 & " ethetai",ethetai
4612 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4613 & cosph1ph2(k,l)*sinkt(m),
4614 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4620 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4621 & i,theta(i)*rad2deg,phii*rad2deg,
4622 & phii1*rad2deg,ethetai
4623 etheta=etheta+ethetai
4624 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4625 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4626 c gloc(nphi+i-2,icg)=wang*dethetai
4627 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4631 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4632 do i=1,ntheta_constr
4633 itheta=itheta_constr(i)
4634 thetiii=theta(itheta)
4635 difi=pinorm(thetiii-theta_constr0(i))
4636 if (difi.gt.theta_drange(i)) then
4637 difi=difi-theta_drange(i)
4638 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4639 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4640 & +for_thet_constr(i)*difi**3
4641 else if (difi.lt.-drange(i)) then
4643 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4644 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4645 & +for_thet_constr(i)*difi**3
4649 C if (energy_dec) then
4650 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4651 C & i,itheta,rad2deg*thetiii,
4652 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4653 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4654 C & gloc(itheta+nphi-2,icg)
4662 c-----------------------------------------------------------------------------
4663 subroutine esc(escloc)
4664 C Calculate the local energy of a side chain and its derivatives in the
4665 C corresponding virtual-bond valence angles THETA and the spherical angles
4667 implicit real*8 (a-h,o-z)
4668 include 'DIMENSIONS'
4669 include 'DIMENSIONS.ZSCOPT'
4670 include 'COMMON.GEO'
4671 include 'COMMON.LOCAL'
4672 include 'COMMON.VAR'
4673 include 'COMMON.INTERACT'
4674 include 'COMMON.DERIV'
4675 include 'COMMON.CHAIN'
4676 include 'COMMON.IOUNITS'
4677 include 'COMMON.NAMES'
4678 include 'COMMON.FFIELD'
4679 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4680 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4681 common /sccalc/ time11,time12,time112,theti,it,nlobit
4684 C write (iout,*) 'ESC'
4685 do i=loc_start,loc_end
4687 if (it.eq.ntyp1) cycle
4688 if (it.eq.10) goto 1
4689 nlobit=nlob(iabs(it))
4690 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4691 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4692 theti=theta(i+1)-pipol
4696 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4698 if (x(2).gt.pi-delta) then
4702 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4704 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4705 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4707 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4708 & ddersc0(1),dersc(1))
4709 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4710 & ddersc0(3),dersc(3))
4712 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4714 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4715 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4716 & dersc0(2),esclocbi,dersc02)
4717 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4719 call splinthet(x(2),0.5d0*delta,ss,ssd)
4724 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4726 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4727 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4729 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4731 c write (iout,*) escloci
4732 else if (x(2).lt.delta) then
4736 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4738 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4739 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4741 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4742 & ddersc0(1),dersc(1))
4743 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4744 & ddersc0(3),dersc(3))
4746 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4748 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4749 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4750 & dersc0(2),esclocbi,dersc02)
4751 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4756 call splinthet(x(2),0.5d0*delta,ss,ssd)
4758 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4760 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4761 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4763 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4764 C write (iout,*) 'i=',i, escloci
4766 call enesc(x,escloci,dersc,ddummy,.false.)
4769 escloc=escloc+escloci
4770 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4771 write (iout,'(a6,i5,0pf7.3)')
4772 & 'escloc',i,escloci
4774 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4776 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4777 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4782 C---------------------------------------------------------------------------
4783 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4784 implicit real*8 (a-h,o-z)
4785 include 'DIMENSIONS'
4786 include 'COMMON.GEO'
4787 include 'COMMON.LOCAL'
4788 include 'COMMON.IOUNITS'
4789 common /sccalc/ time11,time12,time112,theti,it,nlobit
4790 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4791 double precision contr(maxlob,-1:1)
4793 c write (iout,*) 'it=',it,' nlobit=',nlobit
4797 if (mixed) ddersc(j)=0.0d0
4801 C Because of periodicity of the dependence of the SC energy in omega we have
4802 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4803 C To avoid underflows, first compute & store the exponents.
4811 z(k)=x(k)-censc(k,j,it)
4816 Axk=Axk+gaussc(l,k,j,it)*z(l)
4822 expfac=expfac+Ax(k,j,iii)*z(k)
4830 C As in the case of ebend, we want to avoid underflows in exponentiation and
4831 C subsequent NaNs and INFs in energy calculation.
4832 C Find the largest exponent
4836 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4840 cd print *,'it=',it,' emin=',emin
4842 C Compute the contribution to SC energy and derivatives
4846 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4847 cd print *,'j=',j,' expfac=',expfac
4848 escloc_i=escloc_i+expfac
4850 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4854 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4855 & +gaussc(k,2,j,it))*expfac
4862 dersc(1)=dersc(1)/cos(theti)**2
4863 ddersc(1)=ddersc(1)/cos(theti)**2
4866 escloci=-(dlog(escloc_i)-emin)
4868 dersc(j)=dersc(j)/escloc_i
4872 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4877 C------------------------------------------------------------------------------
4878 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4879 implicit real*8 (a-h,o-z)
4880 include 'DIMENSIONS'
4881 include 'COMMON.GEO'
4882 include 'COMMON.LOCAL'
4883 include 'COMMON.IOUNITS'
4884 common /sccalc/ time11,time12,time112,theti,it,nlobit
4885 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4886 double precision contr(maxlob)
4897 z(k)=x(k)-censc(k,j,it)
4903 Axk=Axk+gaussc(l,k,j,it)*z(l)
4909 expfac=expfac+Ax(k,j)*z(k)
4914 C As in the case of ebend, we want to avoid underflows in exponentiation and
4915 C subsequent NaNs and INFs in energy calculation.
4916 C Find the largest exponent
4919 if (emin.gt.contr(j)) emin=contr(j)
4923 C Compute the contribution to SC energy and derivatives
4927 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4928 escloc_i=escloc_i+expfac
4930 dersc(k)=dersc(k)+Ax(k,j)*expfac
4932 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4933 & +gaussc(1,2,j,it))*expfac
4937 dersc(1)=dersc(1)/cos(theti)**2
4938 dersc12=dersc12/cos(theti)**2
4939 escloci=-(dlog(escloc_i)-emin)
4941 dersc(j)=dersc(j)/escloc_i
4943 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4947 c----------------------------------------------------------------------------------
4948 subroutine esc(escloc)
4949 C Calculate the local energy of a side chain and its derivatives in the
4950 C corresponding virtual-bond valence angles THETA and the spherical angles
4951 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4952 C added by Urszula Kozlowska. 07/11/2007
4954 implicit real*8 (a-h,o-z)
4955 include 'DIMENSIONS'
4956 include 'DIMENSIONS.ZSCOPT'
4957 include 'DIMENSIONS.FREE'
4958 include 'COMMON.GEO'
4959 include 'COMMON.LOCAL'
4960 include 'COMMON.VAR'
4961 include 'COMMON.SCROT'
4962 include 'COMMON.INTERACT'
4963 include 'COMMON.DERIV'
4964 include 'COMMON.CHAIN'
4965 include 'COMMON.IOUNITS'
4966 include 'COMMON.NAMES'
4967 include 'COMMON.FFIELD'
4968 include 'COMMON.CONTROL'
4969 include 'COMMON.VECTORS'
4970 double precision x_prime(3),y_prime(3),z_prime(3)
4971 & , sumene,dsc_i,dp2_i,x(65),
4972 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4973 & de_dxx,de_dyy,de_dzz,de_dt
4974 double precision s1_t,s1_6_t,s2_t,s2_6_t
4976 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4977 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4978 & dt_dCi(3),dt_dCi1(3)
4979 common /sccalc/ time11,time12,time112,theti,it,nlobit
4982 do i=loc_start,loc_end
4983 if (itype(i).eq.ntyp1) cycle
4984 costtab(i+1) =dcos(theta(i+1))
4985 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4986 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4987 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4988 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4989 cosfac=dsqrt(cosfac2)
4990 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4991 sinfac=dsqrt(sinfac2)
4993 if (it.eq.10) goto 1
4995 C Compute the axes of tghe local cartesian coordinates system; store in
4996 c x_prime, y_prime and z_prime
5003 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5004 C & dc_norm(3,i+nres)
5006 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5007 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5010 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5013 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5014 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5015 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5016 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5017 c & " xy",scalar(x_prime(1),y_prime(1)),
5018 c & " xz",scalar(x_prime(1),z_prime(1)),
5019 c & " yy",scalar(y_prime(1),y_prime(1)),
5020 c & " yz",scalar(y_prime(1),z_prime(1)),
5021 c & " zz",scalar(z_prime(1),z_prime(1))
5023 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5024 C to local coordinate system. Store in xx, yy, zz.
5030 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5031 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5032 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5039 C Compute the energy of the ith side cbain
5041 c write (2,*) "xx",xx," yy",yy," zz",zz
5044 x(j) = sc_parmin(j,it)
5047 Cc diagnostics - remove later
5049 yy1 = dsin(alph(2))*dcos(omeg(2))
5050 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5051 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5052 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5054 C," --- ", xx_w,yy_w,zz_w
5057 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5058 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5060 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5061 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5063 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5064 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5065 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5066 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5067 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5069 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5070 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5071 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5072 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5073 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5075 dsc_i = 0.743d0+x(61)
5077 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5078 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5079 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5080 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5081 s1=(1+x(63))/(0.1d0 + dscp1)
5082 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5083 s2=(1+x(65))/(0.1d0 + dscp2)
5084 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5085 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5086 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5087 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5089 c & dscp1,dscp2,sumene
5090 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5091 escloc = escloc + sumene
5092 c write (2,*) "escloc",escloc
5093 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5095 if (.not. calc_grad) goto 1
5098 C This section to check the numerical derivatives of the energy of ith side
5099 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5100 C #define DEBUG in the code to turn it on.
5102 write (2,*) "sumene =",sumene
5106 write (2,*) xx,yy,zz
5107 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5108 de_dxx_num=(sumenep-sumene)/aincr
5110 write (2,*) "xx+ sumene from enesc=",sumenep
5113 write (2,*) xx,yy,zz
5114 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5115 de_dyy_num=(sumenep-sumene)/aincr
5117 write (2,*) "yy+ sumene from enesc=",sumenep
5120 write (2,*) xx,yy,zz
5121 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5122 de_dzz_num=(sumenep-sumene)/aincr
5124 write (2,*) "zz+ sumene from enesc=",sumenep
5125 costsave=cost2tab(i+1)
5126 sintsave=sint2tab(i+1)
5127 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5128 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5129 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5130 de_dt_num=(sumenep-sumene)/aincr
5131 write (2,*) " t+ sumene from enesc=",sumenep
5132 cost2tab(i+1)=costsave
5133 sint2tab(i+1)=sintsave
5134 C End of diagnostics section.
5137 C Compute the gradient of esc
5139 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5140 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5141 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5142 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5143 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5144 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5145 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5146 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5147 pom1=(sumene3*sint2tab(i+1)+sumene1)
5148 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5149 pom2=(sumene4*cost2tab(i+1)+sumene2)
5150 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5151 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5152 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5153 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5155 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5156 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5157 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5159 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5160 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5161 & +(pom1+pom2)*pom_dx
5163 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5166 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5167 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5168 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5170 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5171 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5172 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5173 & +x(59)*zz**2 +x(60)*xx*zz
5174 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5175 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5176 & +(pom1-pom2)*pom_dy
5178 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5181 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5182 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5183 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5184 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5185 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5186 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5187 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5188 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5190 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5193 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5194 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5195 & +pom1*pom_dt1+pom2*pom_dt2
5197 write(2,*), "de_dt = ", de_dt,de_dt_num
5201 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5202 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5203 cosfac2xx=cosfac2*xx
5204 sinfac2yy=sinfac2*yy
5206 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5208 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5210 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5211 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5212 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5213 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5214 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5215 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5216 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5217 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5218 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5219 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5223 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5224 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5225 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5226 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5229 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5230 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5231 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5233 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5234 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5238 dXX_Ctab(k,i)=dXX_Ci(k)
5239 dXX_C1tab(k,i)=dXX_Ci1(k)
5240 dYY_Ctab(k,i)=dYY_Ci(k)
5241 dYY_C1tab(k,i)=dYY_Ci1(k)
5242 dZZ_Ctab(k,i)=dZZ_Ci(k)
5243 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5244 dXX_XYZtab(k,i)=dXX_XYZ(k)
5245 dYY_XYZtab(k,i)=dYY_XYZ(k)
5246 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5250 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5251 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5252 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5253 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5254 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5256 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5257 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5258 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5259 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5260 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5261 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5262 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5263 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5265 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5266 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5268 C to check gradient call subroutine check_grad
5275 c------------------------------------------------------------------------------
5276 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5278 C This procedure calculates two-body contact function g(rij) and its derivative:
5281 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5284 C where x=(rij-r0ij)/delta
5286 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5289 double precision rij,r0ij,eps0ij,fcont,fprimcont
5290 double precision x,x2,x4,delta
5294 if (x.lt.-1.0D0) then
5297 else if (x.le.1.0D0) then
5300 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5301 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5308 c------------------------------------------------------------------------------
5309 subroutine splinthet(theti,delta,ss,ssder)
5310 implicit real*8 (a-h,o-z)
5311 include 'DIMENSIONS'
5312 include 'DIMENSIONS.ZSCOPT'
5313 include 'COMMON.VAR'
5314 include 'COMMON.GEO'
5317 if (theti.gt.pipol) then
5318 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5320 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5325 c------------------------------------------------------------------------------
5326 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5328 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5329 double precision ksi,ksi2,ksi3,a1,a2,a3
5330 a1=fprim0*delta/(f1-f0)
5336 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5337 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5340 c------------------------------------------------------------------------------
5341 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5343 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5344 double precision ksi,ksi2,ksi3,a1,a2,a3
5349 a2=3*(f1x-f0x)-2*fprim0x*delta
5350 a3=fprim0x*delta-2*(f1x-f0x)
5351 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5354 C-----------------------------------------------------------------------------
5356 C-----------------------------------------------------------------------------
5357 subroutine etor(etors,edihcnstr,fact)
5358 implicit real*8 (a-h,o-z)
5359 include 'DIMENSIONS'
5360 include 'DIMENSIONS.ZSCOPT'
5361 include 'COMMON.VAR'
5362 include 'COMMON.GEO'
5363 include 'COMMON.LOCAL'
5364 include 'COMMON.TORSION'
5365 include 'COMMON.INTERACT'
5366 include 'COMMON.DERIV'
5367 include 'COMMON.CHAIN'
5368 include 'COMMON.NAMES'
5369 include 'COMMON.IOUNITS'
5370 include 'COMMON.FFIELD'
5371 include 'COMMON.TORCNSTR'
5373 C Set lprn=.true. for debugging
5377 do i=iphi_start,iphi_end
5378 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5379 & .or. itype(i).eq.ntyp1) cycle
5380 itori=itortyp(itype(i-2))
5381 itori1=itortyp(itype(i-1))
5384 C Proline-Proline pair is a special case...
5385 if (itori.eq.3 .and. itori1.eq.3) then
5386 if (phii.gt.-dwapi3) then
5388 fac=1.0D0/(1.0D0-cosphi)
5389 etorsi=v1(1,3,3)*fac
5390 etorsi=etorsi+etorsi
5391 etors=etors+etorsi-v1(1,3,3)
5392 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5395 v1ij=v1(j+1,itori,itori1)
5396 v2ij=v2(j+1,itori,itori1)
5399 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5400 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5404 v1ij=v1(j,itori,itori1)
5405 v2ij=v2(j,itori,itori1)
5408 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5409 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5413 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5414 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5415 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5416 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5417 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5419 ! 6/20/98 - dihedral angle constraints
5422 itori=idih_constr(i)
5425 if (difi.gt.drange(i)) then
5427 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5428 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5429 else if (difi.lt.-drange(i)) then
5431 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5432 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5434 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5435 C & i,itori,rad2deg*phii,
5436 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5438 ! write (iout,*) 'edihcnstr',edihcnstr
5441 c------------------------------------------------------------------------------
5443 subroutine etor(etors,edihcnstr,fact)
5444 implicit real*8 (a-h,o-z)
5445 include 'DIMENSIONS'
5446 include 'DIMENSIONS.ZSCOPT'
5447 include 'COMMON.VAR'
5448 include 'COMMON.GEO'
5449 include 'COMMON.LOCAL'
5450 include 'COMMON.TORSION'
5451 include 'COMMON.INTERACT'
5452 include 'COMMON.DERIV'
5453 include 'COMMON.CHAIN'
5454 include 'COMMON.NAMES'
5455 include 'COMMON.IOUNITS'
5456 include 'COMMON.FFIELD'
5457 include 'COMMON.TORCNSTR'
5459 C Set lprn=.true. for debugging
5463 do i=iphi_start,iphi_end
5465 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5466 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5467 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5468 C & .or. itype(i).eq.ntyp1) cycle
5469 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5470 if (iabs(itype(i)).eq.20) then
5475 itori=itortyp(itype(i-2))
5476 itori1=itortyp(itype(i-1))
5479 C Regular cosine and sine terms
5480 do j=1,nterm(itori,itori1,iblock)
5481 v1ij=v1(j,itori,itori1,iblock)
5482 v2ij=v2(j,itori,itori1,iblock)
5485 etors=etors+v1ij*cosphi+v2ij*sinphi
5486 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5490 C E = SUM ----------------------------------- - v1
5491 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5493 cosphi=dcos(0.5d0*phii)
5494 sinphi=dsin(0.5d0*phii)
5495 do j=1,nlor(itori,itori1,iblock)
5496 vl1ij=vlor1(j,itori,itori1)
5497 vl2ij=vlor2(j,itori,itori1)
5498 vl3ij=vlor3(j,itori,itori1)
5499 pom=vl2ij*cosphi+vl3ij*sinphi
5500 pom1=1.0d0/(pom*pom+1.0d0)
5501 etors=etors+vl1ij*pom1
5502 c if (energy_dec) etors_ii=etors_ii+
5505 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5507 C Subtract the constant term
5508 etors=etors-v0(itori,itori1,iblock)
5510 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5511 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5512 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5513 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5514 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5517 ! 6/20/98 - dihedral angle constraints
5520 itori=idih_constr(i)
5522 difi=pinorm(phii-phi0(i))
5524 if (difi.gt.drange(i)) then
5526 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5527 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5528 edihi=0.25d0*ftors(i)*difi**4
5529 else if (difi.lt.-drange(i)) then
5531 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5532 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5533 edihi=0.25d0*ftors(i)*difi**4
5537 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5538 & i,itori,rad2deg*phii,
5539 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5540 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5542 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5543 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5545 ! write (iout,*) 'edihcnstr',edihcnstr
5548 c----------------------------------------------------------------------------
5549 subroutine etor_d(etors_d,fact2)
5550 C 6/23/01 Compute double torsional energy
5551 implicit real*8 (a-h,o-z)
5552 include 'DIMENSIONS'
5553 include 'DIMENSIONS.ZSCOPT'
5554 include 'COMMON.VAR'
5555 include 'COMMON.GEO'
5556 include 'COMMON.LOCAL'
5557 include 'COMMON.TORSION'
5558 include 'COMMON.INTERACT'
5559 include 'COMMON.DERIV'
5560 include 'COMMON.CHAIN'
5561 include 'COMMON.NAMES'
5562 include 'COMMON.IOUNITS'
5563 include 'COMMON.FFIELD'
5564 include 'COMMON.TORCNSTR'
5566 C Set lprn=.true. for debugging
5570 do i=iphi_start,iphi_end-1
5572 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5573 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5574 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5575 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5576 & (itype(i+1).eq.ntyp1)) cycle
5577 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5579 itori=itortyp(itype(i-2))
5580 itori1=itortyp(itype(i-1))
5581 itori2=itortyp(itype(i))
5587 if (iabs(itype(i+1)).eq.20) iblock=2
5588 C Regular cosine and sine terms
5589 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5590 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5591 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5592 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5593 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5594 cosphi1=dcos(j*phii)
5595 sinphi1=dsin(j*phii)
5596 cosphi2=dcos(j*phii1)
5597 sinphi2=dsin(j*phii1)
5598 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5599 & v2cij*cosphi2+v2sij*sinphi2
5600 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5601 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5603 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5605 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5606 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5607 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5608 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5609 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5610 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5611 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5612 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5613 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5614 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5615 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5616 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5617 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5618 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5621 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5622 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5628 c------------------------------------------------------------------------------
5629 subroutine eback_sc_corr(esccor)
5630 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5631 c conformational states; temporarily implemented as differences
5632 c between UNRES torsional potentials (dependent on three types of
5633 c residues) and the torsional potentials dependent on all 20 types
5634 c of residues computed from AM1 energy surfaces of terminally-blocked
5635 c amino-acid residues.
5636 implicit real*8 (a-h,o-z)
5637 include 'DIMENSIONS'
5638 include 'DIMENSIONS.ZSCOPT'
5639 include 'DIMENSIONS.FREE'
5640 include 'COMMON.VAR'
5641 include 'COMMON.GEO'
5642 include 'COMMON.LOCAL'
5643 include 'COMMON.TORSION'
5644 include 'COMMON.SCCOR'
5645 include 'COMMON.INTERACT'
5646 include 'COMMON.DERIV'
5647 include 'COMMON.CHAIN'
5648 include 'COMMON.NAMES'
5649 include 'COMMON.IOUNITS'
5650 include 'COMMON.FFIELD'
5651 include 'COMMON.CONTROL'
5653 C Set lprn=.true. for debugging
5656 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5658 do i=itau_start,itau_end
5659 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5661 isccori=isccortyp(itype(i-2))
5662 isccori1=isccortyp(itype(i-1))
5664 do intertyp=1,3 !intertyp
5665 cc Added 09 May 2012 (Adasko)
5666 cc Intertyp means interaction type of backbone mainchain correlation:
5667 c 1 = SC...Ca...Ca...Ca
5668 c 2 = Ca...Ca...Ca...SC
5669 c 3 = SC...Ca...Ca...SCi
5671 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5672 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5673 & (itype(i-1).eq.ntyp1)))
5674 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5675 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5676 & .or.(itype(i).eq.ntyp1)))
5677 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5678 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5679 & (itype(i-3).eq.ntyp1)))) cycle
5680 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5681 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5683 do j=1,nterm_sccor(isccori,isccori1)
5684 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5685 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5686 cosphi=dcos(j*tauangle(intertyp,i))
5687 sinphi=dsin(j*tauangle(intertyp,i))
5688 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5691 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5692 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5693 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5695 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5696 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5697 & (v1sccor(j,1,itori,itori1),j=1,6)
5698 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5699 c gsccor_loc(i-3)=gloci
5704 c------------------------------------------------------------------------------
5705 subroutine multibody(ecorr)
5706 C This subroutine calculates multi-body contributions to energy following
5707 C the idea of Skolnick et al. If side chains I and J make a contact and
5708 C at the same time side chains I+1 and J+1 make a contact, an extra
5709 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5710 implicit real*8 (a-h,o-z)
5711 include 'DIMENSIONS'
5712 include 'COMMON.IOUNITS'
5713 include 'COMMON.DERIV'
5714 include 'COMMON.INTERACT'
5715 include 'COMMON.CONTACTS'
5716 double precision gx(3),gx1(3)
5719 C Set lprn=.true. for debugging
5723 write (iout,'(a)') 'Contact function values:'
5725 write (iout,'(i2,20(1x,i2,f10.5))')
5726 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5741 num_conti=num_cont(i)
5742 num_conti1=num_cont(i1)
5747 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5748 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5749 cd & ' ishift=',ishift
5750 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5751 C The system gains extra energy.
5752 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5753 endif ! j1==j+-ishift
5762 c------------------------------------------------------------------------------
5763 double precision function esccorr(i,j,k,l,jj,kk)
5764 implicit real*8 (a-h,o-z)
5765 include 'DIMENSIONS'
5766 include 'COMMON.IOUNITS'
5767 include 'COMMON.DERIV'
5768 include 'COMMON.INTERACT'
5769 include 'COMMON.CONTACTS'
5770 double precision gx(3),gx1(3)
5775 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5776 C Calculate the multi-body contribution to energy.
5777 C Calculate multi-body contributions to the gradient.
5778 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5779 cd & k,l,(gacont(m,kk,k),m=1,3)
5781 gx(m) =ekl*gacont(m,jj,i)
5782 gx1(m)=eij*gacont(m,kk,k)
5783 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5784 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5785 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5786 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5790 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5795 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5801 c------------------------------------------------------------------------------
5803 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5804 implicit real*8 (a-h,o-z)
5805 include 'DIMENSIONS'
5806 integer dimen1,dimen2,atom,indx
5807 double precision buffer(dimen1,dimen2)
5808 double precision zapas
5809 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5810 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5811 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5812 num_kont=num_cont_hb(atom)
5816 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5819 buffer(i,indx+22)=facont_hb(i,atom)
5820 buffer(i,indx+23)=ees0p(i,atom)
5821 buffer(i,indx+24)=ees0m(i,atom)
5822 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5824 buffer(1,indx+26)=dfloat(num_kont)
5827 c------------------------------------------------------------------------------
5828 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5829 implicit real*8 (a-h,o-z)
5830 include 'DIMENSIONS'
5831 integer dimen1,dimen2,atom,indx
5832 double precision buffer(dimen1,dimen2)
5833 double precision zapas
5834 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5835 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5836 & ees0m(ntyp,maxres),
5837 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5838 num_kont=buffer(1,indx+26)
5839 num_kont_old=num_cont_hb(atom)
5840 num_cont_hb(atom)=num_kont+num_kont_old
5845 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5848 facont_hb(ii,atom)=buffer(i,indx+22)
5849 ees0p(ii,atom)=buffer(i,indx+23)
5850 ees0m(ii,atom)=buffer(i,indx+24)
5851 jcont_hb(ii,atom)=buffer(i,indx+25)
5855 c------------------------------------------------------------------------------
5857 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5858 C This subroutine calculates multi-body contributions to hydrogen-bonding
5859 implicit real*8 (a-h,o-z)
5860 include 'DIMENSIONS'
5861 include 'DIMENSIONS.ZSCOPT'
5862 include 'COMMON.IOUNITS'
5864 include 'COMMON.INFO'
5866 include 'COMMON.FFIELD'
5867 include 'COMMON.DERIV'
5868 include 'COMMON.INTERACT'
5869 include 'COMMON.CONTACTS'
5871 parameter (max_cont=maxconts)
5872 parameter (max_dim=2*(8*3+2))
5873 parameter (msglen1=max_cont*max_dim*4)
5874 parameter (msglen2=2*msglen1)
5875 integer source,CorrelType,CorrelID,Error
5876 double precision buffer(max_cont,max_dim)
5878 double precision gx(3),gx1(3)
5881 C Set lprn=.true. for debugging
5886 if (fgProcs.le.1) goto 30
5888 write (iout,'(a)') 'Contact function values:'
5890 write (iout,'(2i3,50(1x,i2,f5.2))')
5891 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5892 & j=1,num_cont_hb(i))
5895 C Caution! Following code assumes that electrostatic interactions concerning
5896 C a given atom are split among at most two processors!
5906 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5909 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5910 if (MyRank.gt.0) then
5911 C Send correlation contributions to the preceding processor
5913 nn=num_cont_hb(iatel_s)
5914 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5915 cd write (iout,*) 'The BUFFER array:'
5917 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5919 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5921 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5922 C Clear the contacts of the atom passed to the neighboring processor
5923 nn=num_cont_hb(iatel_s+1)
5925 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5927 num_cont_hb(iatel_s)=0
5929 cd write (iout,*) 'Processor ',MyID,MyRank,
5930 cd & ' is sending correlation contribution to processor',MyID-1,
5931 cd & ' msglen=',msglen
5932 cd write (*,*) 'Processor ',MyID,MyRank,
5933 cd & ' is sending correlation contribution to processor',MyID-1,
5934 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5935 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5936 cd write (iout,*) 'Processor ',MyID,
5937 cd & ' has sent correlation contribution to processor',MyID-1,
5938 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5939 cd write (*,*) 'Processor ',MyID,
5940 cd & ' has sent correlation contribution to processor',MyID-1,
5941 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5943 endif ! (MyRank.gt.0)
5947 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5948 if (MyRank.lt.fgProcs-1) then
5949 C Receive correlation contributions from the next processor
5951 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5952 cd write (iout,*) 'Processor',MyID,
5953 cd & ' is receiving correlation contribution from processor',MyID+1,
5954 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5955 cd write (*,*) 'Processor',MyID,
5956 cd & ' is receiving correlation contribution from processor',MyID+1,
5957 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5959 do while (nbytes.le.0)
5960 call mp_probe(MyID+1,CorrelType,nbytes)
5962 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5963 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5964 cd write (iout,*) 'Processor',MyID,
5965 cd & ' has received correlation contribution from processor',MyID+1,
5966 cd & ' msglen=',msglen,' nbytes=',nbytes
5967 cd write (iout,*) 'The received BUFFER array:'
5969 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5971 if (msglen.eq.msglen1) then
5972 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5973 else if (msglen.eq.msglen2) then
5974 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5975 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5978 & 'ERROR!!!! message length changed while processing correlations.'
5980 & 'ERROR!!!! message length changed while processing correlations.'
5981 call mp_stopall(Error)
5982 endif ! msglen.eq.msglen1
5983 endif ! MyRank.lt.fgProcs-1
5990 write (iout,'(a)') 'Contact function values:'
5992 write (iout,'(2i3,50(1x,i2,f5.2))')
5993 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5994 & j=1,num_cont_hb(i))
5998 C Remove the loop below after debugging !!!
6005 C Calculate the local-electrostatic correlation terms
6006 do i=iatel_s,iatel_e+1
6008 num_conti=num_cont_hb(i)
6009 num_conti1=num_cont_hb(i+1)
6014 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6015 c & ' jj=',jj,' kk=',kk
6016 if (j1.eq.j+1 .or. j1.eq.j-1) then
6017 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6018 C The system gains extra energy.
6019 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6021 else if (j1.eq.j) then
6022 C Contacts I-J and I-(J+1) occur simultaneously.
6023 C The system loses extra energy.
6024 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6029 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6030 c & ' jj=',jj,' kk=',kk
6032 C Contacts I-J and (I+1)-J occur simultaneously.
6033 C The system loses extra energy.
6034 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6041 c------------------------------------------------------------------------------
6042 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6044 C This subroutine calculates multi-body contributions to hydrogen-bonding
6045 implicit real*8 (a-h,o-z)
6046 include 'DIMENSIONS'
6047 include 'DIMENSIONS.ZSCOPT'
6048 include 'COMMON.IOUNITS'
6050 include 'COMMON.INFO'
6052 include 'COMMON.FFIELD'
6053 include 'COMMON.DERIV'
6054 include 'COMMON.INTERACT'
6055 include 'COMMON.CONTACTS'
6057 parameter (max_cont=maxconts)
6058 parameter (max_dim=2*(8*3+2))
6059 parameter (msglen1=max_cont*max_dim*4)
6060 parameter (msglen2=2*msglen1)
6061 integer source,CorrelType,CorrelID,Error
6062 double precision buffer(max_cont,max_dim)
6064 double precision gx(3),gx1(3)
6067 C Set lprn=.true. for debugging
6074 if (fgProcs.le.1) goto 30
6076 write (iout,'(a)') 'Contact function values:'
6078 write (iout,'(2i3,50(1x,i2,f5.2))')
6079 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6080 & j=1,num_cont_hb(i))
6083 C Caution! Following code assumes that electrostatic interactions concerning
6084 C a given atom are split among at most two processors!
6094 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6097 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6098 if (MyRank.gt.0) then
6099 C Send correlation contributions to the preceding processor
6101 nn=num_cont_hb(iatel_s)
6102 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6103 cd write (iout,*) 'The BUFFER array:'
6105 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6107 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6109 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6110 C Clear the contacts of the atom passed to the neighboring processor
6111 nn=num_cont_hb(iatel_s+1)
6113 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6115 num_cont_hb(iatel_s)=0
6117 cd write (iout,*) 'Processor ',MyID,MyRank,
6118 cd & ' is sending correlation contribution to processor',MyID-1,
6119 cd & ' msglen=',msglen
6120 cd write (*,*) 'Processor ',MyID,MyRank,
6121 cd & ' is sending correlation contribution to processor',MyID-1,
6122 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6123 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6124 cd write (iout,*) 'Processor ',MyID,
6125 cd & ' has sent correlation contribution to processor',MyID-1,
6126 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6127 cd write (*,*) 'Processor ',MyID,
6128 cd & ' has sent correlation contribution to processor',MyID-1,
6129 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6131 endif ! (MyRank.gt.0)
6135 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6136 if (MyRank.lt.fgProcs-1) then
6137 C Receive correlation contributions from the next processor
6139 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6140 cd write (iout,*) 'Processor',MyID,
6141 cd & ' is receiving correlation contribution from processor',MyID+1,
6142 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6143 cd write (*,*) 'Processor',MyID,
6144 cd & ' is receiving correlation contribution from processor',MyID+1,
6145 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6147 do while (nbytes.le.0)
6148 call mp_probe(MyID+1,CorrelType,nbytes)
6150 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6151 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6152 cd write (iout,*) 'Processor',MyID,
6153 cd & ' has received correlation contribution from processor',MyID+1,
6154 cd & ' msglen=',msglen,' nbytes=',nbytes
6155 cd write (iout,*) 'The received BUFFER array:'
6157 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6159 if (msglen.eq.msglen1) then
6160 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6161 else if (msglen.eq.msglen2) then
6162 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6163 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6166 & 'ERROR!!!! message length changed while processing correlations.'
6168 & 'ERROR!!!! message length changed while processing correlations.'
6169 call mp_stopall(Error)
6170 endif ! msglen.eq.msglen1
6171 endif ! MyRank.lt.fgProcs-1
6178 write (iout,'(a)') 'Contact function values:'
6180 write (iout,'(2i3,50(1x,i2,f5.2))')
6181 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6182 & j=1,num_cont_hb(i))
6188 C Remove the loop below after debugging !!!
6195 C Calculate the dipole-dipole interaction energies
6196 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6197 do i=iatel_s,iatel_e+1
6198 num_conti=num_cont_hb(i)
6205 C Calculate the local-electrostatic correlation terms
6206 do i=iatel_s,iatel_e+1
6208 num_conti=num_cont_hb(i)
6209 num_conti1=num_cont_hb(i+1)
6214 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6215 c & ' jj=',jj,' kk=',kk
6216 if (j1.eq.j+1 .or. j1.eq.j-1) then
6217 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6218 C The system gains extra energy.
6220 sqd1=dsqrt(d_cont(jj,i))
6221 sqd2=dsqrt(d_cont(kk,i1))
6222 sred_geom = sqd1*sqd2
6223 IF (sred_geom.lt.cutoff_corr) THEN
6224 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6226 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6227 c & ' jj=',jj,' kk=',kk
6228 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6229 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6231 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6232 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6235 cd write (iout,*) 'sred_geom=',sred_geom,
6236 cd & ' ekont=',ekont,' fprim=',fprimcont
6237 call calc_eello(i,j,i+1,j1,jj,kk)
6238 if (wcorr4.gt.0.0d0)
6239 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6240 if (wcorr5.gt.0.0d0)
6241 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6242 c print *,"wcorr5",ecorr5
6243 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6244 cd write(2,*)'ijkl',i,j,i+1,j1
6245 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6246 & .or. wturn6.eq.0.0d0))then
6247 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6248 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6249 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6250 cd & 'ecorr6=',ecorr6
6251 cd write (iout,'(4e15.5)') sred_geom,
6252 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6253 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6254 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6255 else if (wturn6.gt.0.0d0
6256 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6257 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6258 eturn6=eturn6+eello_turn6(i,jj,kk)
6259 cd write (2,*) 'multibody_eello:eturn6',eturn6
6260 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6267 else if (j1.eq.j) then
6268 C Contacts I-J and I-(J+1) occur simultaneously.
6269 C The system loses extra energy.
6270 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6275 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6276 c & ' jj=',jj,' kk=',kk
6278 C Contacts I-J and (I+1)-J occur simultaneously.
6279 C The system loses extra energy.
6280 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6285 write (iout,*) "eturn6",eturn6,ecorr6
6288 c------------------------------------------------------------------------------
6289 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6290 implicit real*8 (a-h,o-z)
6291 include 'DIMENSIONS'
6292 include 'COMMON.IOUNITS'
6293 include 'COMMON.DERIV'
6294 include 'COMMON.INTERACT'
6295 include 'COMMON.CONTACTS'
6296 double precision gx(3),gx1(3)
6306 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6307 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6308 C Following 4 lines for diagnostics.
6313 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6315 c write (iout,*)'Contacts have occurred for peptide groups',
6316 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6317 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6318 C Calculate the multi-body contribution to energy.
6319 ecorr=ecorr+ekont*ees
6321 C Calculate multi-body contributions to the gradient.
6323 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6324 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6325 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6326 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6327 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6328 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6329 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6330 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6331 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6332 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6333 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6334 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6335 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6336 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6340 gradcorr(ll,m)=gradcorr(ll,m)+
6341 & ees*ekl*gacont_hbr(ll,jj,i)-
6342 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6343 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6348 gradcorr(ll,m)=gradcorr(ll,m)+
6349 & ees*eij*gacont_hbr(ll,kk,k)-
6350 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6351 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6358 C---------------------------------------------------------------------------
6359 subroutine dipole(i,j,jj)
6360 implicit real*8 (a-h,o-z)
6361 include 'DIMENSIONS'
6362 include 'DIMENSIONS.ZSCOPT'
6363 include 'COMMON.IOUNITS'
6364 include 'COMMON.CHAIN'
6365 include 'COMMON.FFIELD'
6366 include 'COMMON.DERIV'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.CONTACTS'
6369 include 'COMMON.TORSION'
6370 include 'COMMON.VAR'
6371 include 'COMMON.GEO'
6372 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6374 iti1 = itortyp(itype(i+1))
6375 if (j.lt.nres-1) then
6376 if (itype(j).le.ntyp) then
6377 itj1 = itortyp(itype(j+1))
6385 dipi(iii,1)=Ub2(iii,i)
6386 dipderi(iii)=Ub2der(iii,i)
6387 dipi(iii,2)=b1(iii,iti1)
6388 dipj(iii,1)=Ub2(iii,j)
6389 dipderj(iii)=Ub2der(iii,j)
6390 dipj(iii,2)=b1(iii,itj1)
6394 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6397 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6400 if (.not.calc_grad) return
6405 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6409 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6414 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6415 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6417 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6419 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6421 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6425 C---------------------------------------------------------------------------
6426 subroutine calc_eello(i,j,k,l,jj,kk)
6428 C This subroutine computes matrices and vectors needed to calculate
6429 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6431 implicit real*8 (a-h,o-z)
6432 include 'DIMENSIONS'
6433 include 'DIMENSIONS.ZSCOPT'
6434 include 'COMMON.IOUNITS'
6435 include 'COMMON.CHAIN'
6436 include 'COMMON.DERIV'
6437 include 'COMMON.INTERACT'
6438 include 'COMMON.CONTACTS'
6439 include 'COMMON.TORSION'
6440 include 'COMMON.VAR'
6441 include 'COMMON.GEO'
6442 include 'COMMON.FFIELD'
6443 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6444 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6447 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6448 cd & ' jj=',jj,' kk=',kk
6449 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6452 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6453 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6456 call transpose2(aa1(1,1),aa1t(1,1))
6457 call transpose2(aa2(1,1),aa2t(1,1))
6460 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6461 & aa1tder(1,1,lll,kkk))
6462 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6463 & aa2tder(1,1,lll,kkk))
6467 C parallel orientation of the two CA-CA-CA frames.
6468 if (i.gt.1 .and. itype(i).le.ntyp) then
6469 iti=itortyp(itype(i))
6473 itk1=itortyp(itype(k+1))
6474 itj=itortyp(itype(j))
6475 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6476 itl1=itortyp(itype(l+1))
6480 C A1 kernel(j+1) A2T
6482 cd write (iout,'(3f10.5,5x,3f10.5)')
6483 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6485 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6486 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6487 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6488 C Following matrices are needed only for 6-th order cumulants
6489 IF (wcorr6.gt.0.0d0) THEN
6490 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6491 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6492 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6493 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6494 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6495 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6496 & ADtEAderx(1,1,1,1,1,1))
6498 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6499 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6500 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6501 & ADtEA1derx(1,1,1,1,1,1))
6503 C End 6-th order cumulants
6506 cd write (2,*) 'In calc_eello6'
6508 cd write (2,*) 'iii=',iii
6510 cd write (2,*) 'kkk=',kkk
6512 cd write (2,'(3(2f10.5),5x)')
6513 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6518 call transpose2(EUgder(1,1,k),auxmat(1,1))
6519 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6520 call transpose2(EUg(1,1,k),auxmat(1,1))
6521 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6522 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6526 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6527 & EAEAderx(1,1,lll,kkk,iii,1))
6531 C A1T kernel(i+1) A2
6532 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6533 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6534 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6535 C Following matrices are needed only for 6-th order cumulants
6536 IF (wcorr6.gt.0.0d0) THEN
6537 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6538 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6539 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6540 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6541 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6542 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6543 & ADtEAderx(1,1,1,1,1,2))
6544 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6545 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6546 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6547 & ADtEA1derx(1,1,1,1,1,2))
6549 C End 6-th order cumulants
6550 call transpose2(EUgder(1,1,l),auxmat(1,1))
6551 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6552 call transpose2(EUg(1,1,l),auxmat(1,1))
6553 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6554 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6558 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6559 & EAEAderx(1,1,lll,kkk,iii,2))
6564 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6565 C They are needed only when the fifth- or the sixth-order cumulants are
6567 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6568 call transpose2(AEA(1,1,1),auxmat(1,1))
6569 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6570 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6571 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6572 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6573 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6574 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6575 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6576 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6577 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6578 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6579 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6580 call transpose2(AEA(1,1,2),auxmat(1,1))
6581 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6582 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6583 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6584 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6585 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6586 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6587 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6588 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6589 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6590 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6591 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6592 C Calculate the Cartesian derivatives of the vectors.
6596 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6597 call matvec2(auxmat(1,1),b1(1,iti),
6598 & AEAb1derx(1,lll,kkk,iii,1,1))
6599 call matvec2(auxmat(1,1),Ub2(1,i),
6600 & AEAb2derx(1,lll,kkk,iii,1,1))
6601 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6602 & AEAb1derx(1,lll,kkk,iii,2,1))
6603 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6604 & AEAb2derx(1,lll,kkk,iii,2,1))
6605 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6606 call matvec2(auxmat(1,1),b1(1,itj),
6607 & AEAb1derx(1,lll,kkk,iii,1,2))
6608 call matvec2(auxmat(1,1),Ub2(1,j),
6609 & AEAb2derx(1,lll,kkk,iii,1,2))
6610 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6611 & AEAb1derx(1,lll,kkk,iii,2,2))
6612 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6613 & AEAb2derx(1,lll,kkk,iii,2,2))
6620 C Antiparallel orientation of the two CA-CA-CA frames.
6621 if (i.gt.1 .and. itype(i).le.ntyp) then
6622 iti=itortyp(itype(i))
6626 itk1=itortyp(itype(k+1))
6627 itl=itortyp(itype(l))
6628 itj=itortyp(itype(j))
6629 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6630 itj1=itortyp(itype(j+1))
6634 C A2 kernel(j-1)T A1T
6635 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6636 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6637 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6638 C Following matrices are needed only for 6-th order cumulants
6639 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6640 & j.eq.i+4 .and. l.eq.i+3)) THEN
6641 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6642 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6643 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6644 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6645 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6646 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6647 & ADtEAderx(1,1,1,1,1,1))
6648 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6649 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6650 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6651 & ADtEA1derx(1,1,1,1,1,1))
6653 C End 6-th order cumulants
6654 call transpose2(EUgder(1,1,k),auxmat(1,1))
6655 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6656 call transpose2(EUg(1,1,k),auxmat(1,1))
6657 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6658 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6662 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6663 & EAEAderx(1,1,lll,kkk,iii,1))
6667 C A2T kernel(i+1)T A1
6668 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6669 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6670 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6671 C Following matrices are needed only for 6-th order cumulants
6672 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6673 & j.eq.i+4 .and. l.eq.i+3)) THEN
6674 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6675 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6676 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6677 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6678 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6679 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6680 & ADtEAderx(1,1,1,1,1,2))
6681 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6682 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6683 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6684 & ADtEA1derx(1,1,1,1,1,2))
6686 C End 6-th order cumulants
6687 call transpose2(EUgder(1,1,j),auxmat(1,1))
6688 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6689 call transpose2(EUg(1,1,j),auxmat(1,1))
6690 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6691 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6695 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6696 & EAEAderx(1,1,lll,kkk,iii,2))
6701 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6702 C They are needed only when the fifth- or the sixth-order cumulants are
6704 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6705 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6706 call transpose2(AEA(1,1,1),auxmat(1,1))
6707 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6708 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6709 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6710 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6711 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6712 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6713 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6714 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6715 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6716 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6717 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6718 call transpose2(AEA(1,1,2),auxmat(1,1))
6719 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6720 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6721 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6722 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6723 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6724 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6725 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6726 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6727 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6728 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6729 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6730 C Calculate the Cartesian derivatives of the vectors.
6734 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6735 call matvec2(auxmat(1,1),b1(1,iti),
6736 & AEAb1derx(1,lll,kkk,iii,1,1))
6737 call matvec2(auxmat(1,1),Ub2(1,i),
6738 & AEAb2derx(1,lll,kkk,iii,1,1))
6739 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6740 & AEAb1derx(1,lll,kkk,iii,2,1))
6741 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6742 & AEAb2derx(1,lll,kkk,iii,2,1))
6743 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6744 call matvec2(auxmat(1,1),b1(1,itl),
6745 & AEAb1derx(1,lll,kkk,iii,1,2))
6746 call matvec2(auxmat(1,1),Ub2(1,l),
6747 & AEAb2derx(1,lll,kkk,iii,1,2))
6748 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6749 & AEAb1derx(1,lll,kkk,iii,2,2))
6750 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6751 & AEAb2derx(1,lll,kkk,iii,2,2))
6760 C---------------------------------------------------------------------------
6761 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6762 & KK,KKderg,AKA,AKAderg,AKAderx)
6766 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6767 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6768 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6773 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6775 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6778 cd if (lprn) write (2,*) 'In kernel'
6780 cd if (lprn) write (2,*) 'kkk=',kkk
6782 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6783 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6785 cd write (2,*) 'lll=',lll
6786 cd write (2,*) 'iii=1'
6788 cd write (2,'(3(2f10.5),5x)')
6789 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6792 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6793 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6795 cd write (2,*) 'lll=',lll
6796 cd write (2,*) 'iii=2'
6798 cd write (2,'(3(2f10.5),5x)')
6799 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6806 C---------------------------------------------------------------------------
6807 double precision function eello4(i,j,k,l,jj,kk)
6808 implicit real*8 (a-h,o-z)
6809 include 'DIMENSIONS'
6810 include 'DIMENSIONS.ZSCOPT'
6811 include 'COMMON.IOUNITS'
6812 include 'COMMON.CHAIN'
6813 include 'COMMON.DERIV'
6814 include 'COMMON.INTERACT'
6815 include 'COMMON.CONTACTS'
6816 include 'COMMON.TORSION'
6817 include 'COMMON.VAR'
6818 include 'COMMON.GEO'
6819 double precision pizda(2,2),ggg1(3),ggg2(3)
6820 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6824 cd print *,'eello4:',i,j,k,l,jj,kk
6825 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6826 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6827 cold eij=facont_hb(jj,i)
6828 cold ekl=facont_hb(kk,k)
6830 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6832 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6833 gcorr_loc(k-1)=gcorr_loc(k-1)
6834 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6836 gcorr_loc(l-1)=gcorr_loc(l-1)
6837 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6839 gcorr_loc(j-1)=gcorr_loc(j-1)
6840 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6845 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6846 & -EAEAderx(2,2,lll,kkk,iii,1)
6847 cd derx(lll,kkk,iii)=0.0d0
6851 cd gcorr_loc(l-1)=0.0d0
6852 cd gcorr_loc(j-1)=0.0d0
6853 cd gcorr_loc(k-1)=0.0d0
6855 cd write (iout,*)'Contacts have occurred for peptide groups',
6856 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6857 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6858 if (j.lt.nres-1) then
6865 if (l.lt.nres-1) then
6873 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6874 ggg1(ll)=eel4*g_contij(ll,1)
6875 ggg2(ll)=eel4*g_contij(ll,2)
6876 ghalf=0.5d0*ggg1(ll)
6878 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6879 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6880 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6881 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6882 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6883 ghalf=0.5d0*ggg2(ll)
6885 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6886 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6887 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6888 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6893 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6894 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6899 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6900 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6906 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6911 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6915 cd write (2,*) iii,gcorr_loc(iii)
6919 cd write (2,*) 'ekont',ekont
6920 cd write (iout,*) 'eello4',ekont*eel4
6923 C---------------------------------------------------------------------------
6924 double precision function eello5(i,j,k,l,jj,kk)
6925 implicit real*8 (a-h,o-z)
6926 include 'DIMENSIONS'
6927 include 'DIMENSIONS.ZSCOPT'
6928 include 'COMMON.IOUNITS'
6929 include 'COMMON.CHAIN'
6930 include 'COMMON.DERIV'
6931 include 'COMMON.INTERACT'
6932 include 'COMMON.CONTACTS'
6933 include 'COMMON.TORSION'
6934 include 'COMMON.VAR'
6935 include 'COMMON.GEO'
6936 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6937 double precision ggg1(3),ggg2(3)
6938 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6943 C /l\ / \ \ / \ / \ / C
6944 C / \ / \ \ / \ / \ / C
6945 C j| o |l1 | o | o| o | | o |o C
6946 C \ |/k\| |/ \| / |/ \| |/ \| C
6947 C \i/ \ / \ / / \ / \ C
6949 C (I) (II) (III) (IV) C
6951 C eello5_1 eello5_2 eello5_3 eello5_4 C
6953 C Antiparallel chains C
6956 C /j\ / \ \ / \ / \ / C
6957 C / \ / \ \ / \ / \ / C
6958 C j1| o |l | o | o| o | | o |o C
6959 C \ |/k\| |/ \| / |/ \| |/ \| C
6960 C \i/ \ / \ / / \ / \ C
6962 C (I) (II) (III) (IV) C
6964 C eello5_1 eello5_2 eello5_3 eello5_4 C
6966 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6968 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6969 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6974 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6976 itk=itortyp(itype(k))
6977 itl=itortyp(itype(l))
6978 itj=itortyp(itype(j))
6983 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6984 cd & eel5_3_num,eel5_4_num)
6988 derx(lll,kkk,iii)=0.0d0
6992 cd eij=facont_hb(jj,i)
6993 cd ekl=facont_hb(kk,k)
6995 cd write (iout,*)'Contacts have occurred for peptide groups',
6996 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6998 C Contribution from the graph I.
6999 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7000 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7001 call transpose2(EUg(1,1,k),auxmat(1,1))
7002 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7003 vv(1)=pizda(1,1)-pizda(2,2)
7004 vv(2)=pizda(1,2)+pizda(2,1)
7005 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7006 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7008 C Explicit gradient in virtual-dihedral angles.
7009 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7010 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7011 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7012 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7013 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7014 vv(1)=pizda(1,1)-pizda(2,2)
7015 vv(2)=pizda(1,2)+pizda(2,1)
7016 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7017 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7018 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7019 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7020 vv(1)=pizda(1,1)-pizda(2,2)
7021 vv(2)=pizda(1,2)+pizda(2,1)
7023 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7024 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7025 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7027 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7028 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7029 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7031 C Cartesian gradient
7035 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7037 vv(1)=pizda(1,1)-pizda(2,2)
7038 vv(2)=pizda(1,2)+pizda(2,1)
7039 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7040 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7041 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7048 C Contribution from graph II
7049 call transpose2(EE(1,1,itk),auxmat(1,1))
7050 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7051 vv(1)=pizda(1,1)+pizda(2,2)
7052 vv(2)=pizda(2,1)-pizda(1,2)
7053 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7054 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7056 C Explicit gradient in virtual-dihedral angles.
7057 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7058 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7059 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7060 vv(1)=pizda(1,1)+pizda(2,2)
7061 vv(2)=pizda(2,1)-pizda(1,2)
7063 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7064 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7065 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7067 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7068 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7069 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7071 C Cartesian gradient
7075 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7077 vv(1)=pizda(1,1)+pizda(2,2)
7078 vv(2)=pizda(2,1)-pizda(1,2)
7079 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7080 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7081 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7090 C Parallel orientation
7091 C Contribution from graph III
7092 call transpose2(EUg(1,1,l),auxmat(1,1))
7093 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7094 vv(1)=pizda(1,1)-pizda(2,2)
7095 vv(2)=pizda(1,2)+pizda(2,1)
7096 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7097 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7099 C Explicit gradient in virtual-dihedral angles.
7100 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7101 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7102 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7103 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7104 vv(1)=pizda(1,1)-pizda(2,2)
7105 vv(2)=pizda(1,2)+pizda(2,1)
7106 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7107 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7108 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7109 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7110 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7111 vv(1)=pizda(1,1)-pizda(2,2)
7112 vv(2)=pizda(1,2)+pizda(2,1)
7113 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7114 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7115 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7116 C Cartesian gradient
7120 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7122 vv(1)=pizda(1,1)-pizda(2,2)
7123 vv(2)=pizda(1,2)+pizda(2,1)
7124 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7125 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7126 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7132 C Contribution from graph IV
7134 call transpose2(EE(1,1,itl),auxmat(1,1))
7135 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7136 vv(1)=pizda(1,1)+pizda(2,2)
7137 vv(2)=pizda(2,1)-pizda(1,2)
7138 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7139 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7141 C Explicit gradient in virtual-dihedral angles.
7142 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7143 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7144 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7145 vv(1)=pizda(1,1)+pizda(2,2)
7146 vv(2)=pizda(2,1)-pizda(1,2)
7147 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7148 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7149 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7150 C Cartesian gradient
7154 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7156 vv(1)=pizda(1,1)+pizda(2,2)
7157 vv(2)=pizda(2,1)-pizda(1,2)
7158 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7159 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7160 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7166 C Antiparallel orientation
7167 C Contribution from graph III
7169 call transpose2(EUg(1,1,j),auxmat(1,1))
7170 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7171 vv(1)=pizda(1,1)-pizda(2,2)
7172 vv(2)=pizda(1,2)+pizda(2,1)
7173 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7174 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7176 C Explicit gradient in virtual-dihedral angles.
7177 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7178 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7179 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7180 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7181 vv(1)=pizda(1,1)-pizda(2,2)
7182 vv(2)=pizda(1,2)+pizda(2,1)
7183 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7184 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7185 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7186 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7187 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7188 vv(1)=pizda(1,1)-pizda(2,2)
7189 vv(2)=pizda(1,2)+pizda(2,1)
7190 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7191 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7192 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7193 C Cartesian gradient
7197 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7199 vv(1)=pizda(1,1)-pizda(2,2)
7200 vv(2)=pizda(1,2)+pizda(2,1)
7201 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7202 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7203 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7209 C Contribution from graph IV
7211 call transpose2(EE(1,1,itj),auxmat(1,1))
7212 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7213 vv(1)=pizda(1,1)+pizda(2,2)
7214 vv(2)=pizda(2,1)-pizda(1,2)
7215 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7216 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7218 C Explicit gradient in virtual-dihedral angles.
7219 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7220 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7221 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7222 vv(1)=pizda(1,1)+pizda(2,2)
7223 vv(2)=pizda(2,1)-pizda(1,2)
7224 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7225 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7226 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7227 C Cartesian gradient
7231 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7233 vv(1)=pizda(1,1)+pizda(2,2)
7234 vv(2)=pizda(2,1)-pizda(1,2)
7235 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7236 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7237 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7244 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7245 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7246 cd write (2,*) 'ijkl',i,j,k,l
7247 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7248 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7250 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7251 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7252 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7253 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7255 if (j.lt.nres-1) then
7262 if (l.lt.nres-1) then
7272 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7274 ggg1(ll)=eel5*g_contij(ll,1)
7275 ggg2(ll)=eel5*g_contij(ll,2)
7276 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7277 ghalf=0.5d0*ggg1(ll)
7279 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7280 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7281 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7282 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7283 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7284 ghalf=0.5d0*ggg2(ll)
7286 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7287 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7288 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7289 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7294 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7295 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7300 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7301 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7307 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7312 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7316 cd write (2,*) iii,g_corr5_loc(iii)
7320 cd write (2,*) 'ekont',ekont
7321 cd write (iout,*) 'eello5',ekont*eel5
7324 c--------------------------------------------------------------------------
7325 double precision function eello6(i,j,k,l,jj,kk)
7326 implicit real*8 (a-h,o-z)
7327 include 'DIMENSIONS'
7328 include 'DIMENSIONS.ZSCOPT'
7329 include 'COMMON.IOUNITS'
7330 include 'COMMON.CHAIN'
7331 include 'COMMON.DERIV'
7332 include 'COMMON.INTERACT'
7333 include 'COMMON.CONTACTS'
7334 include 'COMMON.TORSION'
7335 include 'COMMON.VAR'
7336 include 'COMMON.GEO'
7337 include 'COMMON.FFIELD'
7338 double precision ggg1(3),ggg2(3)
7339 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7344 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7352 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7353 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7357 derx(lll,kkk,iii)=0.0d0
7361 cd eij=facont_hb(jj,i)
7362 cd ekl=facont_hb(kk,k)
7368 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7369 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7370 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7371 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7372 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7373 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7375 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7376 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7377 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7378 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7379 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7380 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7384 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7386 C If turn contributions are considered, they will be handled separately.
7387 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7388 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7389 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7390 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7391 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7392 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7393 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7396 if (j.lt.nres-1) then
7403 if (l.lt.nres-1) then
7411 ggg1(ll)=eel6*g_contij(ll,1)
7412 ggg2(ll)=eel6*g_contij(ll,2)
7413 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7414 ghalf=0.5d0*ggg1(ll)
7416 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7417 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7418 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7419 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7420 ghalf=0.5d0*ggg2(ll)
7421 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7423 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7424 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7425 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7426 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7431 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7432 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7437 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7438 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7444 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7449 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7453 cd write (2,*) iii,g_corr6_loc(iii)
7457 cd write (2,*) 'ekont',ekont
7458 cd write (iout,*) 'eello6',ekont*eel6
7461 c--------------------------------------------------------------------------
7462 double precision function eello6_graph1(i,j,k,l,imat,swap)
7463 implicit real*8 (a-h,o-z)
7464 include 'DIMENSIONS'
7465 include 'DIMENSIONS.ZSCOPT'
7466 include 'COMMON.IOUNITS'
7467 include 'COMMON.CHAIN'
7468 include 'COMMON.DERIV'
7469 include 'COMMON.INTERACT'
7470 include 'COMMON.CONTACTS'
7471 include 'COMMON.TORSION'
7472 include 'COMMON.VAR'
7473 include 'COMMON.GEO'
7474 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7478 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7480 C Parallel Antiparallel C
7486 C \ j|/k\| / \ |/k\|l / C
7491 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7492 itk=itortyp(itype(k))
7493 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7494 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7495 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7496 call transpose2(EUgC(1,1,k),auxmat(1,1))
7497 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7498 vv1(1)=pizda1(1,1)-pizda1(2,2)
7499 vv1(2)=pizda1(1,2)+pizda1(2,1)
7500 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7501 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7502 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7503 s5=scalar2(vv(1),Dtobr2(1,i))
7504 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7505 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7506 if (.not. calc_grad) return
7507 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7508 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7509 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7510 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7511 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7512 & +scalar2(vv(1),Dtobr2der(1,i)))
7513 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7514 vv1(1)=pizda1(1,1)-pizda1(2,2)
7515 vv1(2)=pizda1(1,2)+pizda1(2,1)
7516 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7517 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7519 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7520 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7521 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7522 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7523 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7525 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7526 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7527 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7528 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7529 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7531 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7532 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7533 vv1(1)=pizda1(1,1)-pizda1(2,2)
7534 vv1(2)=pizda1(1,2)+pizda1(2,1)
7535 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7536 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7537 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7538 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7547 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7548 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7549 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7550 call transpose2(EUgC(1,1,k),auxmat(1,1))
7551 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7553 vv1(1)=pizda1(1,1)-pizda1(2,2)
7554 vv1(2)=pizda1(1,2)+pizda1(2,1)
7555 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7556 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7557 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7558 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7559 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7560 s5=scalar2(vv(1),Dtobr2(1,i))
7561 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7567 c----------------------------------------------------------------------------
7568 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7569 implicit real*8 (a-h,o-z)
7570 include 'DIMENSIONS'
7571 include 'DIMENSIONS.ZSCOPT'
7572 include 'COMMON.IOUNITS'
7573 include 'COMMON.CHAIN'
7574 include 'COMMON.DERIV'
7575 include 'COMMON.INTERACT'
7576 include 'COMMON.CONTACTS'
7577 include 'COMMON.TORSION'
7578 include 'COMMON.VAR'
7579 include 'COMMON.GEO'
7581 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7582 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7585 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7587 C Parallel Antiparallel C
7593 C \ j|/k\| \ |/k\|l C
7598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7599 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7600 C AL 7/4/01 s1 would occur in the sixth-order moment,
7601 C but not in a cluster cumulant
7603 s1=dip(1,jj,i)*dip(1,kk,k)
7605 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7606 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7607 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7608 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7609 call transpose2(EUg(1,1,k),auxmat(1,1))
7610 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(1,2)+pizda(2,1)
7613 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7614 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7616 eello6_graph2=-(s1+s2+s3+s4)
7618 eello6_graph2=-(s2+s3+s4)
7621 if (.not. calc_grad) return
7622 C Derivatives in gamma(i-1)
7625 s1=dipderg(1,jj,i)*dip(1,kk,k)
7627 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7628 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7629 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7630 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7632 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7634 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7636 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7638 C Derivatives in gamma(k-1)
7640 s1=dip(1,jj,i)*dipderg(1,kk,k)
7642 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7643 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7644 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7645 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7646 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7647 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7648 vv(1)=pizda(1,1)-pizda(2,2)
7649 vv(2)=pizda(1,2)+pizda(2,1)
7650 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7652 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7654 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7656 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7657 C Derivatives in gamma(j-1) or gamma(l-1)
7660 s1=dipderg(3,jj,i)*dip(1,kk,k)
7662 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7663 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7664 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7665 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7666 vv(1)=pizda(1,1)-pizda(2,2)
7667 vv(2)=pizda(1,2)+pizda(2,1)
7668 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7671 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7673 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7676 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7677 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7679 C Derivatives in gamma(l-1) or gamma(j-1)
7682 s1=dip(1,jj,i)*dipderg(3,kk,k)
7684 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7685 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7686 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7687 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7688 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7689 vv(1)=pizda(1,1)-pizda(2,2)
7690 vv(2)=pizda(1,2)+pizda(2,1)
7691 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7694 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7696 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7699 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7700 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7702 C Cartesian derivatives.
7704 write (2,*) 'In eello6_graph2'
7706 write (2,*) 'iii=',iii
7708 write (2,*) 'kkk=',kkk
7710 write (2,'(3(2f10.5),5x)')
7711 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7721 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7723 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7726 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7728 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7729 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7731 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7732 call transpose2(EUg(1,1,k),auxmat(1,1))
7733 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7735 vv(1)=pizda(1,1)-pizda(2,2)
7736 vv(2)=pizda(1,2)+pizda(2,1)
7737 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7738 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7742 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7745 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7747 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7754 c----------------------------------------------------------------------------
7755 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7756 implicit real*8 (a-h,o-z)
7757 include 'DIMENSIONS'
7758 include 'DIMENSIONS.ZSCOPT'
7759 include 'COMMON.IOUNITS'
7760 include 'COMMON.CHAIN'
7761 include 'COMMON.DERIV'
7762 include 'COMMON.INTERACT'
7763 include 'COMMON.CONTACTS'
7764 include 'COMMON.TORSION'
7765 include 'COMMON.VAR'
7766 include 'COMMON.GEO'
7767 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7769 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7771 C Parallel Antiparallel C
7777 C j|/k\| / |/k\|l / C
7782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7784 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7785 C energy moment and not to the cluster cumulant.
7786 iti=itortyp(itype(i))
7787 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7788 itj1=itortyp(itype(j+1))
7792 itk=itortyp(itype(k))
7793 itk1=itortyp(itype(k+1))
7794 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7795 itl1=itortyp(itype(l+1))
7800 s1=dip(4,jj,i)*dip(4,kk,k)
7802 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7803 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7804 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7805 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7806 call transpose2(EE(1,1,itk),auxmat(1,1))
7807 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7808 vv(1)=pizda(1,1)+pizda(2,2)
7809 vv(2)=pizda(2,1)-pizda(1,2)
7810 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7811 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7813 eello6_graph3=-(s1+s2+s3+s4)
7815 eello6_graph3=-(s2+s3+s4)
7818 if (.not. calc_grad) return
7819 C Derivatives in gamma(k-1)
7820 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7821 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7822 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7823 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7824 C Derivatives in gamma(l-1)
7825 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7826 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7827 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7828 vv(1)=pizda(1,1)+pizda(2,2)
7829 vv(2)=pizda(2,1)-pizda(1,2)
7830 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7831 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7832 C Cartesian derivatives.
7838 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7840 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7843 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7845 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7846 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7848 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7849 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7851 vv(1)=pizda(1,1)+pizda(2,2)
7852 vv(2)=pizda(2,1)-pizda(1,2)
7853 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7855 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7857 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7860 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7862 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7864 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7870 c----------------------------------------------------------------------------
7871 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7872 implicit real*8 (a-h,o-z)
7873 include 'DIMENSIONS'
7874 include 'DIMENSIONS.ZSCOPT'
7875 include 'COMMON.IOUNITS'
7876 include 'COMMON.CHAIN'
7877 include 'COMMON.DERIV'
7878 include 'COMMON.INTERACT'
7879 include 'COMMON.CONTACTS'
7880 include 'COMMON.TORSION'
7881 include 'COMMON.VAR'
7882 include 'COMMON.GEO'
7883 include 'COMMON.FFIELD'
7884 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7885 & auxvec1(2),auxmat1(2,2)
7887 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7889 C Parallel Antiparallel C
7895 C \ j|/k\| \ |/k\|l C
7900 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7902 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7903 C energy moment and not to the cluster cumulant.
7904 cd write (2,*) 'eello_graph4: wturn6',wturn6
7905 iti=itortyp(itype(i))
7906 itj=itortyp(itype(j))
7907 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7908 itj1=itortyp(itype(j+1))
7912 itk=itortyp(itype(k))
7913 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7914 itk1=itortyp(itype(k+1))
7918 itl=itortyp(itype(l))
7919 if (l.lt.nres-1) then
7920 itl1=itortyp(itype(l+1))
7924 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7925 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7926 cd & ' itl',itl,' itl1',itl1
7929 s1=dip(3,jj,i)*dip(3,kk,k)
7931 s1=dip(2,jj,j)*dip(2,kk,l)
7934 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7935 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7937 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7938 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7940 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7941 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7943 call transpose2(EUg(1,1,k),auxmat(1,1))
7944 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7945 vv(1)=pizda(1,1)-pizda(2,2)
7946 vv(2)=pizda(2,1)+pizda(1,2)
7947 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7948 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7950 eello6_graph4=-(s1+s2+s3+s4)
7952 eello6_graph4=-(s2+s3+s4)
7954 if (.not. calc_grad) return
7955 C Derivatives in gamma(i-1)
7959 s1=dipderg(2,jj,i)*dip(3,kk,k)
7961 s1=dipderg(4,jj,j)*dip(2,kk,l)
7964 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7966 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7967 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7969 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7970 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7972 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7973 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7974 cd write (2,*) 'turn6 derivatives'
7976 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7978 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7982 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7984 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7988 C Derivatives in gamma(k-1)
7991 s1=dip(3,jj,i)*dipderg(2,kk,k)
7993 s1=dip(2,jj,j)*dipderg(4,kk,l)
7996 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7997 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7999 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8000 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8002 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8003 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8005 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8006 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8007 vv(1)=pizda(1,1)-pizda(2,2)
8008 vv(2)=pizda(2,1)+pizda(1,2)
8009 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8010 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8012 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8014 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8018 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8020 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8023 C Derivatives in gamma(j-1) or gamma(l-1)
8024 if (l.eq.j+1 .and. l.gt.1) then
8025 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8026 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8027 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8028 vv(1)=pizda(1,1)-pizda(2,2)
8029 vv(2)=pizda(2,1)+pizda(1,2)
8030 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8031 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8032 else if (j.gt.1) then
8033 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8034 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8035 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8036 vv(1)=pizda(1,1)-pizda(2,2)
8037 vv(2)=pizda(2,1)+pizda(1,2)
8038 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8039 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8040 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8042 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8045 C Cartesian derivatives.
8052 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8054 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8058 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8060 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8064 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8066 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8068 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8069 & b1(1,itj1),auxvec(1))
8070 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8072 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8073 & b1(1,itl1),auxvec(1))
8074 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8076 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8078 vv(1)=pizda(1,1)-pizda(2,2)
8079 vv(2)=pizda(2,1)+pizda(1,2)
8080 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8082 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8084 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8087 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8090 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8093 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8095 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8097 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8101 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8103 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8106 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8108 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8116 c----------------------------------------------------------------------------
8117 double precision function eello_turn6(i,jj,kk)
8118 implicit real*8 (a-h,o-z)
8119 include 'DIMENSIONS'
8120 include 'DIMENSIONS.ZSCOPT'
8121 include 'COMMON.IOUNITS'
8122 include 'COMMON.CHAIN'
8123 include 'COMMON.DERIV'
8124 include 'COMMON.INTERACT'
8125 include 'COMMON.CONTACTS'
8126 include 'COMMON.TORSION'
8127 include 'COMMON.VAR'
8128 include 'COMMON.GEO'
8129 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8130 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8132 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8133 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8134 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8135 C the respective energy moment and not to the cluster cumulant.
8140 iti=itortyp(itype(i))
8141 itk=itortyp(itype(k))
8142 itk1=itortyp(itype(k+1))
8143 itl=itortyp(itype(l))
8144 itj=itortyp(itype(j))
8145 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8146 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8147 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8152 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8154 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8158 derx_turn(lll,kkk,iii)=0.0d0
8165 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8167 cd write (2,*) 'eello6_5',eello6_5
8169 call transpose2(AEA(1,1,1),auxmat(1,1))
8170 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8171 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8172 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8176 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8177 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8178 s2 = scalar2(b1(1,itk),vtemp1(1))
8180 call transpose2(AEA(1,1,2),atemp(1,1))
8181 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8182 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8183 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8187 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8188 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8189 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8191 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8192 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8193 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8194 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8195 ss13 = scalar2(b1(1,itk),vtemp4(1))
8196 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8200 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8206 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8208 C Derivatives in gamma(i+2)
8210 call transpose2(AEA(1,1,1),auxmatd(1,1))
8211 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8212 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8213 call transpose2(AEAderg(1,1,2),atempd(1,1))
8214 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8215 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8219 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8220 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8221 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8227 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8228 C Derivatives in gamma(i+3)
8230 call transpose2(AEA(1,1,1),auxmatd(1,1))
8231 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8232 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8233 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8237 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8238 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8239 s2d = scalar2(b1(1,itk),vtemp1d(1))
8241 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8242 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8244 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8246 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8247 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8248 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8258 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8259 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8261 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8262 & -0.5d0*ekont*(s2d+s12d)
8264 C Derivatives in gamma(i+4)
8265 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8266 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8267 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8269 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8270 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8271 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8281 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8283 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8285 C Derivatives in gamma(i+5)
8287 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8288 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8289 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8293 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8294 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8295 s2d = scalar2(b1(1,itk),vtemp1d(1))
8297 call transpose2(AEA(1,1,2),atempd(1,1))
8298 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8299 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8303 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8304 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8306 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8307 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8308 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8318 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8319 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8321 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8322 & -0.5d0*ekont*(s2d+s12d)
8324 C Cartesian derivatives
8329 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8330 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8331 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8335 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8336 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8338 s2d = scalar2(b1(1,itk),vtemp1d(1))
8340 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8341 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8342 s8d = -(atempd(1,1)+atempd(2,2))*
8343 & scalar2(cc(1,1,itl),vtemp2(1))
8347 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8349 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8350 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8357 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8360 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8364 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8365 & - 0.5d0*(s8d+s12d)
8367 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8376 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8378 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8379 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8380 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8381 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8382 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8384 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8385 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8386 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8390 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8391 cd & 16*eel_turn6_num
8393 if (j.lt.nres-1) then
8400 if (l.lt.nres-1) then
8408 ggg1(ll)=eel_turn6*g_contij(ll,1)
8409 ggg2(ll)=eel_turn6*g_contij(ll,2)
8410 ghalf=0.5d0*ggg1(ll)
8412 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8413 & +ekont*derx_turn(ll,2,1)
8414 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8415 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8416 & +ekont*derx_turn(ll,4,1)
8417 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8418 ghalf=0.5d0*ggg2(ll)
8420 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8421 & +ekont*derx_turn(ll,2,2)
8422 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8423 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8424 & +ekont*derx_turn(ll,4,2)
8425 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8430 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8435 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8441 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8446 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8450 cd write (2,*) iii,g_corr6_loc(iii)
8453 eello_turn6=ekont*eel_turn6
8454 cd write (2,*) 'ekont',ekont
8455 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8458 crc-------------------------------------------------
8459 SUBROUTINE MATVEC2(A1,V1,V2)
8460 implicit real*8 (a-h,o-z)
8461 include 'DIMENSIONS'
8462 DIMENSION A1(2,2),V1(2),V2(2)
8466 c 3 VI=VI+A1(I,K)*V1(K)
8470 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8471 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8476 C---------------------------------------
8477 SUBROUTINE MATMAT2(A1,A2,A3)
8478 implicit real*8 (a-h,o-z)
8479 include 'DIMENSIONS'
8480 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8481 c DIMENSION AI3(2,2)
8485 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8491 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8492 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8493 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8494 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8502 c-------------------------------------------------------------------------
8503 double precision function scalar2(u,v)
8505 double precision u(2),v(2)
8508 scalar2=u(1)*v(1)+u(2)*v(2)
8512 C-----------------------------------------------------------------------------
8514 subroutine transpose2(a,at)
8516 double precision a(2,2),at(2,2)
8523 c--------------------------------------------------------------------------
8524 subroutine transpose(n,a,at)
8527 double precision a(n,n),at(n,n)
8535 C---------------------------------------------------------------------------
8536 subroutine prodmat3(a1,a2,kk,transp,prod)
8539 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8541 crc double precision auxmat(2,2),prod_(2,2)
8544 crc call transpose2(kk(1,1),auxmat(1,1))
8545 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8546 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8548 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8549 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8550 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8551 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8552 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8553 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8554 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8555 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8558 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8559 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8561 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8562 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8563 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8564 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8565 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8566 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8567 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8568 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8571 c call transpose2(a2(1,1),a2t(1,1))
8574 crc print *,((prod_(i,j),i=1,2),j=1,2)
8575 crc print *,((prod(i,j),i=1,2),j=1,2)
8579 C-----------------------------------------------------------------------------
8580 double precision function scalar(u,v)
8582 double precision u(3),v(3)
8592 C-----------------------------------------------------------------------
8593 double precision function sscale(r)
8594 double precision r,gamm
8595 include "COMMON.SPLITELE"
8596 if(r.lt.r_cut-rlamb) then
8598 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8599 gamm=(r-(r_cut-rlamb))/rlamb
8600 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8606 C-----------------------------------------------------------------------
8607 C-----------------------------------------------------------------------
8608 double precision function sscagrad(r)
8609 double precision r,gamm
8610 include "COMMON.SPLITELE"
8611 if(r.lt.r_cut-rlamb) then
8613 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8614 gamm=(r-(r_cut-rlamb))/rlamb
8615 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8621 C-----------------------------------------------------------------------
8622 C-----------------------------------------------------------------------
8623 double precision function sscalelip(r)
8624 double precision r,gamm
8625 include "COMMON.SPLITELE"
8626 C if(r.lt.r_cut-rlamb) then
8628 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8629 C gamm=(r-(r_cut-rlamb))/rlamb
8630 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8636 C-----------------------------------------------------------------------
8637 double precision function sscagradlip(r)
8638 double precision r,gamm
8639 include "COMMON.SPLITELE"
8640 C if(r.lt.r_cut-rlamb) then
8642 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8643 C gamm=(r-(r_cut-rlamb))/rlamb
8644 sscagradlip=r*(6*r-6.0d0)