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 include 'COMMON.TORCNSTR'
4450 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4451 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4452 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4453 & sinph1ph2(maxdouble,maxdouble)
4454 logical lprn /.false./, lprn1 /.false./
4456 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4457 do i=ithet_start,ithet_end
4459 c print *,i,itype(i-1),itype(i),itype(i-2)
4460 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4461 & .or.(itype(i).eq.ntyp1)) cycle
4462 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4464 if (iabs(itype(i+1)).eq.20) iblock=2
4465 if (iabs(itype(i+1)).ne.20) iblock=1
4469 theti2=0.5d0*theta(i)
4470 ityp2=ithetyp((itype(i-1)))
4472 coskt(k)=dcos(k*theti2)
4473 sinkt(k)=dsin(k*theti2)
4475 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4478 if (phii.ne.phii) phii=150.0
4482 ityp1=ithetyp((itype(i-2)))
4484 cosph1(k)=dcos(k*phii)
4485 sinph1(k)=dsin(k*phii)
4489 ityp1=ithetyp(itype(i-2))
4495 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4498 if (phii1.ne.phii1) phii1=150.0
4503 ityp3=ithetyp((itype(i)))
4505 cosph2(k)=dcos(k*phii1)
4506 sinph2(k)=dsin(k*phii1)
4510 ityp3=ithetyp(itype(i))
4516 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4517 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4519 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4522 ccl=cosph1(l)*cosph2(k-l)
4523 ssl=sinph1(l)*sinph2(k-l)
4524 scl=sinph1(l)*cosph2(k-l)
4525 csl=cosph1(l)*sinph2(k-l)
4526 cosph1ph2(l,k)=ccl-ssl
4527 cosph1ph2(k,l)=ccl+ssl
4528 sinph1ph2(l,k)=scl+csl
4529 sinph1ph2(k,l)=scl-csl
4533 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4534 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4535 write (iout,*) "coskt and sinkt"
4537 write (iout,*) k,coskt(k),sinkt(k)
4541 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4542 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4545 & write (iout,*) "k",k,"
4546 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4547 & " ethetai",ethetai
4550 write (iout,*) "cosph and sinph"
4552 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4554 write (iout,*) "cosph1ph2 and sinph2ph2"
4557 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4558 & sinph1ph2(l,k),sinph1ph2(k,l)
4561 write(iout,*) "ethetai",ethetai
4565 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4566 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4567 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4568 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4569 ethetai=ethetai+sinkt(m)*aux
4570 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4571 dephii=dephii+k*sinkt(m)*(
4572 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4573 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4574 dephii1=dephii1+k*sinkt(m)*(
4575 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4576 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4578 & write (iout,*) "m",m," k",k," bbthet",
4579 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4580 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4581 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4582 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4586 & write(iout,*) "ethetai",ethetai
4590 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4591 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4592 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4593 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4594 ethetai=ethetai+sinkt(m)*aux
4595 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4596 dephii=dephii+l*sinkt(m)*(
4597 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4598 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4599 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4600 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4601 dephii1=dephii1+(k-l)*sinkt(m)*(
4602 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4603 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4604 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4605 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4607 write (iout,*) "m",m," k",k," l",l," ffthet",
4608 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4609 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4610 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4611 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4612 & " ethetai",ethetai
4613 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4614 & cosph1ph2(k,l)*sinkt(m),
4615 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4621 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4622 & i,theta(i)*rad2deg,phii*rad2deg,
4623 & phii1*rad2deg,ethetai
4624 etheta=etheta+ethetai
4625 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4626 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4627 c gloc(nphi+i-2,icg)=wang*dethetai
4628 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4632 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4633 do i=1,ntheta_constr
4634 itheta=itheta_constr(i)
4635 thetiii=theta(itheta)
4636 difi=pinorm(thetiii-theta_constr0(i))
4637 if (difi.gt.theta_drange(i)) then
4638 difi=difi-theta_drange(i)
4639 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4640 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4641 & +for_thet_constr(i)*difi**3
4642 else if (difi.lt.-drange(i)) then
4644 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4645 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4646 & +for_thet_constr(i)*difi**3
4650 C if (energy_dec) then
4651 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4652 C & i,itheta,rad2deg*thetiii,
4653 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4654 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4655 C & gloc(itheta+nphi-2,icg)
4663 c-----------------------------------------------------------------------------
4664 subroutine esc(escloc)
4665 C Calculate the local energy of a side chain and its derivatives in the
4666 C corresponding virtual-bond valence angles THETA and the spherical angles
4668 implicit real*8 (a-h,o-z)
4669 include 'DIMENSIONS'
4670 include 'DIMENSIONS.ZSCOPT'
4671 include 'COMMON.GEO'
4672 include 'COMMON.LOCAL'
4673 include 'COMMON.VAR'
4674 include 'COMMON.INTERACT'
4675 include 'COMMON.DERIV'
4676 include 'COMMON.CHAIN'
4677 include 'COMMON.IOUNITS'
4678 include 'COMMON.NAMES'
4679 include 'COMMON.FFIELD'
4680 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4681 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4682 common /sccalc/ time11,time12,time112,theti,it,nlobit
4685 C write (iout,*) 'ESC'
4686 do i=loc_start,loc_end
4688 if (it.eq.ntyp1) cycle
4689 if (it.eq.10) goto 1
4690 nlobit=nlob(iabs(it))
4691 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4692 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4693 theti=theta(i+1)-pipol
4697 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4699 if (x(2).gt.pi-delta) then
4703 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4705 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4706 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4708 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4709 & ddersc0(1),dersc(1))
4710 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4711 & ddersc0(3),dersc(3))
4713 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4715 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4716 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4717 & dersc0(2),esclocbi,dersc02)
4718 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4720 call splinthet(x(2),0.5d0*delta,ss,ssd)
4725 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4727 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4728 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4730 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4732 c write (iout,*) escloci
4733 else if (x(2).lt.delta) then
4737 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4739 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4740 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4742 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4743 & ddersc0(1),dersc(1))
4744 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4745 & ddersc0(3),dersc(3))
4747 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4749 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4750 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4751 & dersc0(2),esclocbi,dersc02)
4752 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4757 call splinthet(x(2),0.5d0*delta,ss,ssd)
4759 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4761 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4762 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4764 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4765 C write (iout,*) 'i=',i, escloci
4767 call enesc(x,escloci,dersc,ddummy,.false.)
4770 escloc=escloc+escloci
4771 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4772 write (iout,'(a6,i5,0pf7.3)')
4773 & 'escloc',i,escloci
4775 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4777 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4778 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4783 C---------------------------------------------------------------------------
4784 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4785 implicit real*8 (a-h,o-z)
4786 include 'DIMENSIONS'
4787 include 'COMMON.GEO'
4788 include 'COMMON.LOCAL'
4789 include 'COMMON.IOUNITS'
4790 common /sccalc/ time11,time12,time112,theti,it,nlobit
4791 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4792 double precision contr(maxlob,-1:1)
4794 c write (iout,*) 'it=',it,' nlobit=',nlobit
4798 if (mixed) ddersc(j)=0.0d0
4802 C Because of periodicity of the dependence of the SC energy in omega we have
4803 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4804 C To avoid underflows, first compute & store the exponents.
4812 z(k)=x(k)-censc(k,j,it)
4817 Axk=Axk+gaussc(l,k,j,it)*z(l)
4823 expfac=expfac+Ax(k,j,iii)*z(k)
4831 C As in the case of ebend, we want to avoid underflows in exponentiation and
4832 C subsequent NaNs and INFs in energy calculation.
4833 C Find the largest exponent
4837 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4841 cd print *,'it=',it,' emin=',emin
4843 C Compute the contribution to SC energy and derivatives
4847 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4848 cd print *,'j=',j,' expfac=',expfac
4849 escloc_i=escloc_i+expfac
4851 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4855 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4856 & +gaussc(k,2,j,it))*expfac
4863 dersc(1)=dersc(1)/cos(theti)**2
4864 ddersc(1)=ddersc(1)/cos(theti)**2
4867 escloci=-(dlog(escloc_i)-emin)
4869 dersc(j)=dersc(j)/escloc_i
4873 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4878 C------------------------------------------------------------------------------
4879 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4880 implicit real*8 (a-h,o-z)
4881 include 'DIMENSIONS'
4882 include 'COMMON.GEO'
4883 include 'COMMON.LOCAL'
4884 include 'COMMON.IOUNITS'
4885 common /sccalc/ time11,time12,time112,theti,it,nlobit
4886 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4887 double precision contr(maxlob)
4898 z(k)=x(k)-censc(k,j,it)
4904 Axk=Axk+gaussc(l,k,j,it)*z(l)
4910 expfac=expfac+Ax(k,j)*z(k)
4915 C As in the case of ebend, we want to avoid underflows in exponentiation and
4916 C subsequent NaNs and INFs in energy calculation.
4917 C Find the largest exponent
4920 if (emin.gt.contr(j)) emin=contr(j)
4924 C Compute the contribution to SC energy and derivatives
4928 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4929 escloc_i=escloc_i+expfac
4931 dersc(k)=dersc(k)+Ax(k,j)*expfac
4933 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4934 & +gaussc(1,2,j,it))*expfac
4938 dersc(1)=dersc(1)/cos(theti)**2
4939 dersc12=dersc12/cos(theti)**2
4940 escloci=-(dlog(escloc_i)-emin)
4942 dersc(j)=dersc(j)/escloc_i
4944 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4948 c----------------------------------------------------------------------------------
4949 subroutine esc(escloc)
4950 C Calculate the local energy of a side chain and its derivatives in the
4951 C corresponding virtual-bond valence angles THETA and the spherical angles
4952 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4953 C added by Urszula Kozlowska. 07/11/2007
4955 implicit real*8 (a-h,o-z)
4956 include 'DIMENSIONS'
4957 include 'DIMENSIONS.ZSCOPT'
4958 include 'DIMENSIONS.FREE'
4959 include 'COMMON.GEO'
4960 include 'COMMON.LOCAL'
4961 include 'COMMON.VAR'
4962 include 'COMMON.SCROT'
4963 include 'COMMON.INTERACT'
4964 include 'COMMON.DERIV'
4965 include 'COMMON.CHAIN'
4966 include 'COMMON.IOUNITS'
4967 include 'COMMON.NAMES'
4968 include 'COMMON.FFIELD'
4969 include 'COMMON.CONTROL'
4970 include 'COMMON.VECTORS'
4971 double precision x_prime(3),y_prime(3),z_prime(3)
4972 & , sumene,dsc_i,dp2_i,x(65),
4973 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4974 & de_dxx,de_dyy,de_dzz,de_dt
4975 double precision s1_t,s1_6_t,s2_t,s2_6_t
4977 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4978 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4979 & dt_dCi(3),dt_dCi1(3)
4980 common /sccalc/ time11,time12,time112,theti,it,nlobit
4983 do i=loc_start,loc_end
4984 if (itype(i).eq.ntyp1) cycle
4985 costtab(i+1) =dcos(theta(i+1))
4986 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4987 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4988 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4989 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4990 cosfac=dsqrt(cosfac2)
4991 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4992 sinfac=dsqrt(sinfac2)
4994 if (it.eq.10) goto 1
4996 C Compute the axes of tghe local cartesian coordinates system; store in
4997 c x_prime, y_prime and z_prime
5004 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5005 C & dc_norm(3,i+nres)
5007 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5008 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5011 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5014 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5015 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5016 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5017 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5018 c & " xy",scalar(x_prime(1),y_prime(1)),
5019 c & " xz",scalar(x_prime(1),z_prime(1)),
5020 c & " yy",scalar(y_prime(1),y_prime(1)),
5021 c & " yz",scalar(y_prime(1),z_prime(1)),
5022 c & " zz",scalar(z_prime(1),z_prime(1))
5024 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5025 C to local coordinate system. Store in xx, yy, zz.
5031 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5032 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5033 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5040 C Compute the energy of the ith side cbain
5042 c write (2,*) "xx",xx," yy",yy," zz",zz
5045 x(j) = sc_parmin(j,it)
5048 Cc diagnostics - remove later
5050 yy1 = dsin(alph(2))*dcos(omeg(2))
5051 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5052 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5053 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5055 C," --- ", xx_w,yy_w,zz_w
5058 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5059 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5061 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5062 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5064 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5065 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5066 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5067 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5068 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5070 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5071 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5072 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5073 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5074 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5076 dsc_i = 0.743d0+x(61)
5078 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5079 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5080 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5081 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5082 s1=(1+x(63))/(0.1d0 + dscp1)
5083 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5084 s2=(1+x(65))/(0.1d0 + dscp2)
5085 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5086 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5087 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5088 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5090 c & dscp1,dscp2,sumene
5091 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5092 escloc = escloc + sumene
5093 c write (2,*) "escloc",escloc
5094 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5096 if (.not. calc_grad) goto 1
5099 C This section to check the numerical derivatives of the energy of ith side
5100 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5101 C #define DEBUG in the code to turn it on.
5103 write (2,*) "sumene =",sumene
5107 write (2,*) xx,yy,zz
5108 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5109 de_dxx_num=(sumenep-sumene)/aincr
5111 write (2,*) "xx+ sumene from enesc=",sumenep
5114 write (2,*) xx,yy,zz
5115 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5116 de_dyy_num=(sumenep-sumene)/aincr
5118 write (2,*) "yy+ sumene from enesc=",sumenep
5121 write (2,*) xx,yy,zz
5122 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5123 de_dzz_num=(sumenep-sumene)/aincr
5125 write (2,*) "zz+ sumene from enesc=",sumenep
5126 costsave=cost2tab(i+1)
5127 sintsave=sint2tab(i+1)
5128 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5129 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5130 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5131 de_dt_num=(sumenep-sumene)/aincr
5132 write (2,*) " t+ sumene from enesc=",sumenep
5133 cost2tab(i+1)=costsave
5134 sint2tab(i+1)=sintsave
5135 C End of diagnostics section.
5138 C Compute the gradient of esc
5140 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5141 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5142 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5143 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5144 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5145 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5146 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5147 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5148 pom1=(sumene3*sint2tab(i+1)+sumene1)
5149 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5150 pom2=(sumene4*cost2tab(i+1)+sumene2)
5151 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5152 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5153 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5154 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5156 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5157 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5158 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5160 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5161 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5162 & +(pom1+pom2)*pom_dx
5164 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5167 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5168 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5169 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5171 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5172 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5173 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5174 & +x(59)*zz**2 +x(60)*xx*zz
5175 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5176 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5177 & +(pom1-pom2)*pom_dy
5179 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5182 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5183 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5184 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5185 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5186 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5187 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5188 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5189 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5191 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5194 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5195 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5196 & +pom1*pom_dt1+pom2*pom_dt2
5198 write(2,*), "de_dt = ", de_dt,de_dt_num
5202 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5203 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5204 cosfac2xx=cosfac2*xx
5205 sinfac2yy=sinfac2*yy
5207 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5209 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5211 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5212 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5213 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5214 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5215 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5216 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5217 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5218 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5219 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5220 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5224 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5225 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5226 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5227 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5230 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5231 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5232 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5234 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5235 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5239 dXX_Ctab(k,i)=dXX_Ci(k)
5240 dXX_C1tab(k,i)=dXX_Ci1(k)
5241 dYY_Ctab(k,i)=dYY_Ci(k)
5242 dYY_C1tab(k,i)=dYY_Ci1(k)
5243 dZZ_Ctab(k,i)=dZZ_Ci(k)
5244 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5245 dXX_XYZtab(k,i)=dXX_XYZ(k)
5246 dYY_XYZtab(k,i)=dYY_XYZ(k)
5247 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5251 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5252 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5253 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5254 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5255 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5257 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5258 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5259 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5260 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5261 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5262 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5263 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5264 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5266 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5267 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5269 C to check gradient call subroutine check_grad
5276 c------------------------------------------------------------------------------
5277 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5279 C This procedure calculates two-body contact function g(rij) and its derivative:
5282 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5285 C where x=(rij-r0ij)/delta
5287 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5290 double precision rij,r0ij,eps0ij,fcont,fprimcont
5291 double precision x,x2,x4,delta
5295 if (x.lt.-1.0D0) then
5298 else if (x.le.1.0D0) then
5301 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5302 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5309 c------------------------------------------------------------------------------
5310 subroutine splinthet(theti,delta,ss,ssder)
5311 implicit real*8 (a-h,o-z)
5312 include 'DIMENSIONS'
5313 include 'DIMENSIONS.ZSCOPT'
5314 include 'COMMON.VAR'
5315 include 'COMMON.GEO'
5318 if (theti.gt.pipol) then
5319 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5321 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5326 c------------------------------------------------------------------------------
5327 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5329 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5330 double precision ksi,ksi2,ksi3,a1,a2,a3
5331 a1=fprim0*delta/(f1-f0)
5337 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5338 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5341 c------------------------------------------------------------------------------
5342 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5344 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5345 double precision ksi,ksi2,ksi3,a1,a2,a3
5350 a2=3*(f1x-f0x)-2*fprim0x*delta
5351 a3=fprim0x*delta-2*(f1x-f0x)
5352 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5355 C-----------------------------------------------------------------------------
5357 C-----------------------------------------------------------------------------
5358 subroutine etor(etors,edihcnstr,fact)
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 include 'DIMENSIONS.ZSCOPT'
5362 include 'COMMON.VAR'
5363 include 'COMMON.GEO'
5364 include 'COMMON.LOCAL'
5365 include 'COMMON.TORSION'
5366 include 'COMMON.INTERACT'
5367 include 'COMMON.DERIV'
5368 include 'COMMON.CHAIN'
5369 include 'COMMON.NAMES'
5370 include 'COMMON.IOUNITS'
5371 include 'COMMON.FFIELD'
5372 include 'COMMON.TORCNSTR'
5374 C Set lprn=.true. for debugging
5378 do i=iphi_start,iphi_end
5379 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5380 & .or. itype(i).eq.ntyp1) cycle
5381 itori=itortyp(itype(i-2))
5382 itori1=itortyp(itype(i-1))
5385 C Proline-Proline pair is a special case...
5386 if (itori.eq.3 .and. itori1.eq.3) then
5387 if (phii.gt.-dwapi3) then
5389 fac=1.0D0/(1.0D0-cosphi)
5390 etorsi=v1(1,3,3)*fac
5391 etorsi=etorsi+etorsi
5392 etors=etors+etorsi-v1(1,3,3)
5393 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5396 v1ij=v1(j+1,itori,itori1)
5397 v2ij=v2(j+1,itori,itori1)
5400 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5401 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5405 v1ij=v1(j,itori,itori1)
5406 v2ij=v2(j,itori,itori1)
5409 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5410 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5414 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5415 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5416 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5417 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5418 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5420 ! 6/20/98 - dihedral angle constraints
5423 itori=idih_constr(i)
5426 if (difi.gt.drange(i)) then
5428 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5429 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5430 else if (difi.lt.-drange(i)) then
5432 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5433 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5435 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5436 C & i,itori,rad2deg*phii,
5437 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5439 ! write (iout,*) 'edihcnstr',edihcnstr
5442 c------------------------------------------------------------------------------
5444 subroutine etor(etors,edihcnstr,fact)
5445 implicit real*8 (a-h,o-z)
5446 include 'DIMENSIONS'
5447 include 'DIMENSIONS.ZSCOPT'
5448 include 'COMMON.VAR'
5449 include 'COMMON.GEO'
5450 include 'COMMON.LOCAL'
5451 include 'COMMON.TORSION'
5452 include 'COMMON.INTERACT'
5453 include 'COMMON.DERIV'
5454 include 'COMMON.CHAIN'
5455 include 'COMMON.NAMES'
5456 include 'COMMON.IOUNITS'
5457 include 'COMMON.FFIELD'
5458 include 'COMMON.TORCNSTR'
5460 C Set lprn=.true. for debugging
5464 do i=iphi_start,iphi_end
5466 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5467 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5468 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5469 C & .or. itype(i).eq.ntyp1) cycle
5470 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5471 if (iabs(itype(i)).eq.20) then
5476 itori=itortyp(itype(i-2))
5477 itori1=itortyp(itype(i-1))
5480 C Regular cosine and sine terms
5481 do j=1,nterm(itori,itori1,iblock)
5482 v1ij=v1(j,itori,itori1,iblock)
5483 v2ij=v2(j,itori,itori1,iblock)
5486 etors=etors+v1ij*cosphi+v2ij*sinphi
5487 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5491 C E = SUM ----------------------------------- - v1
5492 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5494 cosphi=dcos(0.5d0*phii)
5495 sinphi=dsin(0.5d0*phii)
5496 do j=1,nlor(itori,itori1,iblock)
5497 vl1ij=vlor1(j,itori,itori1)
5498 vl2ij=vlor2(j,itori,itori1)
5499 vl3ij=vlor3(j,itori,itori1)
5500 pom=vl2ij*cosphi+vl3ij*sinphi
5501 pom1=1.0d0/(pom*pom+1.0d0)
5502 etors=etors+vl1ij*pom1
5503 c if (energy_dec) etors_ii=etors_ii+
5506 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5508 C Subtract the constant term
5509 etors=etors-v0(itori,itori1,iblock)
5511 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5512 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5513 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5514 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5515 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5518 ! 6/20/98 - dihedral angle constraints
5521 itori=idih_constr(i)
5523 difi=pinorm(phii-phi0(i))
5525 if (difi.gt.drange(i)) then
5527 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5528 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5529 edihi=0.25d0*ftors(i)*difi**4
5530 else if (difi.lt.-drange(i)) then
5532 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5533 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5534 edihi=0.25d0*ftors(i)*difi**4
5538 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5539 & i,itori,rad2deg*phii,
5540 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5541 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5543 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5544 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5546 ! write (iout,*) 'edihcnstr',edihcnstr
5549 c----------------------------------------------------------------------------
5550 subroutine etor_d(etors_d,fact2)
5551 C 6/23/01 Compute double torsional energy
5552 implicit real*8 (a-h,o-z)
5553 include 'DIMENSIONS'
5554 include 'DIMENSIONS.ZSCOPT'
5555 include 'COMMON.VAR'
5556 include 'COMMON.GEO'
5557 include 'COMMON.LOCAL'
5558 include 'COMMON.TORSION'
5559 include 'COMMON.INTERACT'
5560 include 'COMMON.DERIV'
5561 include 'COMMON.CHAIN'
5562 include 'COMMON.NAMES'
5563 include 'COMMON.IOUNITS'
5564 include 'COMMON.FFIELD'
5565 include 'COMMON.TORCNSTR'
5567 C Set lprn=.true. for debugging
5571 do i=iphi_start,iphi_end-1
5573 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5574 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5575 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5576 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5577 & (itype(i+1).eq.ntyp1)) cycle
5578 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5580 itori=itortyp(itype(i-2))
5581 itori1=itortyp(itype(i-1))
5582 itori2=itortyp(itype(i))
5588 if (iabs(itype(i+1)).eq.20) iblock=2
5589 C Regular cosine and sine terms
5590 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5591 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5592 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5593 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5594 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5595 cosphi1=dcos(j*phii)
5596 sinphi1=dsin(j*phii)
5597 cosphi2=dcos(j*phii1)
5598 sinphi2=dsin(j*phii1)
5599 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5600 & v2cij*cosphi2+v2sij*sinphi2
5601 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5602 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5604 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5606 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5607 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5608 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5609 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5610 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5611 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5612 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5613 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5614 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5615 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5616 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5617 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5618 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5619 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5622 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5623 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5629 c------------------------------------------------------------------------------
5630 subroutine eback_sc_corr(esccor)
5631 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5632 c conformational states; temporarily implemented as differences
5633 c between UNRES torsional potentials (dependent on three types of
5634 c residues) and the torsional potentials dependent on all 20 types
5635 c of residues computed from AM1 energy surfaces of terminally-blocked
5636 c amino-acid residues.
5637 implicit real*8 (a-h,o-z)
5638 include 'DIMENSIONS'
5639 include 'DIMENSIONS.ZSCOPT'
5640 include 'DIMENSIONS.FREE'
5641 include 'COMMON.VAR'
5642 include 'COMMON.GEO'
5643 include 'COMMON.LOCAL'
5644 include 'COMMON.TORSION'
5645 include 'COMMON.SCCOR'
5646 include 'COMMON.INTERACT'
5647 include 'COMMON.DERIV'
5648 include 'COMMON.CHAIN'
5649 include 'COMMON.NAMES'
5650 include 'COMMON.IOUNITS'
5651 include 'COMMON.FFIELD'
5652 include 'COMMON.CONTROL'
5654 C Set lprn=.true. for debugging
5657 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5659 do i=itau_start,itau_end
5660 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5662 isccori=isccortyp(itype(i-2))
5663 isccori1=isccortyp(itype(i-1))
5665 do intertyp=1,3 !intertyp
5666 cc Added 09 May 2012 (Adasko)
5667 cc Intertyp means interaction type of backbone mainchain correlation:
5668 c 1 = SC...Ca...Ca...Ca
5669 c 2 = Ca...Ca...Ca...SC
5670 c 3 = SC...Ca...Ca...SCi
5672 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5673 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5674 & (itype(i-1).eq.ntyp1)))
5675 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5676 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5677 & .or.(itype(i).eq.ntyp1)))
5678 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5679 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5680 & (itype(i-3).eq.ntyp1)))) cycle
5681 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5682 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5684 do j=1,nterm_sccor(isccori,isccori1)
5685 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5686 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5687 cosphi=dcos(j*tauangle(intertyp,i))
5688 sinphi=dsin(j*tauangle(intertyp,i))
5689 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5690 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5692 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5693 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5694 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5696 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5697 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5698 & (v1sccor(j,1,itori,itori1),j=1,6)
5699 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5700 c gsccor_loc(i-3)=gloci
5705 c------------------------------------------------------------------------------
5706 subroutine multibody(ecorr)
5707 C This subroutine calculates multi-body contributions to energy following
5708 C the idea of Skolnick et al. If side chains I and J make a contact and
5709 C at the same time side chains I+1 and J+1 make a contact, an extra
5710 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5711 implicit real*8 (a-h,o-z)
5712 include 'DIMENSIONS'
5713 include 'COMMON.IOUNITS'
5714 include 'COMMON.DERIV'
5715 include 'COMMON.INTERACT'
5716 include 'COMMON.CONTACTS'
5717 double precision gx(3),gx1(3)
5720 C Set lprn=.true. for debugging
5724 write (iout,'(a)') 'Contact function values:'
5726 write (iout,'(i2,20(1x,i2,f10.5))')
5727 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5742 num_conti=num_cont(i)
5743 num_conti1=num_cont(i1)
5748 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5749 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5750 cd & ' ishift=',ishift
5751 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5752 C The system gains extra energy.
5753 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5754 endif ! j1==j+-ishift
5763 c------------------------------------------------------------------------------
5764 double precision function esccorr(i,j,k,l,jj,kk)
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'COMMON.IOUNITS'
5768 include 'COMMON.DERIV'
5769 include 'COMMON.INTERACT'
5770 include 'COMMON.CONTACTS'
5771 double precision gx(3),gx1(3)
5776 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5777 C Calculate the multi-body contribution to energy.
5778 C Calculate multi-body contributions to the gradient.
5779 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5780 cd & k,l,(gacont(m,kk,k),m=1,3)
5782 gx(m) =ekl*gacont(m,jj,i)
5783 gx1(m)=eij*gacont(m,kk,k)
5784 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5785 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5786 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5787 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5791 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5796 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5802 c------------------------------------------------------------------------------
5804 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 integer dimen1,dimen2,atom,indx
5808 double precision buffer(dimen1,dimen2)
5809 double precision zapas
5810 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5811 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5812 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5813 num_kont=num_cont_hb(atom)
5817 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5820 buffer(i,indx+22)=facont_hb(i,atom)
5821 buffer(i,indx+23)=ees0p(i,atom)
5822 buffer(i,indx+24)=ees0m(i,atom)
5823 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5825 buffer(1,indx+26)=dfloat(num_kont)
5828 c------------------------------------------------------------------------------
5829 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5830 implicit real*8 (a-h,o-z)
5831 include 'DIMENSIONS'
5832 integer dimen1,dimen2,atom,indx
5833 double precision buffer(dimen1,dimen2)
5834 double precision zapas
5835 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5836 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5837 & ees0m(ntyp,maxres),
5838 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5839 num_kont=buffer(1,indx+26)
5840 num_kont_old=num_cont_hb(atom)
5841 num_cont_hb(atom)=num_kont+num_kont_old
5846 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5849 facont_hb(ii,atom)=buffer(i,indx+22)
5850 ees0p(ii,atom)=buffer(i,indx+23)
5851 ees0m(ii,atom)=buffer(i,indx+24)
5852 jcont_hb(ii,atom)=buffer(i,indx+25)
5856 c------------------------------------------------------------------------------
5858 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5859 C This subroutine calculates multi-body contributions to hydrogen-bonding
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'DIMENSIONS.ZSCOPT'
5863 include 'COMMON.IOUNITS'
5865 include 'COMMON.INFO'
5867 include 'COMMON.FFIELD'
5868 include 'COMMON.DERIV'
5869 include 'COMMON.INTERACT'
5870 include 'COMMON.CONTACTS'
5872 parameter (max_cont=maxconts)
5873 parameter (max_dim=2*(8*3+2))
5874 parameter (msglen1=max_cont*max_dim*4)
5875 parameter (msglen2=2*msglen1)
5876 integer source,CorrelType,CorrelID,Error
5877 double precision buffer(max_cont,max_dim)
5879 double precision gx(3),gx1(3)
5882 C Set lprn=.true. for debugging
5887 if (fgProcs.le.1) goto 30
5889 write (iout,'(a)') 'Contact function values:'
5891 write (iout,'(2i3,50(1x,i2,f5.2))')
5892 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5893 & j=1,num_cont_hb(i))
5896 C Caution! Following code assumes that electrostatic interactions concerning
5897 C a given atom are split among at most two processors!
5907 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5910 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5911 if (MyRank.gt.0) then
5912 C Send correlation contributions to the preceding processor
5914 nn=num_cont_hb(iatel_s)
5915 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5916 cd write (iout,*) 'The BUFFER array:'
5918 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5920 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5922 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5923 C Clear the contacts of the atom passed to the neighboring processor
5924 nn=num_cont_hb(iatel_s+1)
5926 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5928 num_cont_hb(iatel_s)=0
5930 cd write (iout,*) 'Processor ',MyID,MyRank,
5931 cd & ' is sending correlation contribution to processor',MyID-1,
5932 cd & ' msglen=',msglen
5933 cd write (*,*) 'Processor ',MyID,MyRank,
5934 cd & ' is sending correlation contribution to processor',MyID-1,
5935 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5936 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5937 cd write (iout,*) 'Processor ',MyID,
5938 cd & ' has sent correlation contribution to processor',MyID-1,
5939 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5940 cd write (*,*) 'Processor ',MyID,
5941 cd & ' has sent correlation contribution to processor',MyID-1,
5942 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5944 endif ! (MyRank.gt.0)
5948 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5949 if (MyRank.lt.fgProcs-1) then
5950 C Receive correlation contributions from the next processor
5952 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5953 cd write (iout,*) 'Processor',MyID,
5954 cd & ' is receiving correlation contribution from processor',MyID+1,
5955 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5956 cd write (*,*) 'Processor',MyID,
5957 cd & ' is receiving correlation contribution from processor',MyID+1,
5958 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5960 do while (nbytes.le.0)
5961 call mp_probe(MyID+1,CorrelType,nbytes)
5963 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5964 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5965 cd write (iout,*) 'Processor',MyID,
5966 cd & ' has received correlation contribution from processor',MyID+1,
5967 cd & ' msglen=',msglen,' nbytes=',nbytes
5968 cd write (iout,*) 'The received BUFFER array:'
5970 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5972 if (msglen.eq.msglen1) then
5973 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5974 else if (msglen.eq.msglen2) then
5975 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5976 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5979 & 'ERROR!!!! message length changed while processing correlations.'
5981 & 'ERROR!!!! message length changed while processing correlations.'
5982 call mp_stopall(Error)
5983 endif ! msglen.eq.msglen1
5984 endif ! MyRank.lt.fgProcs-1
5991 write (iout,'(a)') 'Contact function values:'
5993 write (iout,'(2i3,50(1x,i2,f5.2))')
5994 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5995 & j=1,num_cont_hb(i))
5999 C Remove the loop below after debugging !!!
6006 C Calculate the local-electrostatic correlation terms
6007 do i=iatel_s,iatel_e+1
6009 num_conti=num_cont_hb(i)
6010 num_conti1=num_cont_hb(i+1)
6015 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6016 c & ' jj=',jj,' kk=',kk
6017 if (j1.eq.j+1 .or. j1.eq.j-1) then
6018 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6019 C The system gains extra energy.
6020 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6022 else if (j1.eq.j) then
6023 C Contacts I-J and I-(J+1) occur simultaneously.
6024 C The system loses extra energy.
6025 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6030 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6031 c & ' jj=',jj,' kk=',kk
6033 C Contacts I-J and (I+1)-J occur simultaneously.
6034 C The system loses extra energy.
6035 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6042 c------------------------------------------------------------------------------
6043 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6045 C This subroutine calculates multi-body contributions to hydrogen-bonding
6046 implicit real*8 (a-h,o-z)
6047 include 'DIMENSIONS'
6048 include 'DIMENSIONS.ZSCOPT'
6049 include 'COMMON.IOUNITS'
6051 include 'COMMON.INFO'
6053 include 'COMMON.FFIELD'
6054 include 'COMMON.DERIV'
6055 include 'COMMON.INTERACT'
6056 include 'COMMON.CONTACTS'
6058 parameter (max_cont=maxconts)
6059 parameter (max_dim=2*(8*3+2))
6060 parameter (msglen1=max_cont*max_dim*4)
6061 parameter (msglen2=2*msglen1)
6062 integer source,CorrelType,CorrelID,Error
6063 double precision buffer(max_cont,max_dim)
6065 double precision gx(3),gx1(3)
6068 C Set lprn=.true. for debugging
6075 if (fgProcs.le.1) goto 30
6077 write (iout,'(a)') 'Contact function values:'
6079 write (iout,'(2i3,50(1x,i2,f5.2))')
6080 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6081 & j=1,num_cont_hb(i))
6084 C Caution! Following code assumes that electrostatic interactions concerning
6085 C a given atom are split among at most two processors!
6095 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6098 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6099 if (MyRank.gt.0) then
6100 C Send correlation contributions to the preceding processor
6102 nn=num_cont_hb(iatel_s)
6103 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6104 cd write (iout,*) 'The BUFFER array:'
6106 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6108 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6110 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6111 C Clear the contacts of the atom passed to the neighboring processor
6112 nn=num_cont_hb(iatel_s+1)
6114 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6116 num_cont_hb(iatel_s)=0
6118 cd write (iout,*) 'Processor ',MyID,MyRank,
6119 cd & ' is sending correlation contribution to processor',MyID-1,
6120 cd & ' msglen=',msglen
6121 cd write (*,*) 'Processor ',MyID,MyRank,
6122 cd & ' is sending correlation contribution to processor',MyID-1,
6123 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6124 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6125 cd write (iout,*) 'Processor ',MyID,
6126 cd & ' has sent correlation contribution to processor',MyID-1,
6127 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6128 cd write (*,*) 'Processor ',MyID,
6129 cd & ' has sent correlation contribution to processor',MyID-1,
6130 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6132 endif ! (MyRank.gt.0)
6136 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6137 if (MyRank.lt.fgProcs-1) then
6138 C Receive correlation contributions from the next processor
6140 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6141 cd write (iout,*) 'Processor',MyID,
6142 cd & ' is receiving correlation contribution from processor',MyID+1,
6143 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6144 cd write (*,*) 'Processor',MyID,
6145 cd & ' is receiving correlation contribution from processor',MyID+1,
6146 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6148 do while (nbytes.le.0)
6149 call mp_probe(MyID+1,CorrelType,nbytes)
6151 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6152 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6153 cd write (iout,*) 'Processor',MyID,
6154 cd & ' has received correlation contribution from processor',MyID+1,
6155 cd & ' msglen=',msglen,' nbytes=',nbytes
6156 cd write (iout,*) 'The received BUFFER array:'
6158 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6160 if (msglen.eq.msglen1) then
6161 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6162 else if (msglen.eq.msglen2) then
6163 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6164 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6167 & 'ERROR!!!! message length changed while processing correlations.'
6169 & 'ERROR!!!! message length changed while processing correlations.'
6170 call mp_stopall(Error)
6171 endif ! msglen.eq.msglen1
6172 endif ! MyRank.lt.fgProcs-1
6179 write (iout,'(a)') 'Contact function values:'
6181 write (iout,'(2i3,50(1x,i2,f5.2))')
6182 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6183 & j=1,num_cont_hb(i))
6189 C Remove the loop below after debugging !!!
6196 C Calculate the dipole-dipole interaction energies
6197 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6198 do i=iatel_s,iatel_e+1
6199 num_conti=num_cont_hb(i)
6206 C Calculate the local-electrostatic correlation terms
6207 do i=iatel_s,iatel_e+1
6209 num_conti=num_cont_hb(i)
6210 num_conti1=num_cont_hb(i+1)
6215 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6216 c & ' jj=',jj,' kk=',kk
6217 if (j1.eq.j+1 .or. j1.eq.j-1) then
6218 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6219 C The system gains extra energy.
6221 sqd1=dsqrt(d_cont(jj,i))
6222 sqd2=dsqrt(d_cont(kk,i1))
6223 sred_geom = sqd1*sqd2
6224 IF (sred_geom.lt.cutoff_corr) THEN
6225 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6227 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6228 c & ' jj=',jj,' kk=',kk
6229 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6230 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6232 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6233 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6236 cd write (iout,*) 'sred_geom=',sred_geom,
6237 cd & ' ekont=',ekont,' fprim=',fprimcont
6238 call calc_eello(i,j,i+1,j1,jj,kk)
6239 if (wcorr4.gt.0.0d0)
6240 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6241 if (wcorr5.gt.0.0d0)
6242 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6243 c print *,"wcorr5",ecorr5
6244 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6245 cd write(2,*)'ijkl',i,j,i+1,j1
6246 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6247 & .or. wturn6.eq.0.0d0))then
6248 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6249 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6250 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6251 cd & 'ecorr6=',ecorr6
6252 cd write (iout,'(4e15.5)') sred_geom,
6253 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6254 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6255 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6256 else if (wturn6.gt.0.0d0
6257 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6258 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6259 eturn6=eturn6+eello_turn6(i,jj,kk)
6260 cd write (2,*) 'multibody_eello:eturn6',eturn6
6261 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6268 else if (j1.eq.j) then
6269 C Contacts I-J and I-(J+1) occur simultaneously.
6270 C The system loses extra energy.
6271 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6276 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6277 c & ' jj=',jj,' kk=',kk
6279 C Contacts I-J and (I+1)-J occur simultaneously.
6280 C The system loses extra energy.
6281 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6286 write (iout,*) "eturn6",eturn6,ecorr6
6289 c------------------------------------------------------------------------------
6290 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6291 implicit real*8 (a-h,o-z)
6292 include 'DIMENSIONS'
6293 include 'COMMON.IOUNITS'
6294 include 'COMMON.DERIV'
6295 include 'COMMON.INTERACT'
6296 include 'COMMON.CONTACTS'
6297 double precision gx(3),gx1(3)
6307 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6308 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6309 C Following 4 lines for diagnostics.
6314 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6316 c write (iout,*)'Contacts have occurred for peptide groups',
6317 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6318 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6319 C Calculate the multi-body contribution to energy.
6320 ecorr=ecorr+ekont*ees
6322 C Calculate multi-body contributions to the gradient.
6324 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6325 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6326 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6327 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6328 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6329 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6330 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6331 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6332 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6333 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6334 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6335 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6336 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6337 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6341 gradcorr(ll,m)=gradcorr(ll,m)+
6342 & ees*ekl*gacont_hbr(ll,jj,i)-
6343 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6344 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6349 gradcorr(ll,m)=gradcorr(ll,m)+
6350 & ees*eij*gacont_hbr(ll,kk,k)-
6351 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6352 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6359 C---------------------------------------------------------------------------
6360 subroutine dipole(i,j,jj)
6361 implicit real*8 (a-h,o-z)
6362 include 'DIMENSIONS'
6363 include 'DIMENSIONS.ZSCOPT'
6364 include 'COMMON.IOUNITS'
6365 include 'COMMON.CHAIN'
6366 include 'COMMON.FFIELD'
6367 include 'COMMON.DERIV'
6368 include 'COMMON.INTERACT'
6369 include 'COMMON.CONTACTS'
6370 include 'COMMON.TORSION'
6371 include 'COMMON.VAR'
6372 include 'COMMON.GEO'
6373 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6375 iti1 = itortyp(itype(i+1))
6376 if (j.lt.nres-1) then
6377 if (itype(j).le.ntyp) then
6378 itj1 = itortyp(itype(j+1))
6386 dipi(iii,1)=Ub2(iii,i)
6387 dipderi(iii)=Ub2der(iii,i)
6388 dipi(iii,2)=b1(iii,iti1)
6389 dipj(iii,1)=Ub2(iii,j)
6390 dipderj(iii)=Ub2der(iii,j)
6391 dipj(iii,2)=b1(iii,itj1)
6395 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6398 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6401 if (.not.calc_grad) return
6406 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6410 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6415 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6416 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6418 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6420 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6422 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6426 C---------------------------------------------------------------------------
6427 subroutine calc_eello(i,j,k,l,jj,kk)
6429 C This subroutine computes matrices and vectors needed to calculate
6430 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6432 implicit real*8 (a-h,o-z)
6433 include 'DIMENSIONS'
6434 include 'DIMENSIONS.ZSCOPT'
6435 include 'COMMON.IOUNITS'
6436 include 'COMMON.CHAIN'
6437 include 'COMMON.DERIV'
6438 include 'COMMON.INTERACT'
6439 include 'COMMON.CONTACTS'
6440 include 'COMMON.TORSION'
6441 include 'COMMON.VAR'
6442 include 'COMMON.GEO'
6443 include 'COMMON.FFIELD'
6444 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6445 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6448 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6449 cd & ' jj=',jj,' kk=',kk
6450 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6453 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6454 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6457 call transpose2(aa1(1,1),aa1t(1,1))
6458 call transpose2(aa2(1,1),aa2t(1,1))
6461 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6462 & aa1tder(1,1,lll,kkk))
6463 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6464 & aa2tder(1,1,lll,kkk))
6468 C parallel orientation of the two CA-CA-CA frames.
6469 if (i.gt.1 .and. itype(i).le.ntyp) then
6470 iti=itortyp(itype(i))
6474 itk1=itortyp(itype(k+1))
6475 itj=itortyp(itype(j))
6476 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6477 itl1=itortyp(itype(l+1))
6481 C A1 kernel(j+1) A2T
6483 cd write (iout,'(3f10.5,5x,3f10.5)')
6484 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6486 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6487 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6488 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6489 C Following matrices are needed only for 6-th order cumulants
6490 IF (wcorr6.gt.0.0d0) THEN
6491 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6492 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6493 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6494 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6495 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6496 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6497 & ADtEAderx(1,1,1,1,1,1))
6499 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6500 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6501 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6502 & ADtEA1derx(1,1,1,1,1,1))
6504 C End 6-th order cumulants
6507 cd write (2,*) 'In calc_eello6'
6509 cd write (2,*) 'iii=',iii
6511 cd write (2,*) 'kkk=',kkk
6513 cd write (2,'(3(2f10.5),5x)')
6514 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6519 call transpose2(EUgder(1,1,k),auxmat(1,1))
6520 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6521 call transpose2(EUg(1,1,k),auxmat(1,1))
6522 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6523 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6527 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6528 & EAEAderx(1,1,lll,kkk,iii,1))
6532 C A1T kernel(i+1) A2
6533 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6534 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6535 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6536 C Following matrices are needed only for 6-th order cumulants
6537 IF (wcorr6.gt.0.0d0) THEN
6538 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6539 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6540 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6541 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6542 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6543 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6544 & ADtEAderx(1,1,1,1,1,2))
6545 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6546 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6547 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6548 & ADtEA1derx(1,1,1,1,1,2))
6550 C End 6-th order cumulants
6551 call transpose2(EUgder(1,1,l),auxmat(1,1))
6552 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6553 call transpose2(EUg(1,1,l),auxmat(1,1))
6554 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6555 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6559 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6560 & EAEAderx(1,1,lll,kkk,iii,2))
6565 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6566 C They are needed only when the fifth- or the sixth-order cumulants are
6568 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6569 call transpose2(AEA(1,1,1),auxmat(1,1))
6570 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6571 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6572 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6573 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6574 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6575 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6576 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6577 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6578 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6579 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6580 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6581 call transpose2(AEA(1,1,2),auxmat(1,1))
6582 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6583 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6584 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6585 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6586 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6587 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6588 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6589 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6590 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6591 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6592 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6593 C Calculate the Cartesian derivatives of the vectors.
6597 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6598 call matvec2(auxmat(1,1),b1(1,iti),
6599 & AEAb1derx(1,lll,kkk,iii,1,1))
6600 call matvec2(auxmat(1,1),Ub2(1,i),
6601 & AEAb2derx(1,lll,kkk,iii,1,1))
6602 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6603 & AEAb1derx(1,lll,kkk,iii,2,1))
6604 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6605 & AEAb2derx(1,lll,kkk,iii,2,1))
6606 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6607 call matvec2(auxmat(1,1),b1(1,itj),
6608 & AEAb1derx(1,lll,kkk,iii,1,2))
6609 call matvec2(auxmat(1,1),Ub2(1,j),
6610 & AEAb2derx(1,lll,kkk,iii,1,2))
6611 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6612 & AEAb1derx(1,lll,kkk,iii,2,2))
6613 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6614 & AEAb2derx(1,lll,kkk,iii,2,2))
6621 C Antiparallel orientation of the two CA-CA-CA frames.
6622 if (i.gt.1 .and. itype(i).le.ntyp) then
6623 iti=itortyp(itype(i))
6627 itk1=itortyp(itype(k+1))
6628 itl=itortyp(itype(l))
6629 itj=itortyp(itype(j))
6630 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6631 itj1=itortyp(itype(j+1))
6635 C A2 kernel(j-1)T A1T
6636 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6637 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6638 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6639 C Following matrices are needed only for 6-th order cumulants
6640 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6641 & j.eq.i+4 .and. l.eq.i+3)) THEN
6642 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6643 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6644 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6645 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6646 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6647 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6648 & ADtEAderx(1,1,1,1,1,1))
6649 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6650 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6651 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6652 & ADtEA1derx(1,1,1,1,1,1))
6654 C End 6-th order cumulants
6655 call transpose2(EUgder(1,1,k),auxmat(1,1))
6656 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6657 call transpose2(EUg(1,1,k),auxmat(1,1))
6658 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6659 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6663 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6664 & EAEAderx(1,1,lll,kkk,iii,1))
6668 C A2T kernel(i+1)T A1
6669 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6670 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6671 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6672 C Following matrices are needed only for 6-th order cumulants
6673 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6674 & j.eq.i+4 .and. l.eq.i+3)) THEN
6675 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6676 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6677 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6678 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6679 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6680 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6681 & ADtEAderx(1,1,1,1,1,2))
6682 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6683 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6684 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6685 & ADtEA1derx(1,1,1,1,1,2))
6687 C End 6-th order cumulants
6688 call transpose2(EUgder(1,1,j),auxmat(1,1))
6689 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6690 call transpose2(EUg(1,1,j),auxmat(1,1))
6691 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6692 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6696 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6697 & EAEAderx(1,1,lll,kkk,iii,2))
6702 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6703 C They are needed only when the fifth- or the sixth-order cumulants are
6705 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6706 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6707 call transpose2(AEA(1,1,1),auxmat(1,1))
6708 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6709 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6710 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6711 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6712 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6713 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6714 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6715 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6716 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6717 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6718 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6719 call transpose2(AEA(1,1,2),auxmat(1,1))
6720 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6721 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6722 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6723 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6724 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6725 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6726 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6727 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6728 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6729 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6730 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6731 C Calculate the Cartesian derivatives of the vectors.
6735 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6736 call matvec2(auxmat(1,1),b1(1,iti),
6737 & AEAb1derx(1,lll,kkk,iii,1,1))
6738 call matvec2(auxmat(1,1),Ub2(1,i),
6739 & AEAb2derx(1,lll,kkk,iii,1,1))
6740 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6741 & AEAb1derx(1,lll,kkk,iii,2,1))
6742 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6743 & AEAb2derx(1,lll,kkk,iii,2,1))
6744 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6745 call matvec2(auxmat(1,1),b1(1,itl),
6746 & AEAb1derx(1,lll,kkk,iii,1,2))
6747 call matvec2(auxmat(1,1),Ub2(1,l),
6748 & AEAb2derx(1,lll,kkk,iii,1,2))
6749 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6750 & AEAb1derx(1,lll,kkk,iii,2,2))
6751 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6752 & AEAb2derx(1,lll,kkk,iii,2,2))
6761 C---------------------------------------------------------------------------
6762 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6763 & KK,KKderg,AKA,AKAderg,AKAderx)
6767 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6768 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6769 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6774 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6776 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6779 cd if (lprn) write (2,*) 'In kernel'
6781 cd if (lprn) write (2,*) 'kkk=',kkk
6783 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6784 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6786 cd write (2,*) 'lll=',lll
6787 cd write (2,*) 'iii=1'
6789 cd write (2,'(3(2f10.5),5x)')
6790 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6793 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6794 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6796 cd write (2,*) 'lll=',lll
6797 cd write (2,*) 'iii=2'
6799 cd write (2,'(3(2f10.5),5x)')
6800 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6807 C---------------------------------------------------------------------------
6808 double precision function eello4(i,j,k,l,jj,kk)
6809 implicit real*8 (a-h,o-z)
6810 include 'DIMENSIONS'
6811 include 'DIMENSIONS.ZSCOPT'
6812 include 'COMMON.IOUNITS'
6813 include 'COMMON.CHAIN'
6814 include 'COMMON.DERIV'
6815 include 'COMMON.INTERACT'
6816 include 'COMMON.CONTACTS'
6817 include 'COMMON.TORSION'
6818 include 'COMMON.VAR'
6819 include 'COMMON.GEO'
6820 double precision pizda(2,2),ggg1(3),ggg2(3)
6821 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6825 cd print *,'eello4:',i,j,k,l,jj,kk
6826 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6827 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6828 cold eij=facont_hb(jj,i)
6829 cold ekl=facont_hb(kk,k)
6831 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6833 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6834 gcorr_loc(k-1)=gcorr_loc(k-1)
6835 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6837 gcorr_loc(l-1)=gcorr_loc(l-1)
6838 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6840 gcorr_loc(j-1)=gcorr_loc(j-1)
6841 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6846 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6847 & -EAEAderx(2,2,lll,kkk,iii,1)
6848 cd derx(lll,kkk,iii)=0.0d0
6852 cd gcorr_loc(l-1)=0.0d0
6853 cd gcorr_loc(j-1)=0.0d0
6854 cd gcorr_loc(k-1)=0.0d0
6856 cd write (iout,*)'Contacts have occurred for peptide groups',
6857 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6858 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6859 if (j.lt.nres-1) then
6866 if (l.lt.nres-1) then
6874 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6875 ggg1(ll)=eel4*g_contij(ll,1)
6876 ggg2(ll)=eel4*g_contij(ll,2)
6877 ghalf=0.5d0*ggg1(ll)
6879 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6880 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6881 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6882 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6883 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6884 ghalf=0.5d0*ggg2(ll)
6886 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6887 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6888 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6889 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6894 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6895 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6900 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6901 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6907 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6912 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6916 cd write (2,*) iii,gcorr_loc(iii)
6920 cd write (2,*) 'ekont',ekont
6921 cd write (iout,*) 'eello4',ekont*eel4
6924 C---------------------------------------------------------------------------
6925 double precision function eello5(i,j,k,l,jj,kk)
6926 implicit real*8 (a-h,o-z)
6927 include 'DIMENSIONS'
6928 include 'DIMENSIONS.ZSCOPT'
6929 include 'COMMON.IOUNITS'
6930 include 'COMMON.CHAIN'
6931 include 'COMMON.DERIV'
6932 include 'COMMON.INTERACT'
6933 include 'COMMON.CONTACTS'
6934 include 'COMMON.TORSION'
6935 include 'COMMON.VAR'
6936 include 'COMMON.GEO'
6937 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6938 double precision ggg1(3),ggg2(3)
6939 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6944 C /l\ / \ \ / \ / \ / C
6945 C / \ / \ \ / \ / \ / C
6946 C j| o |l1 | o | o| o | | o |o C
6947 C \ |/k\| |/ \| / |/ \| |/ \| C
6948 C \i/ \ / \ / / \ / \ C
6950 C (I) (II) (III) (IV) C
6952 C eello5_1 eello5_2 eello5_3 eello5_4 C
6954 C Antiparallel chains C
6957 C /j\ / \ \ / \ / \ / C
6958 C / \ / \ \ / \ / \ / C
6959 C j1| o |l | o | o| o | | o |o C
6960 C \ |/k\| |/ \| / |/ \| |/ \| C
6961 C \i/ \ / \ / / \ / \ C
6963 C (I) (II) (III) (IV) C
6965 C eello5_1 eello5_2 eello5_3 eello5_4 C
6967 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6969 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6970 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6975 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6977 itk=itortyp(itype(k))
6978 itl=itortyp(itype(l))
6979 itj=itortyp(itype(j))
6984 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6985 cd & eel5_3_num,eel5_4_num)
6989 derx(lll,kkk,iii)=0.0d0
6993 cd eij=facont_hb(jj,i)
6994 cd ekl=facont_hb(kk,k)
6996 cd write (iout,*)'Contacts have occurred for peptide groups',
6997 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6999 C Contribution from the graph I.
7000 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7001 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7002 call transpose2(EUg(1,1,k),auxmat(1,1))
7003 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7004 vv(1)=pizda(1,1)-pizda(2,2)
7005 vv(2)=pizda(1,2)+pizda(2,1)
7006 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7007 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7009 C Explicit gradient in virtual-dihedral angles.
7010 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7011 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7012 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7013 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7014 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7015 vv(1)=pizda(1,1)-pizda(2,2)
7016 vv(2)=pizda(1,2)+pizda(2,1)
7017 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7018 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7019 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7020 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7021 vv(1)=pizda(1,1)-pizda(2,2)
7022 vv(2)=pizda(1,2)+pizda(2,1)
7024 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7025 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7026 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7028 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7029 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7030 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7032 C Cartesian gradient
7036 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7038 vv(1)=pizda(1,1)-pizda(2,2)
7039 vv(2)=pizda(1,2)+pizda(2,1)
7040 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7041 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7042 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7049 C Contribution from graph II
7050 call transpose2(EE(1,1,itk),auxmat(1,1))
7051 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7052 vv(1)=pizda(1,1)+pizda(2,2)
7053 vv(2)=pizda(2,1)-pizda(1,2)
7054 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7055 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7057 C Explicit gradient in virtual-dihedral angles.
7058 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7059 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7060 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7061 vv(1)=pizda(1,1)+pizda(2,2)
7062 vv(2)=pizda(2,1)-pizda(1,2)
7064 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7065 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7066 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7068 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7069 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7070 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7072 C Cartesian gradient
7076 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7078 vv(1)=pizda(1,1)+pizda(2,2)
7079 vv(2)=pizda(2,1)-pizda(1,2)
7080 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7081 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7082 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7091 C Parallel orientation
7092 C Contribution from graph III
7093 call transpose2(EUg(1,1,l),auxmat(1,1))
7094 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7095 vv(1)=pizda(1,1)-pizda(2,2)
7096 vv(2)=pizda(1,2)+pizda(2,1)
7097 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7098 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7100 C Explicit gradient in virtual-dihedral angles.
7101 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7102 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7103 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7104 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7105 vv(1)=pizda(1,1)-pizda(2,2)
7106 vv(2)=pizda(1,2)+pizda(2,1)
7107 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7108 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7109 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7110 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7111 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7112 vv(1)=pizda(1,1)-pizda(2,2)
7113 vv(2)=pizda(1,2)+pizda(2,1)
7114 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7115 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7116 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7117 C Cartesian gradient
7121 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7123 vv(1)=pizda(1,1)-pizda(2,2)
7124 vv(2)=pizda(1,2)+pizda(2,1)
7125 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7126 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7127 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7133 C Contribution from graph IV
7135 call transpose2(EE(1,1,itl),auxmat(1,1))
7136 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7137 vv(1)=pizda(1,1)+pizda(2,2)
7138 vv(2)=pizda(2,1)-pizda(1,2)
7139 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7140 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7142 C Explicit gradient in virtual-dihedral angles.
7143 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7144 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7145 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7146 vv(1)=pizda(1,1)+pizda(2,2)
7147 vv(2)=pizda(2,1)-pizda(1,2)
7148 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7149 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7150 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7151 C Cartesian gradient
7155 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7157 vv(1)=pizda(1,1)+pizda(2,2)
7158 vv(2)=pizda(2,1)-pizda(1,2)
7159 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7160 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7161 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7167 C Antiparallel orientation
7168 C Contribution from graph III
7170 call transpose2(EUg(1,1,j),auxmat(1,1))
7171 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7172 vv(1)=pizda(1,1)-pizda(2,2)
7173 vv(2)=pizda(1,2)+pizda(2,1)
7174 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7175 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7177 C Explicit gradient in virtual-dihedral angles.
7178 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7179 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7180 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7181 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7182 vv(1)=pizda(1,1)-pizda(2,2)
7183 vv(2)=pizda(1,2)+pizda(2,1)
7184 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7185 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7186 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7187 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7188 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7189 vv(1)=pizda(1,1)-pizda(2,2)
7190 vv(2)=pizda(1,2)+pizda(2,1)
7191 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7192 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7193 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7194 C Cartesian gradient
7198 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7200 vv(1)=pizda(1,1)-pizda(2,2)
7201 vv(2)=pizda(1,2)+pizda(2,1)
7202 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7203 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7204 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7210 C Contribution from graph IV
7212 call transpose2(EE(1,1,itj),auxmat(1,1))
7213 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7214 vv(1)=pizda(1,1)+pizda(2,2)
7215 vv(2)=pizda(2,1)-pizda(1,2)
7216 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7217 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7219 C Explicit gradient in virtual-dihedral angles.
7220 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7221 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7222 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7223 vv(1)=pizda(1,1)+pizda(2,2)
7224 vv(2)=pizda(2,1)-pizda(1,2)
7225 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7226 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7227 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7228 C Cartesian gradient
7232 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7234 vv(1)=pizda(1,1)+pizda(2,2)
7235 vv(2)=pizda(2,1)-pizda(1,2)
7236 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7237 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7238 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7245 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7246 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7247 cd write (2,*) 'ijkl',i,j,k,l
7248 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7249 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7251 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7252 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7253 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7254 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7256 if (j.lt.nres-1) then
7263 if (l.lt.nres-1) then
7273 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7275 ggg1(ll)=eel5*g_contij(ll,1)
7276 ggg2(ll)=eel5*g_contij(ll,2)
7277 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7278 ghalf=0.5d0*ggg1(ll)
7280 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7281 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7282 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7283 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7284 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7285 ghalf=0.5d0*ggg2(ll)
7287 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7288 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7289 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7290 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7295 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7296 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7301 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7302 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7308 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7313 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7317 cd write (2,*) iii,g_corr5_loc(iii)
7321 cd write (2,*) 'ekont',ekont
7322 cd write (iout,*) 'eello5',ekont*eel5
7325 c--------------------------------------------------------------------------
7326 double precision function eello6(i,j,k,l,jj,kk)
7327 implicit real*8 (a-h,o-z)
7328 include 'DIMENSIONS'
7329 include 'DIMENSIONS.ZSCOPT'
7330 include 'COMMON.IOUNITS'
7331 include 'COMMON.CHAIN'
7332 include 'COMMON.DERIV'
7333 include 'COMMON.INTERACT'
7334 include 'COMMON.CONTACTS'
7335 include 'COMMON.TORSION'
7336 include 'COMMON.VAR'
7337 include 'COMMON.GEO'
7338 include 'COMMON.FFIELD'
7339 double precision ggg1(3),ggg2(3)
7340 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7345 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7353 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7354 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7358 derx(lll,kkk,iii)=0.0d0
7362 cd eij=facont_hb(jj,i)
7363 cd ekl=facont_hb(kk,k)
7369 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7370 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7371 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7372 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7373 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7374 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7376 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7377 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7378 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7379 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7380 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7381 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7385 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7387 C If turn contributions are considered, they will be handled separately.
7388 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7389 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7390 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7391 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7392 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7393 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7394 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7397 if (j.lt.nres-1) then
7404 if (l.lt.nres-1) then
7412 ggg1(ll)=eel6*g_contij(ll,1)
7413 ggg2(ll)=eel6*g_contij(ll,2)
7414 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7415 ghalf=0.5d0*ggg1(ll)
7417 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7418 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7419 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7420 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7421 ghalf=0.5d0*ggg2(ll)
7422 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7424 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7425 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7426 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7427 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7432 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7433 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7438 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7439 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7445 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7450 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7454 cd write (2,*) iii,g_corr6_loc(iii)
7458 cd write (2,*) 'ekont',ekont
7459 cd write (iout,*) 'eello6',ekont*eel6
7462 c--------------------------------------------------------------------------
7463 double precision function eello6_graph1(i,j,k,l,imat,swap)
7464 implicit real*8 (a-h,o-z)
7465 include 'DIMENSIONS'
7466 include 'DIMENSIONS.ZSCOPT'
7467 include 'COMMON.IOUNITS'
7468 include 'COMMON.CHAIN'
7469 include 'COMMON.DERIV'
7470 include 'COMMON.INTERACT'
7471 include 'COMMON.CONTACTS'
7472 include 'COMMON.TORSION'
7473 include 'COMMON.VAR'
7474 include 'COMMON.GEO'
7475 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7479 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7481 C Parallel Antiparallel C
7487 C \ j|/k\| / \ |/k\|l / C
7492 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7493 itk=itortyp(itype(k))
7494 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7495 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7496 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7497 call transpose2(EUgC(1,1,k),auxmat(1,1))
7498 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7499 vv1(1)=pizda1(1,1)-pizda1(2,2)
7500 vv1(2)=pizda1(1,2)+pizda1(2,1)
7501 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7502 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7503 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7504 s5=scalar2(vv(1),Dtobr2(1,i))
7505 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7506 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7507 if (.not. calc_grad) return
7508 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7509 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7510 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7511 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7512 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7513 & +scalar2(vv(1),Dtobr2der(1,i)))
7514 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7515 vv1(1)=pizda1(1,1)-pizda1(2,2)
7516 vv1(2)=pizda1(1,2)+pizda1(2,1)
7517 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7518 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7520 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7521 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7522 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7523 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7524 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7526 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7527 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7528 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7529 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7530 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7532 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7533 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7534 vv1(1)=pizda1(1,1)-pizda1(2,2)
7535 vv1(2)=pizda1(1,2)+pizda1(2,1)
7536 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7537 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7538 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7539 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7548 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7549 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7550 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7551 call transpose2(EUgC(1,1,k),auxmat(1,1))
7552 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7554 vv1(1)=pizda1(1,1)-pizda1(2,2)
7555 vv1(2)=pizda1(1,2)+pizda1(2,1)
7556 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7557 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7558 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7559 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7560 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7561 s5=scalar2(vv(1),Dtobr2(1,i))
7562 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7568 c----------------------------------------------------------------------------
7569 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7570 implicit real*8 (a-h,o-z)
7571 include 'DIMENSIONS'
7572 include 'DIMENSIONS.ZSCOPT'
7573 include 'COMMON.IOUNITS'
7574 include 'COMMON.CHAIN'
7575 include 'COMMON.DERIV'
7576 include 'COMMON.INTERACT'
7577 include 'COMMON.CONTACTS'
7578 include 'COMMON.TORSION'
7579 include 'COMMON.VAR'
7580 include 'COMMON.GEO'
7582 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7583 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7588 C Parallel Antiparallel C
7594 C \ j|/k\| \ |/k\|l C
7599 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7600 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7601 C AL 7/4/01 s1 would occur in the sixth-order moment,
7602 C but not in a cluster cumulant
7604 s1=dip(1,jj,i)*dip(1,kk,k)
7606 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7607 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7608 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7609 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7610 call transpose2(EUg(1,1,k),auxmat(1,1))
7611 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7612 vv(1)=pizda(1,1)-pizda(2,2)
7613 vv(2)=pizda(1,2)+pizda(2,1)
7614 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7615 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7617 eello6_graph2=-(s1+s2+s3+s4)
7619 eello6_graph2=-(s2+s3+s4)
7622 if (.not. calc_grad) return
7623 C Derivatives in gamma(i-1)
7626 s1=dipderg(1,jj,i)*dip(1,kk,k)
7628 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7629 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7630 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7631 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7633 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7635 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7637 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7639 C Derivatives in gamma(k-1)
7641 s1=dip(1,jj,i)*dipderg(1,kk,k)
7643 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7644 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7645 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7646 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7647 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7648 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7651 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7653 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7655 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7657 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7658 C Derivatives in gamma(j-1) or gamma(l-1)
7661 s1=dipderg(3,jj,i)*dip(1,kk,k)
7663 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7664 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7665 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7666 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7667 vv(1)=pizda(1,1)-pizda(2,2)
7668 vv(2)=pizda(1,2)+pizda(2,1)
7669 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7672 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7674 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7677 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7678 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7680 C Derivatives in gamma(l-1) or gamma(j-1)
7683 s1=dip(1,jj,i)*dipderg(3,kk,k)
7685 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7686 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7687 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7688 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7689 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7690 vv(1)=pizda(1,1)-pizda(2,2)
7691 vv(2)=pizda(1,2)+pizda(2,1)
7692 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7695 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7697 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7700 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7701 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7703 C Cartesian derivatives.
7705 write (2,*) 'In eello6_graph2'
7707 write (2,*) 'iii=',iii
7709 write (2,*) 'kkk=',kkk
7711 write (2,'(3(2f10.5),5x)')
7712 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7722 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7724 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7727 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7729 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7730 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7732 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7733 call transpose2(EUg(1,1,k),auxmat(1,1))
7734 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7736 vv(1)=pizda(1,1)-pizda(2,2)
7737 vv(2)=pizda(1,2)+pizda(2,1)
7738 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7739 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7741 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7743 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7746 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7748 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7755 c----------------------------------------------------------------------------
7756 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7757 implicit real*8 (a-h,o-z)
7758 include 'DIMENSIONS'
7759 include 'DIMENSIONS.ZSCOPT'
7760 include 'COMMON.IOUNITS'
7761 include 'COMMON.CHAIN'
7762 include 'COMMON.DERIV'
7763 include 'COMMON.INTERACT'
7764 include 'COMMON.CONTACTS'
7765 include 'COMMON.TORSION'
7766 include 'COMMON.VAR'
7767 include 'COMMON.GEO'
7768 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7770 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7772 C Parallel Antiparallel C
7778 C j|/k\| / |/k\|l / C
7783 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7785 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7786 C energy moment and not to the cluster cumulant.
7787 iti=itortyp(itype(i))
7788 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7789 itj1=itortyp(itype(j+1))
7793 itk=itortyp(itype(k))
7794 itk1=itortyp(itype(k+1))
7795 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7796 itl1=itortyp(itype(l+1))
7801 s1=dip(4,jj,i)*dip(4,kk,k)
7803 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7804 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7805 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7806 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7807 call transpose2(EE(1,1,itk),auxmat(1,1))
7808 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7809 vv(1)=pizda(1,1)+pizda(2,2)
7810 vv(2)=pizda(2,1)-pizda(1,2)
7811 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7812 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7814 eello6_graph3=-(s1+s2+s3+s4)
7816 eello6_graph3=-(s2+s3+s4)
7819 if (.not. calc_grad) return
7820 C Derivatives in gamma(k-1)
7821 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7822 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7823 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7824 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7825 C Derivatives in gamma(l-1)
7826 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7827 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7828 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7829 vv(1)=pizda(1,1)+pizda(2,2)
7830 vv(2)=pizda(2,1)-pizda(1,2)
7831 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7832 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7833 C Cartesian derivatives.
7839 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7841 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7844 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7846 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7847 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7849 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7850 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7852 vv(1)=pizda(1,1)+pizda(2,2)
7853 vv(2)=pizda(2,1)-pizda(1,2)
7854 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7856 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7858 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7861 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7863 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7865 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7871 c----------------------------------------------------------------------------
7872 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7873 implicit real*8 (a-h,o-z)
7874 include 'DIMENSIONS'
7875 include 'DIMENSIONS.ZSCOPT'
7876 include 'COMMON.IOUNITS'
7877 include 'COMMON.CHAIN'
7878 include 'COMMON.DERIV'
7879 include 'COMMON.INTERACT'
7880 include 'COMMON.CONTACTS'
7881 include 'COMMON.TORSION'
7882 include 'COMMON.VAR'
7883 include 'COMMON.GEO'
7884 include 'COMMON.FFIELD'
7885 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7886 & auxvec1(2),auxmat1(2,2)
7888 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7890 C Parallel Antiparallel C
7896 C \ j|/k\| \ |/k\|l C
7901 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7903 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7904 C energy moment and not to the cluster cumulant.
7905 cd write (2,*) 'eello_graph4: wturn6',wturn6
7906 iti=itortyp(itype(i))
7907 itj=itortyp(itype(j))
7908 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7909 itj1=itortyp(itype(j+1))
7913 itk=itortyp(itype(k))
7914 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7915 itk1=itortyp(itype(k+1))
7919 itl=itortyp(itype(l))
7920 if (l.lt.nres-1) then
7921 itl1=itortyp(itype(l+1))
7925 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7926 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7927 cd & ' itl',itl,' itl1',itl1
7930 s1=dip(3,jj,i)*dip(3,kk,k)
7932 s1=dip(2,jj,j)*dip(2,kk,l)
7935 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7936 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7938 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7939 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7941 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7942 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7944 call transpose2(EUg(1,1,k),auxmat(1,1))
7945 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7946 vv(1)=pizda(1,1)-pizda(2,2)
7947 vv(2)=pizda(2,1)+pizda(1,2)
7948 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7949 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7951 eello6_graph4=-(s1+s2+s3+s4)
7953 eello6_graph4=-(s2+s3+s4)
7955 if (.not. calc_grad) return
7956 C Derivatives in gamma(i-1)
7960 s1=dipderg(2,jj,i)*dip(3,kk,k)
7962 s1=dipderg(4,jj,j)*dip(2,kk,l)
7965 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7967 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7968 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7970 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7971 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7973 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7974 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7975 cd write (2,*) 'turn6 derivatives'
7977 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7979 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7983 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7985 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7989 C Derivatives in gamma(k-1)
7992 s1=dip(3,jj,i)*dipderg(2,kk,k)
7994 s1=dip(2,jj,j)*dipderg(4,kk,l)
7997 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7998 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8000 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8001 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8003 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8004 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8006 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8007 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8008 vv(1)=pizda(1,1)-pizda(2,2)
8009 vv(2)=pizda(2,1)+pizda(1,2)
8010 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8011 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8013 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8015 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8019 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8021 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8024 C Derivatives in gamma(j-1) or gamma(l-1)
8025 if (l.eq.j+1 .and. l.gt.1) then
8026 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8027 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8028 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8029 vv(1)=pizda(1,1)-pizda(2,2)
8030 vv(2)=pizda(2,1)+pizda(1,2)
8031 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8032 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8033 else if (j.gt.1) then
8034 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8035 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8036 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8037 vv(1)=pizda(1,1)-pizda(2,2)
8038 vv(2)=pizda(2,1)+pizda(1,2)
8039 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8040 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8041 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8043 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8046 C Cartesian derivatives.
8053 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8055 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8059 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8061 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8065 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8067 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8069 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8070 & b1(1,itj1),auxvec(1))
8071 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8073 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8074 & b1(1,itl1),auxvec(1))
8075 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8077 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8079 vv(1)=pizda(1,1)-pizda(2,2)
8080 vv(2)=pizda(2,1)+pizda(1,2)
8081 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8083 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8085 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8088 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8091 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8094 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8096 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8098 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8102 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8104 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8107 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8109 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8117 c----------------------------------------------------------------------------
8118 double precision function eello_turn6(i,jj,kk)
8119 implicit real*8 (a-h,o-z)
8120 include 'DIMENSIONS'
8121 include 'DIMENSIONS.ZSCOPT'
8122 include 'COMMON.IOUNITS'
8123 include 'COMMON.CHAIN'
8124 include 'COMMON.DERIV'
8125 include 'COMMON.INTERACT'
8126 include 'COMMON.CONTACTS'
8127 include 'COMMON.TORSION'
8128 include 'COMMON.VAR'
8129 include 'COMMON.GEO'
8130 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8131 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8133 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8134 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8135 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8136 C the respective energy moment and not to the cluster cumulant.
8141 iti=itortyp(itype(i))
8142 itk=itortyp(itype(k))
8143 itk1=itortyp(itype(k+1))
8144 itl=itortyp(itype(l))
8145 itj=itortyp(itype(j))
8146 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8147 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8148 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8153 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8155 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8159 derx_turn(lll,kkk,iii)=0.0d0
8166 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8168 cd write (2,*) 'eello6_5',eello6_5
8170 call transpose2(AEA(1,1,1),auxmat(1,1))
8171 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8172 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8173 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8177 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8178 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8179 s2 = scalar2(b1(1,itk),vtemp1(1))
8181 call transpose2(AEA(1,1,2),atemp(1,1))
8182 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8183 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8184 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8188 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8189 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8190 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8192 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8193 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8194 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8195 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8196 ss13 = scalar2(b1(1,itk),vtemp4(1))
8197 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8201 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8207 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8209 C Derivatives in gamma(i+2)
8211 call transpose2(AEA(1,1,1),auxmatd(1,1))
8212 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8213 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8214 call transpose2(AEAderg(1,1,2),atempd(1,1))
8215 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8216 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8220 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8221 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8222 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8228 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8229 C Derivatives in gamma(i+3)
8231 call transpose2(AEA(1,1,1),auxmatd(1,1))
8232 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8233 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8234 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8238 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8239 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8240 s2d = scalar2(b1(1,itk),vtemp1d(1))
8242 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8243 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8245 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8247 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8248 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8249 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8259 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8260 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8262 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8263 & -0.5d0*ekont*(s2d+s12d)
8265 C Derivatives in gamma(i+4)
8266 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8267 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8268 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8270 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8271 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8272 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8282 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8284 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8286 C Derivatives in gamma(i+5)
8288 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8289 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8290 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8294 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8295 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8296 s2d = scalar2(b1(1,itk),vtemp1d(1))
8298 call transpose2(AEA(1,1,2),atempd(1,1))
8299 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8300 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8304 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8305 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8307 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8308 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8309 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8319 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8320 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8322 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8323 & -0.5d0*ekont*(s2d+s12d)
8325 C Cartesian derivatives
8330 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8331 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8332 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8336 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8337 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8339 s2d = scalar2(b1(1,itk),vtemp1d(1))
8341 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8342 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8343 s8d = -(atempd(1,1)+atempd(2,2))*
8344 & scalar2(cc(1,1,itl),vtemp2(1))
8348 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8350 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8351 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8358 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8361 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8365 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8366 & - 0.5d0*(s8d+s12d)
8368 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8377 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8379 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8380 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8381 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8382 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8383 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8385 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8386 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8387 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8391 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8392 cd & 16*eel_turn6_num
8394 if (j.lt.nres-1) then
8401 if (l.lt.nres-1) then
8409 ggg1(ll)=eel_turn6*g_contij(ll,1)
8410 ggg2(ll)=eel_turn6*g_contij(ll,2)
8411 ghalf=0.5d0*ggg1(ll)
8413 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8414 & +ekont*derx_turn(ll,2,1)
8415 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8416 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8417 & +ekont*derx_turn(ll,4,1)
8418 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8419 ghalf=0.5d0*ggg2(ll)
8421 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8422 & +ekont*derx_turn(ll,2,2)
8423 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8424 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8425 & +ekont*derx_turn(ll,4,2)
8426 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8431 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8436 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8442 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8447 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8451 cd write (2,*) iii,g_corr6_loc(iii)
8454 eello_turn6=ekont*eel_turn6
8455 cd write (2,*) 'ekont',ekont
8456 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8459 crc-------------------------------------------------
8460 SUBROUTINE MATVEC2(A1,V1,V2)
8461 implicit real*8 (a-h,o-z)
8462 include 'DIMENSIONS'
8463 DIMENSION A1(2,2),V1(2),V2(2)
8467 c 3 VI=VI+A1(I,K)*V1(K)
8471 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8472 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8477 C---------------------------------------
8478 SUBROUTINE MATMAT2(A1,A2,A3)
8479 implicit real*8 (a-h,o-z)
8480 include 'DIMENSIONS'
8481 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8482 c DIMENSION AI3(2,2)
8486 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8492 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8493 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8494 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8495 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8503 c-------------------------------------------------------------------------
8504 double precision function scalar2(u,v)
8506 double precision u(2),v(2)
8509 scalar2=u(1)*v(1)+u(2)*v(2)
8513 C-----------------------------------------------------------------------------
8515 subroutine transpose2(a,at)
8517 double precision a(2,2),at(2,2)
8524 c--------------------------------------------------------------------------
8525 subroutine transpose(n,a,at)
8528 double precision a(n,n),at(n,n)
8536 C---------------------------------------------------------------------------
8537 subroutine prodmat3(a1,a2,kk,transp,prod)
8540 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8542 crc double precision auxmat(2,2),prod_(2,2)
8545 crc call transpose2(kk(1,1),auxmat(1,1))
8546 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8547 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8549 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8550 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8551 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8552 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8553 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8554 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8555 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8556 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8559 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8560 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8562 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8563 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8564 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8565 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8566 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8567 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8568 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8569 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8572 c call transpose2(a2(1,1),a2t(1,1))
8575 crc print *,((prod_(i,j),i=1,2),j=1,2)
8576 crc print *,((prod(i,j),i=1,2),j=1,2)
8580 C-----------------------------------------------------------------------------
8581 double precision function scalar(u,v)
8583 double precision u(3),v(3)
8593 C-----------------------------------------------------------------------
8594 double precision function sscale(r)
8595 double precision r,gamm
8596 include "COMMON.SPLITELE"
8597 if(r.lt.r_cut-rlamb) then
8599 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8600 gamm=(r-(r_cut-rlamb))/rlamb
8601 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8607 C-----------------------------------------------------------------------
8608 C-----------------------------------------------------------------------
8609 double precision function sscagrad(r)
8610 double precision r,gamm
8611 include "COMMON.SPLITELE"
8612 if(r.lt.r_cut-rlamb) then
8614 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8615 gamm=(r-(r_cut-rlamb))/rlamb
8616 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8622 C-----------------------------------------------------------------------
8623 C-----------------------------------------------------------------------
8624 double precision function sscalelip(r)
8625 double precision r,gamm
8626 include "COMMON.SPLITELE"
8627 C if(r.lt.r_cut-rlamb) then
8629 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8630 C gamm=(r-(r_cut-rlamb))/rlamb
8631 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8637 C-----------------------------------------------------------------------
8638 double precision function sscagradlip(r)
8639 double precision r,gamm
8640 include "COMMON.SPLITELE"
8641 C if(r.lt.r_cut-rlamb) then
8643 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8644 C gamm=(r-(r_cut-rlamb))/rlamb
8645 sscagradlip=r*(6*r-6.0d0)