1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
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)
49 C write(iout,*) 'po elektostatyce'
51 C Calculate electrostatic (H-bonding) energy of the main chain.
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
60 C write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
82 call ebend(ebe,ethetacnstr)
83 cd print *,'Bend energy finished.'
85 C Calculate the SC local energy.
88 C print *,'SCLOC energy finished.'
90 C Calculate the virtual-bond torsional energy.
92 cd print *,'nterm=',nterm
93 call etor(etors,edihcnstr,fact(1))
95 C 6/23/01 Calculate double-torsional energy
97 call etor_d(etors_d,fact(2))
99 C 21/5/07 Calculate local sicdechain correlation energy
101 call eback_sc_corr(esccor)
103 if (wliptran.gt.0) then
104 call Eliptransfer(eliptran)
108 C 12/1/95 Multi-body terms
112 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
113 & .or. wturn6.gt.0.0d0) then
114 c print *,"calling multibody_eello"
115 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
116 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
117 c print *,ecorr,ecorr5,ecorr6,eturn6
124 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
125 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
127 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
129 if (shield_mode.gt.0) then
130 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
132 & +fact(1)*wvdwpp*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+ethetacnstr
141 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
143 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
144 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
145 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
146 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
147 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
148 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
152 if (shield_mode.gt.0) then
153 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
154 & +welec*fact(1)*(ees+evdw1)
155 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
156 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
157 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
158 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
159 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
160 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
163 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
164 & +welec*fact(1)*(ees+evdw1)
165 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
166 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
167 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
168 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
169 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
170 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
177 energia(2)=evdw2-evdw2_14
194 energia(8)=eello_turn3
195 energia(9)=eello_turn4
204 energia(20)=edihcnstr
206 energia(24)=ethetacnstr
211 if (isnan(etot).ne.0) energia(0)=1.0d+99
213 if (isnan(etot)) energia(0)=1.0d+99
218 idumm=proc_proc(etot,i)
220 call proc_proc(etot,i)
222 if(i.eq.1)energia(0)=1.0d+99
229 C Sum up the components of the Cartesian gradient.
234 if (shield_mode.eq.0) then
235 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
236 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
238 & wstrain*ghpbc(j,i)+
239 & wcorr*fact(3)*gradcorr(j,i)+
240 & wel_loc*fact(2)*gel_loc(j,i)+
241 & wturn3*fact(2)*gcorr3_turn(j,i)+
242 & wturn4*fact(3)*gcorr4_turn(j,i)+
243 & wcorr5*fact(4)*gradcorr5(j,i)+
244 & wcorr6*fact(5)*gradcorr6(j,i)+
245 & wturn6*fact(5)*gcorr6_turn(j,i)+
246 & wsccor*fact(2)*gsccorc(j,i)
247 & +wliptran*gliptranc(j,i)
248 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
250 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
251 & wsccor*fact(2)*gsccorx(j,i)
252 & +wliptran*gliptranx(j,i)
254 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
255 & +fact(1)*wscp*gvdwc_scp(j,i)+
256 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
258 & wstrain*ghpbc(j,i)+
259 & wcorr*fact(3)*gradcorr(j,i)+
260 & wel_loc*fact(2)*gel_loc(j,i)+
261 & wturn3*fact(2)*gcorr3_turn(j,i)+
262 & wturn4*fact(3)*gcorr4_turn(j,i)+
263 & wcorr5*fact(4)*gradcorr5(j,i)+
264 & wcorr6*fact(5)*gradcorr6(j,i)+
265 & wturn6*fact(5)*gcorr6_turn(j,i)+
266 & wsccor*fact(2)*gsccorc(j,i)
267 & +wliptran*gliptranc(j,i)
268 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
269 & +fact(1)*wscp*gradx_scp(j,i)+
271 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
272 & wsccor*fact(2)*gsccorx(j,i)
273 & +wliptran*gliptranx(j,i)
280 if (shield_mode.eq.0) then
281 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
282 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
284 & wcorr*fact(3)*gradcorr(j,i)+
285 & wel_loc*fact(2)*gel_loc(j,i)+
286 & wturn3*fact(2)*gcorr3_turn(j,i)+
287 & wturn4*fact(3)*gcorr4_turn(j,i)+
288 & wcorr5*fact(4)*gradcorr5(j,i)+
289 & wcorr6*fact(5)*gradcorr6(j,i)+
290 & wturn6*fact(5)*gcorr6_turn(j,i)+
291 & wsccor*fact(2)*gsccorc(j,i)
292 & +wliptran*gliptranc(j,i)
293 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
295 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
296 & wsccor*fact(1)*gsccorx(j,i)
297 & +wliptran*gliptranx(j,i)
299 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
300 & fact(1)*wscp*gvdwc_scp(j,i)+
301 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
303 & wcorr*fact(3)*gradcorr(j,i)+
304 & wel_loc*fact(2)*gel_loc(j,i)+
305 & wturn3*fact(2)*gcorr3_turn(j,i)+
306 & wturn4*fact(3)*gcorr4_turn(j,i)+
307 & wcorr5*fact(4)*gradcorr5(j,i)+
308 & wcorr6*fact(5)*gradcorr6(j,i)+
309 & wturn6*fact(5)*gcorr6_turn(j,i)+
310 & wsccor*fact(2)*gsccorc(j,i)
311 & +wliptran*gliptranc(j,i)
312 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
313 & fact(1)*wscp*gradx_scp(j,i)+
315 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
316 & wsccor*fact(1)*gsccorx(j,i)
317 & +wliptran*gliptranx(j,i)
325 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
326 & +wcorr5*fact(4)*g_corr5_loc(i)
327 & +wcorr6*fact(5)*g_corr6_loc(i)
328 & +wturn4*fact(3)*gel_loc_turn4(i)
329 & +wturn3*fact(2)*gel_loc_turn3(i)
330 & +wturn6*fact(5)*gel_loc_turn6(i)
331 & +wel_loc*fact(2)*gel_loc_loc(i)
332 c & +wsccor*fact(1)*gsccor_loc(i)
333 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
336 if (dyn_ss) call dyn_set_nss
339 C------------------------------------------------------------------------
340 subroutine enerprint(energia,fact)
341 implicit real*8 (a-h,o-z)
343 include 'DIMENSIONS.ZSCOPT'
344 include 'COMMON.IOUNITS'
345 include 'COMMON.FFIELD'
346 include 'COMMON.SBRIDGE'
347 double precision energia(0:max_ene),fact(6)
349 evdw=energia(1)+fact(6)*energia(21)
351 evdw2=energia(2)+energia(17)
363 eello_turn3=energia(8)
364 eello_turn4=energia(9)
365 eello_turn6=energia(10)
372 edihcnstr=energia(20)
374 ethetacnstr=energia(24)
377 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
379 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
380 & etors_d,wtor_d*fact(2),ehpb,wstrain,
381 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
382 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
383 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
384 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
385 & eliptran,wliptran,etot
386 10 format (/'Virtual-chain energies:'//
387 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
388 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
389 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
390 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
391 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
392 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
393 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
394 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
395 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
396 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
397 & ' (SS bridges & dist. cnstr.)'/
398 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
399 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
400 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
401 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
402 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
403 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
404 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
405 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
406 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
407 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
408 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
409 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
410 & 'ETOT= ',1pE16.6,' (total)')
412 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
413 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
414 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
415 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
416 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
417 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
418 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
419 10 format (/'Virtual-chain energies:'//
420 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
421 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
422 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
423 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
424 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
425 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
426 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
427 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
428 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
429 & ' (SS bridges & dist. cnstr.)'/
430 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
431 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
432 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
433 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
434 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
435 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
436 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
437 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
438 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
439 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
440 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
441 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
442 & 'ETOT= ',1pE16.6,' (total)')
446 C-----------------------------------------------------------------------
447 subroutine elj(evdw,evdw_t)
449 C This subroutine calculates the interaction energy of nonbonded side chains
450 C assuming the LJ potential of interaction.
452 implicit real*8 (a-h,o-z)
454 include 'DIMENSIONS.ZSCOPT'
455 include "DIMENSIONS.COMPAR"
456 parameter (accur=1.0d-10)
459 include 'COMMON.LOCAL'
460 include 'COMMON.CHAIN'
461 include 'COMMON.DERIV'
462 include 'COMMON.INTERACT'
463 include 'COMMON.TORSION'
464 include 'COMMON.ENEPS'
465 include 'COMMON.SBRIDGE'
466 include 'COMMON.NAMES'
467 include 'COMMON.IOUNITS'
468 include 'COMMON.CONTACTS'
472 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
476 eneps_temp(j,i)=0.0d0
485 if (itypi.eq.ntyp1) cycle
486 itypi1=iabs(itype(i+1))
493 C Calculate SC interaction energy.
496 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
497 cd & 'iend=',iend(i,iint)
498 do j=istart(i,iint),iend(i,iint)
500 if (itypj.eq.ntyp1) cycle
504 C Change 12/1/95 to calculate four-body interactions
505 rij=xj*xj+yj*yj+zj*zj
507 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
508 eps0ij=eps(itypi,itypj)
513 ij=icant(itypi,itypj)
515 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
516 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
519 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
520 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
521 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
522 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
523 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
524 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
525 if (bb.gt.0.0d0) then
532 C Calculate the components of the gradient in DC and X
534 fac=-rrij*(e1+evdwij)
539 gvdwx(k,i)=gvdwx(k,i)-gg(k)
540 gvdwx(k,j)=gvdwx(k,j)+gg(k)
544 gvdwc(l,k)=gvdwc(l,k)+gg(l)
549 C 12/1/95, revised on 5/20/97
551 C Calculate the contact function. The ith column of the array JCONT will
552 C contain the numbers of atoms that make contacts with the atom I (of numbers
553 C greater than I). The arrays FACONT and GACONT will contain the values of
554 C the contact function and its derivative.
556 C Uncomment next line, if the correlation interactions include EVDW explicitly.
557 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
558 C Uncomment next line, if the correlation interactions are contact function only
559 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
561 sigij=sigma(itypi,itypj)
562 r0ij=rs0(itypi,itypj)
564 C Check whether the SC's are not too far to make a contact.
567 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
568 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
570 if (fcont.gt.0.0D0) then
571 C If the SC-SC distance if close to sigma, apply spline.
572 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
573 cAdam & fcont1,fprimcont1)
574 cAdam fcont1=1.0d0-fcont1
575 cAdam if (fcont1.gt.0.0d0) then
576 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
577 cAdam fcont=fcont*fcont1
579 C Uncomment following 4 lines to have the geometric average of the epsilon0's
580 cga eps0ij=1.0d0/dsqrt(eps0ij)
582 cga gg(k)=gg(k)*eps0ij
584 cga eps0ij=-evdwij*eps0ij
585 C Uncomment for AL's type of SC correlation interactions.
587 num_conti=num_conti+1
589 facont(num_conti,i)=fcont*eps0ij
590 fprimcont=eps0ij*fprimcont/rij
592 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
593 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
594 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
595 C Uncomment following 3 lines for Skolnick's type of SC correlation.
596 gacont(1,num_conti,i)=-fprimcont*xj
597 gacont(2,num_conti,i)=-fprimcont*yj
598 gacont(3,num_conti,i)=-fprimcont*zj
599 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
600 cd write (iout,'(2i3,3f10.5)')
601 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
607 num_cont(i)=num_conti
612 gvdwc(j,i)=expon*gvdwc(j,i)
613 gvdwx(j,i)=expon*gvdwx(j,i)
617 C******************************************************************************
621 C To save time, the factor of EXPON has been extracted from ALL components
622 C of GVDWC and GRADX. Remember to multiply them by this factor before further
625 C******************************************************************************
628 C-----------------------------------------------------------------------------
629 subroutine eljk(evdw,evdw_t)
631 C This subroutine calculates the interaction energy of nonbonded side chains
632 C assuming the LJK potential of interaction.
634 implicit real*8 (a-h,o-z)
636 include 'DIMENSIONS.ZSCOPT'
637 include "DIMENSIONS.COMPAR"
640 include 'COMMON.LOCAL'
641 include 'COMMON.CHAIN'
642 include 'COMMON.DERIV'
643 include 'COMMON.INTERACT'
644 include 'COMMON.ENEPS'
645 include 'COMMON.IOUNITS'
646 include 'COMMON.NAMES'
651 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
654 eneps_temp(j,i)=0.0d0
661 if (itypi.eq.ntyp1) cycle
662 itypi1=iabs(itype(i+1))
667 C Calculate SC interaction energy.
670 do j=istart(i,iint),iend(i,iint)
672 if (itypj.eq.ntyp1) cycle
676 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
678 e_augm=augm(itypi,itypj)*fac_augm
681 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
682 fac=r_shift_inv**expon
686 ij=icant(itypi,itypj)
687 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
688 & /dabs(eps(itypi,itypj))
689 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
690 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
691 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
692 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
693 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
694 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
695 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
696 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
697 if (bb.gt.0.0d0) then
704 C Calculate the components of the gradient in DC and X
706 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
711 gvdwx(k,i)=gvdwx(k,i)-gg(k)
712 gvdwx(k,j)=gvdwx(k,j)+gg(k)
716 gvdwc(l,k)=gvdwc(l,k)+gg(l)
726 gvdwc(j,i)=expon*gvdwc(j,i)
727 gvdwx(j,i)=expon*gvdwx(j,i)
733 C-----------------------------------------------------------------------------
734 subroutine ebp(evdw,evdw_t)
736 C This subroutine calculates the interaction energy of nonbonded side chains
737 C assuming the Berne-Pechukas potential of interaction.
739 implicit real*8 (a-h,o-z)
741 include 'DIMENSIONS.ZSCOPT'
742 include "DIMENSIONS.COMPAR"
745 include 'COMMON.LOCAL'
746 include 'COMMON.CHAIN'
747 include 'COMMON.DERIV'
748 include 'COMMON.NAMES'
749 include 'COMMON.INTERACT'
750 include 'COMMON.ENEPS'
751 include 'COMMON.IOUNITS'
752 include 'COMMON.CALC'
754 c double precision rrsave(maxdim)
760 eneps_temp(j,i)=0.0d0
765 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
766 c if (icall.eq.0) then
774 if (itypi.eq.ntyp1) cycle
775 itypi1=iabs(itype(i+1))
779 dxi=dc_norm(1,nres+i)
780 dyi=dc_norm(2,nres+i)
781 dzi=dc_norm(3,nres+i)
782 dsci_inv=vbld_inv(i+nres)
784 C Calculate SC interaction energy.
787 do j=istart(i,iint),iend(i,iint)
790 if (itypj.eq.ntyp1) cycle
791 dscj_inv=vbld_inv(j+nres)
792 chi1=chi(itypi,itypj)
793 chi2=chi(itypj,itypi)
800 alf12=0.5D0*(alf1+alf2)
801 C For diagnostics only!!!
814 dxj=dc_norm(1,nres+j)
815 dyj=dc_norm(2,nres+j)
816 dzj=dc_norm(3,nres+j)
817 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
818 cd if (icall.eq.0) then
824 C Calculate the angle-dependent terms of energy & contributions to derivatives.
826 C Calculate whole angle-dependent part of epsilon and contributions
828 fac=(rrij*sigsq)**expon2
831 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
832 eps2der=evdwij*eps3rt
833 eps3der=evdwij*eps2rt
834 evdwij=evdwij*eps2rt*eps3rt
835 ij=icant(itypi,itypj)
836 aux=eps1*eps2rt**2*eps3rt**2
837 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
838 & /dabs(eps(itypi,itypj))
839 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
840 if (bb.gt.0.0d0) then
847 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
849 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
850 & restyp(itypi),i,restyp(itypj),j,
851 & epsi,sigm,chi1,chi2,chip1,chip2,
852 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
853 & om1,om2,om12,1.0D0/dsqrt(rrij),
856 C Calculate gradient components.
857 e1=e1*eps1*eps2rt**2*eps3rt**2
858 fac=-expon*(e1+evdwij)
861 C Calculate radial part of the gradient
865 C Calculate the angular part of the gradient and sum add the contributions
866 C to the appropriate components of the Cartesian gradient.
875 C-----------------------------------------------------------------------------
876 subroutine egb(evdw,evdw_t)
878 C This subroutine calculates the interaction energy of nonbonded side chains
879 C assuming the Gay-Berne potential of interaction.
881 implicit real*8 (a-h,o-z)
883 include 'DIMENSIONS.ZSCOPT'
884 include "DIMENSIONS.COMPAR"
887 include 'COMMON.LOCAL'
888 include 'COMMON.CHAIN'
889 include 'COMMON.DERIV'
890 include 'COMMON.NAMES'
891 include 'COMMON.INTERACT'
892 include 'COMMON.ENEPS'
893 include 'COMMON.IOUNITS'
894 include 'COMMON.CALC'
895 include 'COMMON.SBRIDGE'
898 integer icant,xshift,yshift,zshift
902 eneps_temp(j,i)=0.0d0
905 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
909 c if (icall.gt.0) lprn=.true.
913 if (itypi.eq.ntyp1) cycle
914 itypi1=iabs(itype(i+1))
918 C returning the ith atom to box
920 if (xi.lt.0) xi=xi+boxxsize
922 if (yi.lt.0) yi=yi+boxysize
924 if (zi.lt.0) zi=zi+boxzsize
925 if ((zi.gt.bordlipbot)
926 &.and.(zi.lt.bordliptop)) then
927 C the energy transfer exist
928 if (zi.lt.buflipbot) then
929 C what fraction I am in
931 & ((zi-bordlipbot)/lipbufthick)
932 C lipbufthick is thickenes of lipid buffore
933 sslipi=sscalelip(fracinbuf)
934 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
935 elseif (zi.gt.bufliptop) then
936 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
937 sslipi=sscalelip(fracinbuf)
938 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
948 dxi=dc_norm(1,nres+i)
949 dyi=dc_norm(2,nres+i)
950 dzi=dc_norm(3,nres+i)
951 dsci_inv=vbld_inv(i+nres)
953 C Calculate SC interaction energy.
956 do j=istart(i,iint),iend(i,iint)
957 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
958 call dyn_ssbond_ene(i,j,evdwij)
960 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
961 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
962 C triple bond artifac removal
963 do k=j+1,iend(i,iint)
964 C search over all next residues
965 if (dyn_ss_mask(k)) then
966 C check if they are cysteins
967 C write(iout,*) 'k=',k
968 call triple_ssbond_ene(i,j,k,evdwij)
969 C call the energy function that removes the artifical triple disulfide
970 C bond the soubroutine is located in ssMD.F
972 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
973 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
979 if (itypj.eq.ntyp1) cycle
980 dscj_inv=vbld_inv(j+nres)
981 sig0ij=sigma(itypi,itypj)
982 chi1=chi(itypi,itypj)
983 chi2=chi(itypj,itypi)
990 alf12=0.5D0*(alf1+alf2)
991 C For diagnostics only!!!
1004 C returning jth atom to box
1006 if (xj.lt.0) xj=xj+boxxsize
1008 if (yj.lt.0) yj=yj+boxysize
1010 if (zj.lt.0) zj=zj+boxzsize
1011 if ((zj.gt.bordlipbot)
1012 &.and.(zj.lt.bordliptop)) then
1013 C the energy transfer exist
1014 if (zj.lt.buflipbot) then
1015 C what fraction I am in
1017 & ((zj-bordlipbot)/lipbufthick)
1018 C lipbufthick is thickenes of lipid buffore
1019 sslipj=sscalelip(fracinbuf)
1020 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1021 elseif (zj.gt.bufliptop) then
1022 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1023 sslipj=sscalelip(fracinbuf)
1024 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1033 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1034 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1035 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1036 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1037 C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1039 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1040 C checking the distance
1041 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1046 C finding the closest
1050 xj=xj_safe+xshift*boxxsize
1051 yj=yj_safe+yshift*boxysize
1052 zj=zj_safe+zshift*boxzsize
1053 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1054 if(dist_temp.lt.dist_init) then
1064 if (subchap.eq.1) then
1074 dxj=dc_norm(1,nres+j)
1075 dyj=dc_norm(2,nres+j)
1076 dzj=dc_norm(3,nres+j)
1077 c write (iout,*) i,j,xj,yj,zj
1078 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1080 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1081 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1082 if (sss.le.0.0) cycle
1083 C Calculate angle-dependent terms of energy and contributions to their
1088 sig=sig0ij*dsqrt(sigsq)
1089 rij_shift=1.0D0/rij-sig+sig0ij
1090 C I hate to put IF's in the loops, but here don't have another choice!!!!
1091 if (rij_shift.le.0.0D0) then
1096 c---------------------------------------------------------------
1097 rij_shift=1.0D0/rij_shift
1098 fac=rij_shift**expon
1101 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1102 eps2der=evdwij*eps3rt
1103 eps3der=evdwij*eps2rt
1104 evdwij=evdwij*eps2rt*eps3rt
1106 evdw=evdw+evdwij*sss
1108 evdw_t=evdw_t+evdwij*sss
1110 ij=icant(itypi,itypj)
1111 aux=eps1*eps2rt**2*eps3rt**2
1112 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1113 & /dabs(eps(itypi,itypj))
1114 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1115 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1116 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1117 c & aux*e2/eps(itypi,itypj)
1119 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1122 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1123 & restyp(itypi),i,restyp(itypj),j,
1124 & epsi,sigm,chi1,chi2,chip1,chip2,
1125 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1126 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1128 write (iout,*) "partial sum", evdw, evdw_t
1132 C Calculate gradient components.
1133 e1=e1*eps1*eps2rt**2*eps3rt**2
1134 fac=-expon*(e1+evdwij)*rij_shift
1137 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1138 C Calculate the radial part of the gradient
1142 C Calculate angular part of the gradient.
1145 C write(iout,*) "partial sum", evdw, evdw_t
1152 C-----------------------------------------------------------------------------
1153 subroutine egbv(evdw,evdw_t)
1155 C This subroutine calculates the interaction energy of nonbonded side chains
1156 C assuming the Gay-Berne-Vorobjev potential of interaction.
1158 implicit real*8 (a-h,o-z)
1159 include 'DIMENSIONS'
1160 include 'DIMENSIONS.ZSCOPT'
1161 include "DIMENSIONS.COMPAR"
1162 include 'COMMON.GEO'
1163 include 'COMMON.VAR'
1164 include 'COMMON.LOCAL'
1165 include 'COMMON.CHAIN'
1166 include 'COMMON.DERIV'
1167 include 'COMMON.NAMES'
1168 include 'COMMON.INTERACT'
1169 include 'COMMON.ENEPS'
1170 include 'COMMON.IOUNITS'
1171 include 'COMMON.CALC'
1172 common /srutu/ icall
1178 eneps_temp(j,i)=0.0d0
1183 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1186 c if (icall.gt.0) lprn=.true.
1188 do i=iatsc_s,iatsc_e
1189 itypi=iabs(itype(i))
1190 if (itypi.eq.ntyp1) cycle
1191 itypi1=iabs(itype(i+1))
1195 dxi=dc_norm(1,nres+i)
1196 dyi=dc_norm(2,nres+i)
1197 dzi=dc_norm(3,nres+i)
1198 dsci_inv=vbld_inv(i+nres)
1200 C Calculate SC interaction energy.
1202 do iint=1,nint_gr(i)
1203 do j=istart(i,iint),iend(i,iint)
1205 itypj=iabs(itype(j))
1206 if (itypj.eq.ntyp1) cycle
1207 dscj_inv=vbld_inv(j+nres)
1208 sig0ij=sigma(itypi,itypj)
1209 r0ij=r0(itypi,itypj)
1210 chi1=chi(itypi,itypj)
1211 chi2=chi(itypj,itypi)
1218 alf12=0.5D0*(alf1+alf2)
1219 C For diagnostics only!!!
1232 dxj=dc_norm(1,nres+j)
1233 dyj=dc_norm(2,nres+j)
1234 dzj=dc_norm(3,nres+j)
1235 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1237 C Calculate angle-dependent terms of energy and contributions to their
1241 sig=sig0ij*dsqrt(sigsq)
1242 rij_shift=1.0D0/rij-sig+r0ij
1243 C I hate to put IF's in the loops, but here don't have another choice!!!!
1244 if (rij_shift.le.0.0D0) then
1249 c---------------------------------------------------------------
1250 rij_shift=1.0D0/rij_shift
1251 fac=rij_shift**expon
1254 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1255 eps2der=evdwij*eps3rt
1256 eps3der=evdwij*eps2rt
1257 fac_augm=rrij**expon
1258 e_augm=augm(itypi,itypj)*fac_augm
1259 evdwij=evdwij*eps2rt*eps3rt
1260 if (bb.gt.0.0d0) then
1261 evdw=evdw+evdwij+e_augm
1263 evdw_t=evdw_t+evdwij+e_augm
1265 ij=icant(itypi,itypj)
1266 aux=eps1*eps2rt**2*eps3rt**2
1267 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1268 & /dabs(eps(itypi,itypj))
1269 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1270 c eneps_temp(ij)=eneps_temp(ij)
1271 c & +(evdwij+e_augm)/eps(itypi,itypj)
1273 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1274 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1275 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1276 c & restyp(itypi),i,restyp(itypj),j,
1277 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1278 c & chi1,chi2,chip1,chip2,
1279 c & eps1,eps2rt**2,eps3rt**2,
1280 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1284 C Calculate gradient components.
1285 e1=e1*eps1*eps2rt**2*eps3rt**2
1286 fac=-expon*(e1+evdwij)*rij_shift
1288 fac=rij*fac-2*expon*rrij*e_augm
1289 C Calculate the radial part of the gradient
1293 C Calculate angular part of the gradient.
1301 C-----------------------------------------------------------------------------
1302 subroutine sc_angular
1303 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1304 C om12. Called by ebp, egb, and egbv.
1306 include 'COMMON.CALC'
1310 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1311 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1312 om12=dxi*dxj+dyi*dyj+dzi*dzj
1314 C Calculate eps1(om12) and its derivative in om12
1315 faceps1=1.0D0-om12*chiom12
1316 faceps1_inv=1.0D0/faceps1
1317 eps1=dsqrt(faceps1_inv)
1318 C Following variable is eps1*deps1/dom12
1319 eps1_om12=faceps1_inv*chiom12
1320 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1325 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1326 sigsq=1.0D0-facsig*faceps1_inv
1327 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1328 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1329 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1330 C Calculate eps2 and its derivatives in om1, om2, and om12.
1333 chipom12=chip12*om12
1334 facp=1.0D0-om12*chipom12
1336 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1337 C Following variable is the square root of eps2
1338 eps2rt=1.0D0-facp1*facp_inv
1339 C Following three variables are the derivatives of the square root of eps
1340 C in om1, om2, and om12.
1341 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1342 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1343 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1344 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1345 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1346 C Calculate whole angle-dependent part of epsilon and contributions
1347 C to its derivatives
1350 C----------------------------------------------------------------------------
1352 implicit real*8 (a-h,o-z)
1353 include 'DIMENSIONS'
1354 include 'DIMENSIONS.ZSCOPT'
1355 include 'COMMON.CHAIN'
1356 include 'COMMON.DERIV'
1357 include 'COMMON.CALC'
1358 double precision dcosom1(3),dcosom2(3)
1359 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1360 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1361 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1362 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1364 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1365 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1368 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1371 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1372 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1373 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1374 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1375 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1376 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1379 C Calculate the components of the gradient in DC and X
1383 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1388 c------------------------------------------------------------------------------
1389 subroutine vec_and_deriv
1390 implicit real*8 (a-h,o-z)
1391 include 'DIMENSIONS'
1392 include 'DIMENSIONS.ZSCOPT'
1393 include 'COMMON.IOUNITS'
1394 include 'COMMON.GEO'
1395 include 'COMMON.VAR'
1396 include 'COMMON.LOCAL'
1397 include 'COMMON.CHAIN'
1398 include 'COMMON.VECTORS'
1399 include 'COMMON.DERIV'
1400 include 'COMMON.INTERACT'
1401 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1402 C Compute the local reference systems. For reference system (i), the
1403 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1404 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1406 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1407 if (i.eq.nres-1) then
1408 C Case of the last full residue
1409 C Compute the Z-axis
1410 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1411 costh=dcos(pi-theta(nres))
1412 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1417 C Compute the derivatives of uz
1419 uzder(2,1,1)=-dc_norm(3,i-1)
1420 uzder(3,1,1)= dc_norm(2,i-1)
1421 uzder(1,2,1)= dc_norm(3,i-1)
1423 uzder(3,2,1)=-dc_norm(1,i-1)
1424 uzder(1,3,1)=-dc_norm(2,i-1)
1425 uzder(2,3,1)= dc_norm(1,i-1)
1428 uzder(2,1,2)= dc_norm(3,i)
1429 uzder(3,1,2)=-dc_norm(2,i)
1430 uzder(1,2,2)=-dc_norm(3,i)
1432 uzder(3,2,2)= dc_norm(1,i)
1433 uzder(1,3,2)= dc_norm(2,i)
1434 uzder(2,3,2)=-dc_norm(1,i)
1437 C Compute the Y-axis
1440 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1443 C Compute the derivatives of uy
1446 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1447 & -dc_norm(k,i)*dc_norm(j,i-1)
1448 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1450 uyder(j,j,1)=uyder(j,j,1)-costh
1451 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1456 uygrad(l,k,j,i)=uyder(l,k,j)
1457 uzgrad(l,k,j,i)=uzder(l,k,j)
1461 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1462 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1463 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1464 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1468 C Compute the Z-axis
1469 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1470 costh=dcos(pi-theta(i+2))
1471 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1476 C Compute the derivatives of uz
1478 uzder(2,1,1)=-dc_norm(3,i+1)
1479 uzder(3,1,1)= dc_norm(2,i+1)
1480 uzder(1,2,1)= dc_norm(3,i+1)
1482 uzder(3,2,1)=-dc_norm(1,i+1)
1483 uzder(1,3,1)=-dc_norm(2,i+1)
1484 uzder(2,3,1)= dc_norm(1,i+1)
1487 uzder(2,1,2)= dc_norm(3,i)
1488 uzder(3,1,2)=-dc_norm(2,i)
1489 uzder(1,2,2)=-dc_norm(3,i)
1491 uzder(3,2,2)= dc_norm(1,i)
1492 uzder(1,3,2)= dc_norm(2,i)
1493 uzder(2,3,2)=-dc_norm(1,i)
1496 C Compute the Y-axis
1499 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1502 C Compute the derivatives of uy
1505 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1506 & -dc_norm(k,i)*dc_norm(j,i+1)
1507 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1509 uyder(j,j,1)=uyder(j,j,1)-costh
1510 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1515 uygrad(l,k,j,i)=uyder(l,k,j)
1516 uzgrad(l,k,j,i)=uzder(l,k,j)
1520 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1521 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1522 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1523 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1529 vbld_inv_temp(1)=vbld_inv(i+1)
1530 if (i.lt.nres-1) then
1531 vbld_inv_temp(2)=vbld_inv(i+2)
1533 vbld_inv_temp(2)=vbld_inv(i)
1538 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1539 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1547 C-----------------------------------------------------------------------------
1548 subroutine vec_and_deriv_test
1549 implicit real*8 (a-h,o-z)
1550 include 'DIMENSIONS'
1551 include 'DIMENSIONS.ZSCOPT'
1552 include 'COMMON.IOUNITS'
1553 include 'COMMON.GEO'
1554 include 'COMMON.VAR'
1555 include 'COMMON.LOCAL'
1556 include 'COMMON.CHAIN'
1557 include 'COMMON.VECTORS'
1558 dimension uyder(3,3,2),uzder(3,3,2)
1559 C Compute the local reference systems. For reference system (i), the
1560 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1561 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1563 if (i.eq.nres-1) then
1564 C Case of the last full residue
1565 C Compute the Z-axis
1566 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1567 costh=dcos(pi-theta(nres))
1568 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1569 c write (iout,*) 'fac',fac,
1570 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1571 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1575 C Compute the derivatives of uz
1577 uzder(2,1,1)=-dc_norm(3,i-1)
1578 uzder(3,1,1)= dc_norm(2,i-1)
1579 uzder(1,2,1)= dc_norm(3,i-1)
1581 uzder(3,2,1)=-dc_norm(1,i-1)
1582 uzder(1,3,1)=-dc_norm(2,i-1)
1583 uzder(2,3,1)= dc_norm(1,i-1)
1586 uzder(2,1,2)= dc_norm(3,i)
1587 uzder(3,1,2)=-dc_norm(2,i)
1588 uzder(1,2,2)=-dc_norm(3,i)
1590 uzder(3,2,2)= dc_norm(1,i)
1591 uzder(1,3,2)= dc_norm(2,i)
1592 uzder(2,3,2)=-dc_norm(1,i)
1594 C Compute the Y-axis
1596 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1599 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1600 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1601 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1603 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1606 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1607 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1610 c write (iout,*) 'facy',facy,
1611 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1612 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1614 uy(k,i)=facy*uy(k,i)
1616 C Compute the derivatives of uy
1619 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1620 & -dc_norm(k,i)*dc_norm(j,i-1)
1621 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1623 c uyder(j,j,1)=uyder(j,j,1)-costh
1624 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1625 uyder(j,j,1)=uyder(j,j,1)
1626 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1627 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1633 uygrad(l,k,j,i)=uyder(l,k,j)
1634 uzgrad(l,k,j,i)=uzder(l,k,j)
1638 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1639 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1640 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1641 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1644 C Compute the Z-axis
1645 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1646 costh=dcos(pi-theta(i+2))
1647 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1648 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1652 C Compute the derivatives of uz
1654 uzder(2,1,1)=-dc_norm(3,i+1)
1655 uzder(3,1,1)= dc_norm(2,i+1)
1656 uzder(1,2,1)= dc_norm(3,i+1)
1658 uzder(3,2,1)=-dc_norm(1,i+1)
1659 uzder(1,3,1)=-dc_norm(2,i+1)
1660 uzder(2,3,1)= dc_norm(1,i+1)
1663 uzder(2,1,2)= dc_norm(3,i)
1664 uzder(3,1,2)=-dc_norm(2,i)
1665 uzder(1,2,2)=-dc_norm(3,i)
1667 uzder(3,2,2)= dc_norm(1,i)
1668 uzder(1,3,2)= dc_norm(2,i)
1669 uzder(2,3,2)=-dc_norm(1,i)
1671 C Compute the Y-axis
1673 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1674 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1675 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1677 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1680 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1681 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1684 c write (iout,*) 'facy',facy,
1685 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1686 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1688 uy(k,i)=facy*uy(k,i)
1690 C Compute the derivatives of uy
1693 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1694 & -dc_norm(k,i)*dc_norm(j,i+1)
1695 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1697 c uyder(j,j,1)=uyder(j,j,1)-costh
1698 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1699 uyder(j,j,1)=uyder(j,j,1)
1700 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1701 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1707 uygrad(l,k,j,i)=uyder(l,k,j)
1708 uzgrad(l,k,j,i)=uzder(l,k,j)
1712 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1713 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1714 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1715 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1722 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1723 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1730 C-----------------------------------------------------------------------------
1731 subroutine check_vecgrad
1732 implicit real*8 (a-h,o-z)
1733 include 'DIMENSIONS'
1734 include 'DIMENSIONS.ZSCOPT'
1735 include 'COMMON.IOUNITS'
1736 include 'COMMON.GEO'
1737 include 'COMMON.VAR'
1738 include 'COMMON.LOCAL'
1739 include 'COMMON.CHAIN'
1740 include 'COMMON.VECTORS'
1741 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1742 dimension uyt(3,maxres),uzt(3,maxres)
1743 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1744 double precision delta /1.0d-7/
1747 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1748 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1749 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1750 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1751 cd & (dc_norm(if90,i),if90=1,3)
1752 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1753 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1754 cd write(iout,'(a)')
1760 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1761 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1774 cd write (iout,*) 'i=',i
1776 erij(k)=dc_norm(k,i)
1780 dc_norm(k,i)=erij(k)
1782 dc_norm(j,i)=dc_norm(j,i)+delta
1783 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1785 c dc_norm(k,i)=dc_norm(k,i)/fac
1787 c write (iout,*) (dc_norm(k,i),k=1,3)
1788 c write (iout,*) (erij(k),k=1,3)
1791 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1792 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1793 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1794 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1796 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1797 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1798 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1801 dc_norm(k,i)=erij(k)
1804 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1805 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1806 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1807 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1808 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1809 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1810 cd write (iout,'(a)')
1815 C--------------------------------------------------------------------------
1816 subroutine set_matrices
1817 implicit real*8 (a-h,o-z)
1818 include 'DIMENSIONS'
1819 include 'DIMENSIONS.ZSCOPT'
1820 include 'COMMON.IOUNITS'
1821 include 'COMMON.GEO'
1822 include 'COMMON.VAR'
1823 include 'COMMON.LOCAL'
1824 include 'COMMON.CHAIN'
1825 include 'COMMON.DERIV'
1826 include 'COMMON.INTERACT'
1827 include 'COMMON.CONTACTS'
1828 include 'COMMON.TORSION'
1829 include 'COMMON.VECTORS'
1830 include 'COMMON.FFIELD'
1831 double precision auxvec(2),auxmat(2,2)
1833 C Compute the virtual-bond-torsional-angle dependent quantities needed
1834 C to calculate the el-loc multibody terms of various order.
1837 if (i .lt. nres+1) then
1874 if (i .gt. 3 .and. i .lt. nres+1) then
1875 obrot_der(1,i-2)=-sin1
1876 obrot_der(2,i-2)= cos1
1877 Ugder(1,1,i-2)= sin1
1878 Ugder(1,2,i-2)=-cos1
1879 Ugder(2,1,i-2)=-cos1
1880 Ugder(2,2,i-2)=-sin1
1883 obrot2_der(1,i-2)=-dwasin2
1884 obrot2_der(2,i-2)= dwacos2
1885 Ug2der(1,1,i-2)= dwasin2
1886 Ug2der(1,2,i-2)=-dwacos2
1887 Ug2der(2,1,i-2)=-dwacos2
1888 Ug2der(2,2,i-2)=-dwasin2
1890 obrot_der(1,i-2)=0.0d0
1891 obrot_der(2,i-2)=0.0d0
1892 Ugder(1,1,i-2)=0.0d0
1893 Ugder(1,2,i-2)=0.0d0
1894 Ugder(2,1,i-2)=0.0d0
1895 Ugder(2,2,i-2)=0.0d0
1896 obrot2_der(1,i-2)=0.0d0
1897 obrot2_der(2,i-2)=0.0d0
1898 Ug2der(1,1,i-2)=0.0d0
1899 Ug2der(1,2,i-2)=0.0d0
1900 Ug2der(2,1,i-2)=0.0d0
1901 Ug2der(2,2,i-2)=0.0d0
1903 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1904 if (itype(i-2).le.ntyp) then
1905 iti = itortyp(itype(i-2))
1912 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1913 if (itype(i-1).le.ntyp) then
1914 iti1 = itortyp(itype(i-1))
1921 cd write (iout,*) '*******i',i,' iti1',iti
1922 cd write (iout,*) 'b1',b1(:,iti)
1923 cd write (iout,*) 'b2',b2(:,iti)
1924 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1925 c print *,"itilde1 i iti iti1",i,iti,iti1
1926 if (i .gt. iatel_s+2) then
1927 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1928 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1929 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1930 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1931 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1932 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1933 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1943 DtUg2(l,k,i-2)=0.0d0
1947 c print *,"itilde2 i iti iti1",i,iti,iti1
1948 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1949 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1950 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1951 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1952 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1953 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1954 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1955 c print *,"itilde3 i iti iti1",i,iti,iti1
1957 muder(k,i-2)=Ub2der(k,i-2)
1959 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1960 if (itype(i-1).le.ntyp) then
1961 iti1 = itortyp(itype(i-1))
1969 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1971 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
1973 C Vectors and matrices dependent on a single virtual-bond dihedral.
1974 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1975 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1976 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1977 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1978 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1979 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1980 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1981 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1982 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1983 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1984 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1986 C Matrices dependent on two consecutive virtual-bond dihedrals.
1987 C The order of matrices is from left to right.
1989 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1990 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1991 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1992 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1993 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1994 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1995 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1996 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1999 cd iti = itortyp(itype(i))
2002 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2003 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2008 C--------------------------------------------------------------------------
2009 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2011 C This subroutine calculates the average interaction energy and its gradient
2012 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2013 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2014 C The potential depends both on the distance of peptide-group centers and on
2015 C the orientation of the CA-CA virtual bonds.
2017 implicit real*8 (a-h,o-z)
2018 include 'DIMENSIONS'
2019 include 'DIMENSIONS.ZSCOPT'
2020 include 'COMMON.CONTROL'
2021 include 'COMMON.IOUNITS'
2022 include 'COMMON.GEO'
2023 include 'COMMON.VAR'
2024 include 'COMMON.LOCAL'
2025 include 'COMMON.CHAIN'
2026 include 'COMMON.DERIV'
2027 include 'COMMON.INTERACT'
2028 include 'COMMON.CONTACTS'
2029 include 'COMMON.TORSION'
2030 include 'COMMON.VECTORS'
2031 include 'COMMON.FFIELD'
2032 include 'COMMON.SHIELD'
2033 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2034 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2035 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2036 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2037 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2038 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2039 double precision scal_el /0.5d0/
2041 C 13-go grudnia roku pamietnego...
2042 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2043 & 0.0d0,1.0d0,0.0d0,
2044 & 0.0d0,0.0d0,1.0d0/
2045 cd write(iout,*) 'In EELEC'
2047 cd write(iout,*) 'Type',i
2048 cd write(iout,*) 'B1',B1(:,i)
2049 cd write(iout,*) 'B2',B2(:,i)
2050 cd write(iout,*) 'CC',CC(:,:,i)
2051 cd write(iout,*) 'DD',DD(:,:,i)
2052 cd write(iout,*) 'EE',EE(:,:,i)
2054 cd call check_vecgrad
2056 if (icheckgrad.eq.1) then
2058 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2060 dc_norm(k,i)=dc(k,i)*fac
2062 c write (iout,*) 'i',i,' fac',fac
2065 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2066 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2067 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2068 cd if (wel_loc.gt.0.0d0) then
2069 if (icheckgrad.eq.1) then
2070 call vec_and_deriv_test
2077 cd write (iout,*) 'i=',i
2079 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2082 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2083 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2096 C print '(a)','Enter EELEC'
2097 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2099 gel_loc_loc(i)=0.0d0
2102 do i=iatel_s,iatel_e
2104 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2105 C & .or. itype(i+2).eq.ntyp1) cycle
2107 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2108 C & .or. itype(i+2).eq.ntyp1
2109 C & .or. itype(i-1).eq.ntyp1
2112 if (itel(i).eq.0) goto 1215
2116 dx_normi=dc_norm(1,i)
2117 dy_normi=dc_norm(2,i)
2118 dz_normi=dc_norm(3,i)
2119 xmedi=c(1,i)+0.5d0*dxi
2120 ymedi=c(2,i)+0.5d0*dyi
2121 zmedi=c(3,i)+0.5d0*dzi
2122 xmedi=mod(xmedi,boxxsize)
2123 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2124 ymedi=mod(ymedi,boxysize)
2125 if (ymedi.lt.0) ymedi=ymedi+boxysize
2126 zmedi=mod(zmedi,boxzsize)
2127 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2129 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2130 do j=ielstart(i),ielend(i)
2132 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2133 C & .or.itype(j+2).eq.ntyp1
2136 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2137 C & .or.itype(j+2).eq.ntyp1
2138 C & .or.itype(j-1).eq.ntyp1
2143 if (itel(j).eq.0) goto 1216
2147 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2148 aaa=app(iteli,itelj)
2149 bbb=bpp(iteli,itelj)
2150 C Diagnostics only!!!
2156 ael6i=ael6(iteli,itelj)
2157 ael3i=ael3(iteli,itelj)
2161 dx_normj=dc_norm(1,j)
2162 dy_normj=dc_norm(2,j)
2163 dz_normj=dc_norm(3,j)
2168 if (xj.lt.0) xj=xj+boxxsize
2170 if (yj.lt.0) yj=yj+boxysize
2172 if (zj.lt.0) zj=zj+boxzsize
2173 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2181 xj=xj_safe+xshift*boxxsize
2182 yj=yj_safe+yshift*boxysize
2183 zj=zj_safe+zshift*boxzsize
2184 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2185 if(dist_temp.lt.dist_init) then
2195 if (isubchap.eq.1) then
2204 rij=xj*xj+yj*yj+zj*zj
2205 sss=sscale(sqrt(rij))
2206 sssgrad=sscagrad(sqrt(rij))
2212 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2213 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2214 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2215 fac=cosa-3.0D0*cosb*cosg
2217 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2218 if (j.eq.i+2) ev1=scal_el*ev1
2223 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2226 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2227 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2228 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2229 if (shield_mode.gt.0) then
2232 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2233 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2242 evdw1=evdw1+evdwij*sss
2243 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2244 c &'evdw1',i,j,evdwij
2245 c &,iteli,itelj,aaa,evdw1
2247 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2248 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2249 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2250 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2251 c & xmedi,ymedi,zmedi,xj,yj,zj
2253 C Calculate contributions to the Cartesian gradient.
2256 facvdw=-6*rrmij*(ev1+evdwij)*sss
2257 facel=-3*rrmij*(el1+eesij)
2264 * Radial derivatives. First process both termini of the fragment (i,j)
2269 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2270 & (shield_mode.gt.0)) then
2272 do ilist=1,ishield_list(i)
2273 iresshield=shield_list(ilist,i)
2275 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2277 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2279 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2280 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2281 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2282 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2283 C if (iresshield.gt.i) then
2284 C do ishi=i+1,iresshield-1
2285 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2286 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2290 C do ishi=iresshield,i
2291 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2292 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2298 do ilist=1,ishield_list(j)
2299 iresshield=shield_list(ilist,j)
2301 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2303 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2305 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2306 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2311 gshieldc(k,i)=gshieldc(k,i)+
2312 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2313 gshieldc(k,j)=gshieldc(k,j)+
2314 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2315 gshieldc(k,i-1)=gshieldc(k,i-1)+
2316 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2317 gshieldc(k,j-1)=gshieldc(k,j-1)+
2318 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2325 gelc(k,i)=gelc(k,i)+ghalf
2326 gelc(k,j)=gelc(k,j)+ghalf
2329 * Loop over residues i+1 thru j-1.
2333 gelc(l,k)=gelc(l,k)+ggg(l)
2339 if (sss.gt.0.0) then
2340 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2341 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2342 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2350 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2351 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2354 * Loop over residues i+1 thru j-1.
2358 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2362 facvdw=(ev1+evdwij)*sss
2365 fac=-3*rrmij*(facvdw+facvdw+facel)
2371 * Radial derivatives. First process both termini of the fragment (i,j)
2378 gelc(k,i)=gelc(k,i)+ghalf
2379 gelc(k,j)=gelc(k,j)+ghalf
2382 * Loop over residues i+1 thru j-1.
2386 gelc(l,k)=gelc(l,k)+ggg(l)
2393 ecosa=2.0D0*fac3*fac1+fac4
2396 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2397 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2399 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2400 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2402 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2403 cd & (dcosg(k),k=1,3)
2405 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2406 & *fac_shield(i)**2*fac_shield(j)**2
2410 gelc(k,i)=gelc(k,i)+ghalf
2411 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2412 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2413 & *fac_shield(i)**2*fac_shield(j)**2
2415 gelc(k,j)=gelc(k,j)+ghalf
2416 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2417 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2418 & *fac_shield(i)**2*fac_shield(j)**2
2422 gelc(l,k)=gelc(l,k)+ggg(l)
2427 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2428 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2429 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2431 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2432 C energy of a peptide unit is assumed in the form of a second-order
2433 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2434 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2435 C are computed for EVERY pair of non-contiguous peptide groups.
2437 if (j.lt.nres-1) then
2448 muij(kkk)=mu(k,i)*mu(l,j)
2451 cd write (iout,*) 'EELEC: i',i,' j',j
2452 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2453 cd write(iout,*) 'muij',muij
2454 ury=scalar(uy(1,i),erij)
2455 urz=scalar(uz(1,i),erij)
2456 vry=scalar(uy(1,j),erij)
2457 vrz=scalar(uz(1,j),erij)
2458 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2459 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2460 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2461 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2462 C For diagnostics only
2467 fac=dsqrt(-ael6i)*r3ij
2468 cd write (2,*) 'fac=',fac
2469 C For diagnostics only
2475 cd write (iout,'(4i5,4f10.5)')
2476 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2477 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2478 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2479 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2480 cd write (iout,'(4f10.5)')
2481 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2482 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2483 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2484 cd write (iout,'(2i3,9f10.5/)') i,j,
2485 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2487 C Derivatives of the elements of A in virtual-bond vectors
2488 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2495 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2496 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2497 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2498 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2499 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2500 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2501 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2502 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2503 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2504 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2505 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2506 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2516 C Compute radial contributions to the gradient
2538 C Add the contributions coming from er
2541 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2542 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2543 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2544 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2547 C Derivatives in DC(i)
2548 ghalf1=0.5d0*agg(k,1)
2549 ghalf2=0.5d0*agg(k,2)
2550 ghalf3=0.5d0*agg(k,3)
2551 ghalf4=0.5d0*agg(k,4)
2552 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2553 & -3.0d0*uryg(k,2)*vry)+ghalf1
2554 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2555 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2556 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2557 & -3.0d0*urzg(k,2)*vry)+ghalf3
2558 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2559 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2560 C Derivatives in DC(i+1)
2561 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2562 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2563 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2564 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2565 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2566 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2567 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2568 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2569 C Derivatives in DC(j)
2570 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2571 & -3.0d0*vryg(k,2)*ury)+ghalf1
2572 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2573 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2574 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2575 & -3.0d0*vryg(k,2)*urz)+ghalf3
2576 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2577 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2578 C Derivatives in DC(j+1) or DC(nres-1)
2579 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2580 & -3.0d0*vryg(k,3)*ury)
2581 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2582 & -3.0d0*vrzg(k,3)*ury)
2583 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2584 & -3.0d0*vryg(k,3)*urz)
2585 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2586 & -3.0d0*vrzg(k,3)*urz)
2591 C Derivatives in DC(i+1)
2592 cd aggi1(k,1)=agg(k,1)
2593 cd aggi1(k,2)=agg(k,2)
2594 cd aggi1(k,3)=agg(k,3)
2595 cd aggi1(k,4)=agg(k,4)
2596 C Derivatives in DC(j)
2601 C Derivatives in DC(j+1)
2606 if (j.eq.nres-1 .and. i.lt.j-2) then
2608 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2609 cd aggj1(k,l)=agg(k,l)
2615 C Check the loc-el terms by numerical integration
2625 aggi(k,l)=-aggi(k,l)
2626 aggi1(k,l)=-aggi1(k,l)
2627 aggj(k,l)=-aggj(k,l)
2628 aggj1(k,l)=-aggj1(k,l)
2631 if (j.lt.nres-1) then
2637 aggi(k,l)=-aggi(k,l)
2638 aggi1(k,l)=-aggi1(k,l)
2639 aggj(k,l)=-aggj(k,l)
2640 aggj1(k,l)=-aggj1(k,l)
2651 aggi(k,l)=-aggi(k,l)
2652 aggi1(k,l)=-aggi1(k,l)
2653 aggj(k,l)=-aggj(k,l)
2654 aggj1(k,l)=-aggj1(k,l)
2660 IF (wel_loc.gt.0.0d0) THEN
2661 C Contribution to the local-electrostatic energy coming from the i-j pair
2662 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2664 if (shield_mode.eq.0) then
2671 eel_loc_ij=eel_loc_ij
2672 & *fac_shield(i)*fac_shield(j)
2673 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2674 C write (iout,'(a6,2i5,0pf7.3)')
2675 C & 'eelloc',i,j,eel_loc_ij
2676 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2677 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2678 C eel_loc=eel_loc+eel_loc_ij
2679 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2680 & (shield_mode.gt.0)) then
2683 do ilist=1,ishield_list(i)
2684 iresshield=shield_list(ilist,i)
2686 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2689 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2691 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2692 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2696 do ilist=1,ishield_list(j)
2697 iresshield=shield_list(ilist,j)
2699 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2702 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2704 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2705 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2711 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2712 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2713 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2714 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2715 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2716 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2717 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2718 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2721 eel_loc=eel_loc+eel_loc_ij
2723 C Partial derivatives in virtual-bond dihedral angles gamma
2726 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2727 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2728 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2729 & *fac_shield(i)*fac_shield(j)
2731 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2732 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2733 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2734 & *fac_shield(i)*fac_shield(j)
2736 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2737 cd write(iout,*) 'agg ',agg
2738 cd write(iout,*) 'aggi ',aggi
2739 cd write(iout,*) 'aggi1',aggi1
2740 cd write(iout,*) 'aggj ',aggj
2741 cd write(iout,*) 'aggj1',aggj1
2743 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2745 ggg(l)=(agg(l,1)*muij(1)+
2746 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2747 & *fac_shield(i)*fac_shield(j)
2752 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2755 C Remaining derivatives of eello
2757 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2758 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2759 & *fac_shield(i)*fac_shield(j)
2761 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2762 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2763 & *fac_shield(i)*fac_shield(j)
2765 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2766 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2767 & *fac_shield(i)*fac_shield(j)
2769 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2770 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2771 & *fac_shield(i)*fac_shield(j)
2776 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2777 C Contributions from turns
2782 call eturn34(i,j,eello_turn3,eello_turn4)
2784 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2785 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2787 C Calculate the contact function. The ith column of the array JCONT will
2788 C contain the numbers of atoms that make contacts with the atom I (of numbers
2789 C greater than I). The arrays FACONT and GACONT will contain the values of
2790 C the contact function and its derivative.
2791 c r0ij=1.02D0*rpp(iteli,itelj)
2792 c r0ij=1.11D0*rpp(iteli,itelj)
2793 r0ij=2.20D0*rpp(iteli,itelj)
2794 c r0ij=1.55D0*rpp(iteli,itelj)
2795 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2796 if (fcont.gt.0.0D0) then
2797 num_conti=num_conti+1
2798 if (num_conti.gt.maxconts) then
2799 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2800 & ' will skip next contacts for this conf.'
2802 jcont_hb(num_conti,i)=j
2803 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2804 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2805 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2807 d_cont(num_conti,i)=rij
2808 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2809 C --- Electrostatic-interaction matrix ---
2810 a_chuj(1,1,num_conti,i)=a22
2811 a_chuj(1,2,num_conti,i)=a23
2812 a_chuj(2,1,num_conti,i)=a32
2813 a_chuj(2,2,num_conti,i)=a33
2814 C --- Gradient of rij
2816 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2819 c a_chuj(1,1,num_conti,i)=-0.61d0
2820 c a_chuj(1,2,num_conti,i)= 0.4d0
2821 c a_chuj(2,1,num_conti,i)= 0.65d0
2822 c a_chuj(2,2,num_conti,i)= 0.50d0
2823 c else if (i.eq.2) then
2824 c a_chuj(1,1,num_conti,i)= 0.0d0
2825 c a_chuj(1,2,num_conti,i)= 0.0d0
2826 c a_chuj(2,1,num_conti,i)= 0.0d0
2827 c a_chuj(2,2,num_conti,i)= 0.0d0
2829 C --- and its gradients
2830 cd write (iout,*) 'i',i,' j',j
2832 cd write (iout,*) 'iii 1 kkk',kkk
2833 cd write (iout,*) agg(kkk,:)
2836 cd write (iout,*) 'iii 2 kkk',kkk
2837 cd write (iout,*) aggi(kkk,:)
2840 cd write (iout,*) 'iii 3 kkk',kkk
2841 cd write (iout,*) aggi1(kkk,:)
2844 cd write (iout,*) 'iii 4 kkk',kkk
2845 cd write (iout,*) aggj(kkk,:)
2848 cd write (iout,*) 'iii 5 kkk',kkk
2849 cd write (iout,*) aggj1(kkk,:)
2856 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2857 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2858 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2859 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2860 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2862 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2868 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2869 C Calculate contact energies
2871 wij=cosa-3.0D0*cosb*cosg
2874 c fac3=dsqrt(-ael6i)/r0ij**3
2875 fac3=dsqrt(-ael6i)*r3ij
2876 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2877 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2879 if (shield_mode.eq.0) then
2883 ees0plist(num_conti,i)=j
2884 C fac_shield(i)=0.4d0
2885 C fac_shield(j)=0.6d0
2887 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2888 & *fac_shield(i)*fac_shield(j)
2890 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2891 & *fac_shield(i)*fac_shield(j)
2893 C Diagnostics. Comment out or remove after debugging!
2894 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2895 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2896 c ees0m(num_conti,i)=0.0D0
2898 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2899 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2900 facont_hb(num_conti,i)=fcont
2902 C Angular derivatives of the contact function
2903 ees0pij1=fac3/ees0pij
2904 ees0mij1=fac3/ees0mij
2905 fac3p=-3.0D0*fac3*rrmij
2906 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2907 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2909 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2910 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2911 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2912 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2913 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2914 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2915 ecosap=ecosa1+ecosa2
2916 ecosbp=ecosb1+ecosb2
2917 ecosgp=ecosg1+ecosg2
2918 ecosam=ecosa1-ecosa2
2919 ecosbm=ecosb1-ecosb2
2920 ecosgm=ecosg1-ecosg2
2929 fprimcont=fprimcont/rij
2930 cd facont_hb(num_conti,i)=1.0D0
2931 C Following line is for diagnostics.
2934 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2935 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2938 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2939 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2941 gggp(1)=gggp(1)+ees0pijp*xj
2942 gggp(2)=gggp(2)+ees0pijp*yj
2943 gggp(3)=gggp(3)+ees0pijp*zj
2944 gggm(1)=gggm(1)+ees0mijp*xj
2945 gggm(2)=gggm(2)+ees0mijp*yj
2946 gggm(3)=gggm(3)+ees0mijp*zj
2947 C Derivatives due to the contact function
2948 gacont_hbr(1,num_conti,i)=fprimcont*xj
2949 gacont_hbr(2,num_conti,i)=fprimcont*yj
2950 gacont_hbr(3,num_conti,i)=fprimcont*zj
2952 ghalfp=0.5D0*gggp(k)
2953 ghalfm=0.5D0*gggm(k)
2954 gacontp_hb1(k,num_conti,i)=ghalfp
2955 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2956 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2957 & *fac_shield(i)*fac_shield(j)
2959 gacontp_hb2(k,num_conti,i)=ghalfp
2960 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2961 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2962 & *fac_shield(i)*fac_shield(j)
2964 gacontp_hb3(k,num_conti,i)=gggp(k)
2965 gacontm_hb1(k,num_conti,i)=ghalfm
2966 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2967 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2968 & *fac_shield(i)*fac_shield(j)
2970 gacontm_hb2(k,num_conti,i)=ghalfm
2971 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2972 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2973 & *fac_shield(i)*fac_shield(j)
2975 gacontm_hb3(k,num_conti,i)=gggm(k)
2976 & *fac_shield(i)*fac_shield(j)
2980 C Diagnostics. Comment out or remove after debugging!
2982 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2983 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2984 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2985 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2986 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2987 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2990 endif ! num_conti.le.maxconts
2995 num_cont_hb(i)=num_conti
2999 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3000 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3002 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3003 ccc eel_loc=eel_loc+eello_turn3
3006 C-----------------------------------------------------------------------------
3007 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3008 C Third- and fourth-order contributions from turns
3009 implicit real*8 (a-h,o-z)
3010 include 'DIMENSIONS'
3011 include 'DIMENSIONS.ZSCOPT'
3012 include 'COMMON.IOUNITS'
3013 include 'COMMON.GEO'
3014 include 'COMMON.VAR'
3015 include 'COMMON.LOCAL'
3016 include 'COMMON.CHAIN'
3017 include 'COMMON.DERIV'
3018 include 'COMMON.INTERACT'
3019 include 'COMMON.CONTACTS'
3020 include 'COMMON.TORSION'
3021 include 'COMMON.VECTORS'
3022 include 'COMMON.FFIELD'
3023 include 'COMMON.SHIELD'
3024 include 'COMMON.CONTROL'
3026 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3027 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3028 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3029 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3030 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3031 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3033 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3034 C changes suggested by Ana to avoid out of bounds
3035 C & .or.((i+5).gt.nres)
3036 C & .or.((i-1).le.0)
3037 C end of changes suggested by Ana
3038 & .or. itype(i+2).eq.ntyp1
3039 & .or. itype(i+3).eq.ntyp1
3040 C & .or. itype(i+5).eq.ntyp1
3041 C & .or. itype(i).eq.ntyp1
3042 C & .or. itype(i-1).eq.ntyp1
3045 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3047 C Third-order contributions
3054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3055 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3056 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3057 call transpose2(auxmat(1,1),auxmat1(1,1))
3058 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3059 if (shield_mode.eq.0) then
3067 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3068 & *fac_shield(i)*fac_shield(j)
3069 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3070 & *fac_shield(i)*fac_shield(j)
3072 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3073 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3074 cd & ' eello_turn3_num',4*eello_turn3_num
3076 C Derivatives in shield mode
3077 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3078 & (shield_mode.gt.0)) then
3081 do ilist=1,ishield_list(i)
3082 iresshield=shield_list(ilist,i)
3084 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3086 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3088 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3089 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3093 do ilist=1,ishield_list(j)
3094 iresshield=shield_list(ilist,j)
3096 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3098 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3100 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3101 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3108 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3109 & grad_shield(k,i)*eello_t3/fac_shield(i)
3110 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3111 & grad_shield(k,j)*eello_t3/fac_shield(j)
3112 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3113 & grad_shield(k,i)*eello_t3/fac_shield(i)
3114 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3115 & grad_shield(k,j)*eello_t3/fac_shield(j)
3119 C Derivatives in gamma(i)
3120 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3121 call transpose2(auxmat2(1,1),pizda(1,1))
3122 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3123 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3124 C Derivatives in gamma(i+1)
3125 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3126 call transpose2(auxmat2(1,1),pizda(1,1))
3127 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3128 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3129 & +0.5d0*(pizda(1,1)+pizda(2,2))
3130 & *fac_shield(i)*fac_shield(j)
3132 C Cartesian derivatives
3134 a_temp(1,1)=aggi(l,1)
3135 a_temp(1,2)=aggi(l,2)
3136 a_temp(2,1)=aggi(l,3)
3137 a_temp(2,2)=aggi(l,4)
3138 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3139 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3140 & +0.5d0*(pizda(1,1)+pizda(2,2))
3141 & *fac_shield(i)*fac_shield(j)
3143 a_temp(1,1)=aggi1(l,1)
3144 a_temp(1,2)=aggi1(l,2)
3145 a_temp(2,1)=aggi1(l,3)
3146 a_temp(2,2)=aggi1(l,4)
3147 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3148 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3149 & +0.5d0*(pizda(1,1)+pizda(2,2))
3150 & *fac_shield(i)*fac_shield(j)
3152 a_temp(1,1)=aggj(l,1)
3153 a_temp(1,2)=aggj(l,2)
3154 a_temp(2,1)=aggj(l,3)
3155 a_temp(2,2)=aggj(l,4)
3156 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3157 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3158 & +0.5d0*(pizda(1,1)+pizda(2,2))
3159 & *fac_shield(i)*fac_shield(j)
3161 a_temp(1,1)=aggj1(l,1)
3162 a_temp(1,2)=aggj1(l,2)
3163 a_temp(2,1)=aggj1(l,3)
3164 a_temp(2,2)=aggj1(l,4)
3165 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3166 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3167 & +0.5d0*(pizda(1,1)+pizda(2,2))
3168 & *fac_shield(i)*fac_shield(j)
3173 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3174 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3175 C changes suggested by Ana to avoid out of bounds
3176 C & .or.((i+5).gt.nres)
3177 C & .or.((i-1).le.0)
3178 C end of changes suggested by Ana
3179 & .or. itype(i+3).eq.ntyp1
3180 & .or. itype(i+4).eq.ntyp1
3181 C & .or. itype(i+5).eq.ntyp1
3182 & .or. itype(i).eq.ntyp1
3183 C & .or. itype(i-1).eq.ntyp1
3185 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3187 C Fourth-order contributions
3195 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3196 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3197 iti1=itortyp(itype(i+1))
3198 iti2=itortyp(itype(i+2))
3199 iti3=itortyp(itype(i+3))
3200 call transpose2(EUg(1,1,i+1),e1t(1,1))
3201 call transpose2(Eug(1,1,i+2),e2t(1,1))
3202 call transpose2(Eug(1,1,i+3),e3t(1,1))
3203 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3204 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3205 s1=scalar2(b1(1,iti2),auxvec(1))
3206 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3207 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3208 s2=scalar2(b1(1,iti1),auxvec(1))
3209 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3210 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3211 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3212 if (shield_mode.eq.0) then
3220 eello_turn4=eello_turn4-(s1+s2+s3)
3221 & *fac_shield(i)*fac_shield(j)
3222 eello_t4=-(s1+s2+s3)
3223 & *fac_shield(i)*fac_shield(j)
3225 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3226 cd & ' eello_turn4_num',8*eello_turn4_num
3227 C Derivatives in gamma(i)
3229 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3230 & (shield_mode.gt.0)) then
3233 do ilist=1,ishield_list(i)
3234 iresshield=shield_list(ilist,i)
3236 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3238 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3240 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3241 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3245 do ilist=1,ishield_list(j)
3246 iresshield=shield_list(ilist,j)
3248 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3250 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3252 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3253 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3260 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3261 & grad_shield(k,i)*eello_t4/fac_shield(i)
3262 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3263 & grad_shield(k,j)*eello_t4/fac_shield(j)
3264 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3265 & grad_shield(k,i)*eello_t4/fac_shield(i)
3266 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3267 & grad_shield(k,j)*eello_t4/fac_shield(j)
3270 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3271 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3272 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3273 s1=scalar2(b1(1,iti2),auxvec(1))
3274 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3275 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3276 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3277 & *fac_shield(i)*fac_shield(j)
3279 C Derivatives in gamma(i+1)
3280 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3281 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3282 s2=scalar2(b1(1,iti1),auxvec(1))
3283 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3284 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3285 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3286 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3287 & *fac_shield(i)*fac_shield(j)
3289 C Derivatives in gamma(i+2)
3290 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3291 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3292 s1=scalar2(b1(1,iti2),auxvec(1))
3293 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3294 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3295 s2=scalar2(b1(1,iti1),auxvec(1))
3296 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3297 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3298 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3299 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3300 & *fac_shield(i)*fac_shield(j)
3302 C Cartesian derivatives
3304 C Derivatives of this turn contributions in DC(i+2)
3305 if (j.lt.nres-1) then
3307 a_temp(1,1)=agg(l,1)
3308 a_temp(1,2)=agg(l,2)
3309 a_temp(2,1)=agg(l,3)
3310 a_temp(2,2)=agg(l,4)
3311 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3312 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3313 s1=scalar2(b1(1,iti2),auxvec(1))
3314 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3315 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3316 s2=scalar2(b1(1,iti1),auxvec(1))
3317 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3318 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3319 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3321 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3322 & *fac_shield(i)*fac_shield(j)
3326 C Remaining derivatives of this turn contribution
3328 a_temp(1,1)=aggi(l,1)
3329 a_temp(1,2)=aggi(l,2)
3330 a_temp(2,1)=aggi(l,3)
3331 a_temp(2,2)=aggi(l,4)
3332 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3333 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3334 s1=scalar2(b1(1,iti2),auxvec(1))
3335 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3336 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3337 s2=scalar2(b1(1,iti1),auxvec(1))
3338 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3339 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3340 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3341 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3342 & *fac_shield(i)*fac_shield(j)
3344 a_temp(1,1)=aggi1(l,1)
3345 a_temp(1,2)=aggi1(l,2)
3346 a_temp(2,1)=aggi1(l,3)
3347 a_temp(2,2)=aggi1(l,4)
3348 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3349 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3350 s1=scalar2(b1(1,iti2),auxvec(1))
3351 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3352 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3353 s2=scalar2(b1(1,iti1),auxvec(1))
3354 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3355 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3356 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3357 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3358 & *fac_shield(i)*fac_shield(j)
3360 a_temp(1,1)=aggj(l,1)
3361 a_temp(1,2)=aggj(l,2)
3362 a_temp(2,1)=aggj(l,3)
3363 a_temp(2,2)=aggj(l,4)
3364 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3365 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3366 s1=scalar2(b1(1,iti2),auxvec(1))
3367 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3368 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3369 s2=scalar2(b1(1,iti1),auxvec(1))
3370 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3371 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3372 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3373 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3374 & *fac_shield(i)*fac_shield(j)
3376 a_temp(1,1)=aggj1(l,1)
3377 a_temp(1,2)=aggj1(l,2)
3378 a_temp(2,1)=aggj1(l,3)
3379 a_temp(2,2)=aggj1(l,4)
3380 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3381 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3382 s1=scalar2(b1(1,iti2),auxvec(1))
3383 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3384 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3385 s2=scalar2(b1(1,iti1),auxvec(1))
3386 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3387 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3388 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3389 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3390 & *fac_shield(i)*fac_shield(j)
3398 C-----------------------------------------------------------------------------
3399 subroutine vecpr(u,v,w)
3400 implicit real*8(a-h,o-z)
3401 dimension u(3),v(3),w(3)
3402 w(1)=u(2)*v(3)-u(3)*v(2)
3403 w(2)=-u(1)*v(3)+u(3)*v(1)
3404 w(3)=u(1)*v(2)-u(2)*v(1)
3407 C-----------------------------------------------------------------------------
3408 subroutine unormderiv(u,ugrad,unorm,ungrad)
3409 C This subroutine computes the derivatives of a normalized vector u, given
3410 C the derivatives computed without normalization conditions, ugrad. Returns
3413 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3414 double precision vec(3)
3415 double precision scalar
3417 c write (2,*) 'ugrad',ugrad
3420 vec(i)=scalar(ugrad(1,i),u(1))
3422 c write (2,*) 'vec',vec
3425 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3428 c write (2,*) 'ungrad',ungrad
3431 C-----------------------------------------------------------------------------
3432 subroutine escp(evdw2,evdw2_14)
3434 C This subroutine calculates the excluded-volume interaction energy between
3435 C peptide-group centers and side chains and its gradient in virtual-bond and
3436 C side-chain vectors.
3438 implicit real*8 (a-h,o-z)
3439 include 'DIMENSIONS'
3440 include 'DIMENSIONS.ZSCOPT'
3441 include 'COMMON.GEO'
3442 include 'COMMON.VAR'
3443 include 'COMMON.LOCAL'
3444 include 'COMMON.CHAIN'
3445 include 'COMMON.DERIV'
3446 include 'COMMON.INTERACT'
3447 include 'COMMON.FFIELD'
3448 include 'COMMON.IOUNITS'
3452 cd print '(a)','Enter ESCP'
3453 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3454 c & ' scal14',scal14
3455 do i=iatscp_s,iatscp_e
3456 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3458 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3459 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3460 if (iteli.eq.0) goto 1225
3461 xi=0.5D0*(c(1,i)+c(1,i+1))
3462 yi=0.5D0*(c(2,i)+c(2,i+1))
3463 zi=0.5D0*(c(3,i)+c(3,i+1))
3464 C Returning the ith atom to box
3466 if (xi.lt.0) xi=xi+boxxsize
3468 if (yi.lt.0) yi=yi+boxysize
3470 if (zi.lt.0) zi=zi+boxzsize
3471 do iint=1,nscp_gr(i)
3473 do j=iscpstart(i,iint),iscpend(i,iint)
3474 itypj=iabs(itype(j))
3475 if (itypj.eq.ntyp1) cycle
3476 C Uncomment following three lines for SC-p interactions
3480 C Uncomment following three lines for Ca-p interactions
3484 C returning the jth atom to box
3486 if (xj.lt.0) xj=xj+boxxsize
3488 if (yj.lt.0) yj=yj+boxysize
3490 if (zj.lt.0) zj=zj+boxzsize
3491 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3496 C Finding the closest jth atom
3500 xj=xj_safe+xshift*boxxsize
3501 yj=yj_safe+yshift*boxysize
3502 zj=zj_safe+zshift*boxzsize
3503 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3504 if(dist_temp.lt.dist_init) then
3514 if (subchap.eq.1) then
3523 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3524 C sss is scaling function for smoothing the cutoff gradient otherwise
3525 C the gradient would not be continuouse
3526 sss=sscale(1.0d0/(dsqrt(rrij)))
3527 if (sss.le.0.0d0) cycle
3528 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3530 e1=fac*fac*aad(itypj,iteli)
3531 e2=fac*bad(itypj,iteli)
3532 if (iabs(j-i) .le. 2) then
3535 evdw2_14=evdw2_14+(e1+e2)*sss
3538 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3539 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3540 c & bad(itypj,iteli)
3541 evdw2=evdw2+evdwij*sss
3544 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3546 fac=-(evdwij+e1)*rrij*sss
3547 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3552 cd write (iout,*) 'j<i'
3553 C Uncomment following three lines for SC-p interactions
3555 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3558 cd write (iout,*) 'j>i'
3561 C Uncomment following line for SC-p interactions
3562 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3566 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3570 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3571 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3574 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3584 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3585 gradx_scp(j,i)=expon*gradx_scp(j,i)
3588 C******************************************************************************
3592 C To save time the factor EXPON has been extracted from ALL components
3593 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3596 C******************************************************************************
3599 C--------------------------------------------------------------------------
3600 subroutine edis(ehpb)
3602 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3604 implicit real*8 (a-h,o-z)
3605 include 'DIMENSIONS'
3606 include 'DIMENSIONS.ZSCOPT'
3607 include 'COMMON.SBRIDGE'
3608 include 'COMMON.CHAIN'
3609 include 'COMMON.DERIV'
3610 include 'COMMON.VAR'
3611 include 'COMMON.INTERACT'
3612 include 'COMMON.CONTROL'
3613 include 'COMMON.IOUNITS'
3616 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3617 cd print *,'link_start=',link_start,' link_end=',link_end
3618 C write(iout,*) link_end, "link_end"
3619 if (link_end.eq.0) return
3620 do i=link_start,link_end
3621 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3622 C CA-CA distance used in regularization of structure.
3625 C iii and jjj point to the residues for which the distance is assigned.
3626 if (ii.gt.nres) then
3633 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3634 C distance and angle dependent SS bond potential.
3635 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3636 C & iabs(itype(jjj)).eq.1) then
3637 C write(iout,*) constr_dist,"const"
3638 if (.not.dyn_ss .and. i.le.nss) then
3639 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3640 & iabs(itype(jjj)).eq.1) then
3641 call ssbond_ene(iii,jjj,eij)
3644 else if (ii.gt.nres .and. jj.gt.nres) then
3645 c Restraints from contact prediction
3647 if (constr_dist.eq.11) then
3648 C ehpb=ehpb+fordepth(i)**4.0d0
3649 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3650 ehpb=ehpb+fordepth(i)**4.0d0
3651 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3652 fac=fordepth(i)**4.0d0
3653 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3654 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3655 C & ehpb,fordepth(i),dd
3656 C write(iout,*) ehpb,"atu?"
3658 C fac=fordepth(i)**4.0d0
3659 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3661 if (dhpb1(i).gt.0.0d0) then
3662 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3663 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3664 c write (iout,*) "beta nmr",
3665 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3669 C Get the force constant corresponding to this distance.
3671 C Calculate the contribution to energy.
3672 ehpb=ehpb+waga*rdis*rdis
3673 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3675 C Evaluate gradient.
3678 endif !end dhpb1(i).gt.0
3679 endif !end const_dist=11
3681 ggg(j)=fac*(c(j,jj)-c(j,ii))
3684 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3685 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3688 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3689 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3692 C write(iout,*) "before"
3694 C write(iout,*) "after",dd
3695 if (constr_dist.eq.11) then
3696 ehpb=ehpb+fordepth(i)**4.0d0
3697 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3698 fac=fordepth(i)**4.0d0
3699 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3700 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3701 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3702 C print *,ehpb,"tu?"
3703 C write(iout,*) ehpb,"btu?",
3704 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3705 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3706 C & ehpb,fordepth(i),dd
3708 if (dhpb1(i).gt.0.0d0) then
3709 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3710 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3711 c write (iout,*) "alph nmr",
3712 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3715 C Get the force constant corresponding to this distance.
3717 C Calculate the contribution to energy.
3718 ehpb=ehpb+waga*rdis*rdis
3719 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3721 C Evaluate gradient.
3728 ggg(j)=fac*(c(j,jj)-c(j,ii))
3730 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3731 C If this is a SC-SC distance, we need to calculate the contributions to the
3732 C Cartesian gradient in the SC vectors (ghpbx).
3735 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3736 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3741 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3746 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3749 C--------------------------------------------------------------------------
3750 subroutine ssbond_ene(i,j,eij)
3752 C Calculate the distance and angle dependent SS-bond potential energy
3753 C using a free-energy function derived based on RHF/6-31G** ab initio
3754 C calculations of diethyl disulfide.
3756 C A. Liwo and U. Kozlowska, 11/24/03
3758 implicit real*8 (a-h,o-z)
3759 include 'DIMENSIONS'
3760 include 'DIMENSIONS.ZSCOPT'
3761 include 'COMMON.SBRIDGE'
3762 include 'COMMON.CHAIN'
3763 include 'COMMON.DERIV'
3764 include 'COMMON.LOCAL'
3765 include 'COMMON.INTERACT'
3766 include 'COMMON.VAR'
3767 include 'COMMON.IOUNITS'
3768 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3769 itypi=iabs(itype(i))
3773 dxi=dc_norm(1,nres+i)
3774 dyi=dc_norm(2,nres+i)
3775 dzi=dc_norm(3,nres+i)
3776 dsci_inv=dsc_inv(itypi)
3777 itypj=iabs(itype(j))
3778 dscj_inv=dsc_inv(itypj)
3782 dxj=dc_norm(1,nres+j)
3783 dyj=dc_norm(2,nres+j)
3784 dzj=dc_norm(3,nres+j)
3785 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3790 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3791 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3792 om12=dxi*dxj+dyi*dyj+dzi*dzj
3794 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3795 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3801 deltat12=om2-om1+2.0d0
3803 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3804 & +akct*deltad*deltat12
3805 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3806 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3807 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3808 c & " deltat12",deltat12," eij",eij
3809 ed=2*akcm*deltad+akct*deltat12
3811 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3812 eom1=-2*akth*deltat1-pom1-om2*pom2
3813 eom2= 2*akth*deltat2+pom1-om1*pom2
3816 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3819 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3820 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3821 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3822 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3825 C Calculate the components of the gradient in DC and X
3829 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3834 C--------------------------------------------------------------------------
3835 subroutine ebond(estr)
3837 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3839 implicit real*8 (a-h,o-z)
3840 include 'DIMENSIONS'
3841 include 'DIMENSIONS.ZSCOPT'
3842 include 'COMMON.LOCAL'
3843 include 'COMMON.GEO'
3844 include 'COMMON.INTERACT'
3845 include 'COMMON.DERIV'
3846 include 'COMMON.VAR'
3847 include 'COMMON.CHAIN'
3848 include 'COMMON.IOUNITS'
3849 include 'COMMON.NAMES'
3850 include 'COMMON.FFIELD'
3851 include 'COMMON.CONTROL'
3852 logical energy_dec /.false./
3853 double precision u(3),ud(3)
3856 c write (iout,*) "distchainmax",distchainmax
3858 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3859 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3861 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3862 C & *dc(j,i-1)/vbld(i)
3864 C if (energy_dec) write(iout,*)
3865 C & "estr1",i,vbld(i),distchainmax,
3866 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3868 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3869 diff = vbld(i)-vbldpDUM
3870 C write(iout,*) i,diff
3872 diff = vbld(i)-vbldp0
3873 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3877 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3880 C write (iout,'(a7,i5,4f7.3)')
3881 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3883 estr=0.5d0*AKP*estr+estr1
3885 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3889 if (iti.ne.10 .and. iti.ne.ntyp1) then
3892 diff=vbld(i+nres)-vbldsc0(1,iti)
3893 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3894 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3895 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3897 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3901 diff=vbld(i+nres)-vbldsc0(j,iti)
3902 ud(j)=aksc(j,iti)*diff
3903 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3917 uprod2=uprod2*u(k)*u(k)
3921 usumsqder=usumsqder+ud(j)*uprod2
3923 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3924 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3925 estr=estr+uprod/usum
3927 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3935 C--------------------------------------------------------------------------
3936 subroutine ebend(etheta,ethetacnstr)
3938 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3939 C angles gamma and its derivatives in consecutive thetas and gammas.
3941 implicit real*8 (a-h,o-z)
3942 include 'DIMENSIONS'
3943 include 'DIMENSIONS.ZSCOPT'
3944 include 'COMMON.LOCAL'
3945 include 'COMMON.GEO'
3946 include 'COMMON.INTERACT'
3947 include 'COMMON.DERIV'
3948 include 'COMMON.VAR'
3949 include 'COMMON.CHAIN'
3950 include 'COMMON.IOUNITS'
3951 include 'COMMON.NAMES'
3952 include 'COMMON.FFIELD'
3953 include 'COMMON.TORCNSTR'
3954 common /calcthet/ term1,term2,termm,diffak,ratak,
3955 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3956 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3957 double precision y(2),z(2)
3959 c time11=dexp(-2*time)
3962 c write (iout,*) "nres",nres
3963 c write (*,'(a,i2)') 'EBEND ICG=',icg
3964 c write (iout,*) ithet_start,ithet_end
3965 do i=ithet_start,ithet_end
3966 C if (itype(i-1).eq.ntyp1) cycle
3968 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3969 & .or.itype(i).eq.ntyp1) cycle
3970 C Zero the energy function and its derivative at 0 or pi.
3971 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3973 ichir1=isign(1,itype(i-2))
3974 ichir2=isign(1,itype(i))
3975 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3976 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3977 if (itype(i-1).eq.10) then
3978 itype1=isign(10,itype(i-2))
3979 ichir11=isign(1,itype(i-2))
3980 ichir12=isign(1,itype(i-2))
3981 itype2=isign(10,itype(i))
3982 ichir21=isign(1,itype(i))
3983 ichir22=isign(1,itype(i))
3990 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3994 c call proc_proc(phii,icrc)
3995 if (icrc.eq.1) phii=150.0
4006 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4010 c call proc_proc(phii1,icrc)
4011 if (icrc.eq.1) phii1=150.0
4023 C Calculate the "mean" value of theta from the part of the distribution
4024 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4025 C In following comments this theta will be referred to as t_c.
4026 thet_pred_mean=0.0d0
4028 athetk=athet(k,it,ichir1,ichir2)
4029 bthetk=bthet(k,it,ichir1,ichir2)
4031 athetk=athet(k,itype1,ichir11,ichir12)
4032 bthetk=bthet(k,itype2,ichir21,ichir22)
4034 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4036 c write (iout,*) "thet_pred_mean",thet_pred_mean
4037 dthett=thet_pred_mean*ssd
4038 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4039 c write (iout,*) "thet_pred_mean",thet_pred_mean
4040 C Derivatives of the "mean" values in gamma1 and gamma2.
4041 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4042 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4043 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4044 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4046 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4047 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4048 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4049 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4051 if (theta(i).gt.pi-delta) then
4052 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4054 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4055 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4056 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4058 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4060 else if (theta(i).lt.delta) then
4061 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4062 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4063 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4065 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4066 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4069 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4072 etheta=etheta+ethetai
4073 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4074 c & 'ebend',i,ethetai,theta(i),itype(i)
4075 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4076 c & rad2deg*phii,rad2deg*phii1,ethetai
4077 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4078 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4079 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4083 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4084 do i=1,ntheta_constr
4085 itheta=itheta_constr(i)
4086 thetiii=theta(itheta)
4087 difi=pinorm(thetiii-theta_constr0(i))
4088 if (difi.gt.theta_drange(i)) then
4089 difi=difi-theta_drange(i)
4090 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4091 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4092 & +for_thet_constr(i)*difi**3
4093 else if (difi.lt.-drange(i)) then
4095 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4096 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4097 & +for_thet_constr(i)*difi**3
4101 C if (energy_dec) then
4102 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4103 C & i,itheta,rad2deg*thetiii,
4104 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4105 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4106 C & gloc(itheta+nphi-2,icg)
4109 C Ufff.... We've done all this!!!
4112 C---------------------------------------------------------------------------
4113 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4115 implicit real*8 (a-h,o-z)
4116 include 'DIMENSIONS'
4117 include 'COMMON.LOCAL'
4118 include 'COMMON.IOUNITS'
4119 common /calcthet/ term1,term2,termm,diffak,ratak,
4120 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4121 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4122 C Calculate the contributions to both Gaussian lobes.
4123 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4124 C The "polynomial part" of the "standard deviation" of this part of
4128 sig=sig*thet_pred_mean+polthet(j,it)
4130 C Derivative of the "interior part" of the "standard deviation of the"
4131 C gamma-dependent Gaussian lobe in t_c.
4132 sigtc=3*polthet(3,it)
4134 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4137 C Set the parameters of both Gaussian lobes of the distribution.
4138 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4139 fac=sig*sig+sigc0(it)
4142 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4143 sigsqtc=-4.0D0*sigcsq*sigtc
4144 c print *,i,sig,sigtc,sigsqtc
4145 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4146 sigtc=-sigtc/(fac*fac)
4147 C Following variable is sigma(t_c)**(-2)
4148 sigcsq=sigcsq*sigcsq
4150 sig0inv=1.0D0/sig0i**2
4151 delthec=thetai-thet_pred_mean
4152 delthe0=thetai-theta0i
4153 term1=-0.5D0*sigcsq*delthec*delthec
4154 term2=-0.5D0*sig0inv*delthe0*delthe0
4155 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4156 C NaNs in taking the logarithm. We extract the largest exponent which is added
4157 C to the energy (this being the log of the distribution) at the end of energy
4158 C term evaluation for this virtual-bond angle.
4159 if (term1.gt.term2) then
4161 term2=dexp(term2-termm)
4165 term1=dexp(term1-termm)
4168 C The ratio between the gamma-independent and gamma-dependent lobes of
4169 C the distribution is a Gaussian function of thet_pred_mean too.
4170 diffak=gthet(2,it)-thet_pred_mean
4171 ratak=diffak/gthet(3,it)**2
4172 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4173 C Let's differentiate it in thet_pred_mean NOW.
4175 C Now put together the distribution terms to make complete distribution.
4176 termexp=term1+ak*term2
4177 termpre=sigc+ak*sig0i
4178 C Contribution of the bending energy from this theta is just the -log of
4179 C the sum of the contributions from the two lobes and the pre-exponential
4180 C factor. Simple enough, isn't it?
4181 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4182 C NOW the derivatives!!!
4183 C 6/6/97 Take into account the deformation.
4184 E_theta=(delthec*sigcsq*term1
4185 & +ak*delthe0*sig0inv*term2)/termexp
4186 E_tc=((sigtc+aktc*sig0i)/termpre
4187 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4188 & aktc*term2)/termexp)
4191 c-----------------------------------------------------------------------------
4192 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4193 implicit real*8 (a-h,o-z)
4194 include 'DIMENSIONS'
4195 include 'COMMON.LOCAL'
4196 include 'COMMON.IOUNITS'
4197 common /calcthet/ term1,term2,termm,diffak,ratak,
4198 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4199 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4200 delthec=thetai-thet_pred_mean
4201 delthe0=thetai-theta0i
4202 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4203 t3 = thetai-thet_pred_mean
4207 t14 = t12+t6*sigsqtc
4209 t21 = thetai-theta0i
4215 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4216 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4217 & *(-t12*t9-ak*sig0inv*t27)
4221 C--------------------------------------------------------------------------
4222 subroutine ebend(etheta,ethetacnstr)
4224 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4225 C angles gamma and its derivatives in consecutive thetas and gammas.
4226 C ab initio-derived potentials from
4227 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4229 implicit real*8 (a-h,o-z)
4230 include 'DIMENSIONS'
4231 include 'DIMENSIONS.ZSCOPT'
4232 include 'COMMON.LOCAL'
4233 include 'COMMON.GEO'
4234 include 'COMMON.INTERACT'
4235 include 'COMMON.DERIV'
4236 include 'COMMON.VAR'
4237 include 'COMMON.CHAIN'
4238 include 'COMMON.IOUNITS'
4239 include 'COMMON.NAMES'
4240 include 'COMMON.FFIELD'
4241 include 'COMMON.CONTROL'
4242 include 'COMMON.TORCNSTR'
4243 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4244 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4245 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4246 & sinph1ph2(maxdouble,maxdouble)
4247 logical lprn /.false./, lprn1 /.false./
4249 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4250 do i=ithet_start,ithet_end
4252 C if (itype(i-1).eq.ntyp1) cycle
4254 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4255 & .or.itype(i).eq.ntyp1) cycle
4256 if (iabs(itype(i+1)).eq.20) iblock=2
4257 if (iabs(itype(i+1)).ne.20) iblock=1
4261 theti2=0.5d0*theta(i)
4262 ityp2=ithetyp((itype(i-1)))
4264 coskt(k)=dcos(k*theti2)
4265 sinkt(k)=dsin(k*theti2)
4275 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4278 if (phii.ne.phii) phii=150.0
4282 ityp1=ithetyp((itype(i-2)))
4284 cosph1(k)=dcos(k*phii)
4285 sinph1(k)=dsin(k*phii)
4291 ityp1=ithetyp((itype(i-2)))
4297 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4300 if (phii1.ne.phii1) phii1=150.0
4305 ityp3=ithetyp((itype(i)))
4307 cosph2(k)=dcos(k*phii1)
4308 sinph2(k)=dsin(k*phii1)
4313 ityp3=ithetyp((itype(i)))
4319 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4320 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4322 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4325 ccl=cosph1(l)*cosph2(k-l)
4326 ssl=sinph1(l)*sinph2(k-l)
4327 scl=sinph1(l)*cosph2(k-l)
4328 csl=cosph1(l)*sinph2(k-l)
4329 cosph1ph2(l,k)=ccl-ssl
4330 cosph1ph2(k,l)=ccl+ssl
4331 sinph1ph2(l,k)=scl+csl
4332 sinph1ph2(k,l)=scl-csl
4336 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4337 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4338 write (iout,*) "coskt and sinkt"
4340 write (iout,*) k,coskt(k),sinkt(k)
4344 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4345 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4348 & write (iout,*) "k",k,"
4349 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4350 & " ethetai",ethetai
4353 write (iout,*) "cosph and sinph"
4355 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4357 write (iout,*) "cosph1ph2 and sinph2ph2"
4360 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4361 & sinph1ph2(l,k),sinph1ph2(k,l)
4364 write(iout,*) "ethetai",ethetai
4368 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4369 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4370 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4371 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4372 ethetai=ethetai+sinkt(m)*aux
4373 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4374 dephii=dephii+k*sinkt(m)*(
4375 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4376 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4377 dephii1=dephii1+k*sinkt(m)*(
4378 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4379 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4381 & write (iout,*) "m",m," k",k," bbthet",
4382 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4383 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4384 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4385 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4389 & write(iout,*) "ethetai",ethetai
4393 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4394 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4395 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4396 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4397 ethetai=ethetai+sinkt(m)*aux
4398 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4399 dephii=dephii+l*sinkt(m)*(
4400 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4401 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4402 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4403 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4404 dephii1=dephii1+(k-l)*sinkt(m)*(
4405 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4406 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4407 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4408 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4410 write (iout,*) "m",m," k",k," l",l," ffthet",
4411 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4412 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4413 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4414 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4415 & " ethetai",ethetai
4416 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4417 & cosph1ph2(k,l)*sinkt(m),
4418 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4424 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4425 & i,theta(i)*rad2deg,phii*rad2deg,
4426 & phii1*rad2deg,ethetai
4427 etheta=etheta+ethetai
4428 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4429 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4430 c gloc(nphi+i-2,icg)=wang*dethetai
4431 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4435 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4436 do i=1,ntheta_constr
4437 itheta=itheta_constr(i)
4438 thetiii=theta(itheta)
4439 difi=pinorm(thetiii-theta_constr0(i))
4440 if (difi.gt.theta_drange(i)) then
4441 difi=difi-theta_drange(i)
4442 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4443 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4444 & +for_thet_constr(i)*difi**3
4445 else if (difi.lt.-drange(i)) then
4447 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4448 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4449 & +for_thet_constr(i)*difi**3
4453 C if (energy_dec) then
4454 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4455 C & i,itheta,rad2deg*thetiii,
4456 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4457 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4458 C & gloc(itheta+nphi-2,icg)
4465 c-----------------------------------------------------------------------------
4466 subroutine esc(escloc)
4467 C Calculate the local energy of a side chain and its derivatives in the
4468 C corresponding virtual-bond valence angles THETA and the spherical angles
4470 implicit real*8 (a-h,o-z)
4471 include 'DIMENSIONS'
4472 include 'DIMENSIONS.ZSCOPT'
4473 include 'COMMON.GEO'
4474 include 'COMMON.LOCAL'
4475 include 'COMMON.VAR'
4476 include 'COMMON.INTERACT'
4477 include 'COMMON.DERIV'
4478 include 'COMMON.CHAIN'
4479 include 'COMMON.IOUNITS'
4480 include 'COMMON.NAMES'
4481 include 'COMMON.FFIELD'
4482 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4483 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4484 common /sccalc/ time11,time12,time112,theti,it,nlobit
4487 C write (iout,*) 'ESC'
4488 do i=loc_start,loc_end
4490 if (it.eq.ntyp1) cycle
4491 if (it.eq.10) goto 1
4492 nlobit=nlob(iabs(it))
4493 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4494 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4495 theti=theta(i+1)-pipol
4499 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4501 if (x(2).gt.pi-delta) then
4505 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4507 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4508 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4510 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4511 & ddersc0(1),dersc(1))
4512 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4513 & ddersc0(3),dersc(3))
4515 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4517 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4518 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4519 & dersc0(2),esclocbi,dersc02)
4520 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4522 call splinthet(x(2),0.5d0*delta,ss,ssd)
4527 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4529 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4530 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4532 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4534 c write (iout,*) escloci
4535 else if (x(2).lt.delta) then
4539 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4541 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4542 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4544 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4545 & ddersc0(1),dersc(1))
4546 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4547 & ddersc0(3),dersc(3))
4549 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4551 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4552 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4553 & dersc0(2),esclocbi,dersc02)
4554 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4559 call splinthet(x(2),0.5d0*delta,ss,ssd)
4561 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4563 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4564 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4566 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4567 C write (iout,*) 'i=',i, escloci
4569 call enesc(x,escloci,dersc,ddummy,.false.)
4572 escloc=escloc+escloci
4573 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4574 write (iout,'(a6,i5,0pf7.3)')
4575 & 'escloc',i,escloci
4577 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4579 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4580 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4585 C---------------------------------------------------------------------------
4586 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4587 implicit real*8 (a-h,o-z)
4588 include 'DIMENSIONS'
4589 include 'COMMON.GEO'
4590 include 'COMMON.LOCAL'
4591 include 'COMMON.IOUNITS'
4592 common /sccalc/ time11,time12,time112,theti,it,nlobit
4593 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4594 double precision contr(maxlob,-1:1)
4596 c write (iout,*) 'it=',it,' nlobit=',nlobit
4600 if (mixed) ddersc(j)=0.0d0
4604 C Because of periodicity of the dependence of the SC energy in omega we have
4605 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4606 C To avoid underflows, first compute & store the exponents.
4614 z(k)=x(k)-censc(k,j,it)
4619 Axk=Axk+gaussc(l,k,j,it)*z(l)
4625 expfac=expfac+Ax(k,j,iii)*z(k)
4633 C As in the case of ebend, we want to avoid underflows in exponentiation and
4634 C subsequent NaNs and INFs in energy calculation.
4635 C Find the largest exponent
4639 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4643 cd print *,'it=',it,' emin=',emin
4645 C Compute the contribution to SC energy and derivatives
4649 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4650 cd print *,'j=',j,' expfac=',expfac
4651 escloc_i=escloc_i+expfac
4653 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4657 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4658 & +gaussc(k,2,j,it))*expfac
4665 dersc(1)=dersc(1)/cos(theti)**2
4666 ddersc(1)=ddersc(1)/cos(theti)**2
4669 escloci=-(dlog(escloc_i)-emin)
4671 dersc(j)=dersc(j)/escloc_i
4675 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4680 C------------------------------------------------------------------------------
4681 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'COMMON.GEO'
4685 include 'COMMON.LOCAL'
4686 include 'COMMON.IOUNITS'
4687 common /sccalc/ time11,time12,time112,theti,it,nlobit
4688 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4689 double precision contr(maxlob)
4700 z(k)=x(k)-censc(k,j,it)
4706 Axk=Axk+gaussc(l,k,j,it)*z(l)
4712 expfac=expfac+Ax(k,j)*z(k)
4717 C As in the case of ebend, we want to avoid underflows in exponentiation and
4718 C subsequent NaNs and INFs in energy calculation.
4719 C Find the largest exponent
4722 if (emin.gt.contr(j)) emin=contr(j)
4726 C Compute the contribution to SC energy and derivatives
4730 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4731 escloc_i=escloc_i+expfac
4733 dersc(k)=dersc(k)+Ax(k,j)*expfac
4735 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4736 & +gaussc(1,2,j,it))*expfac
4740 dersc(1)=dersc(1)/cos(theti)**2
4741 dersc12=dersc12/cos(theti)**2
4742 escloci=-(dlog(escloc_i)-emin)
4744 dersc(j)=dersc(j)/escloc_i
4746 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4750 c----------------------------------------------------------------------------------
4751 subroutine esc(escloc)
4752 C Calculate the local energy of a side chain and its derivatives in the
4753 C corresponding virtual-bond valence angles THETA and the spherical angles
4754 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4755 C added by Urszula Kozlowska. 07/11/2007
4757 implicit real*8 (a-h,o-z)
4758 include 'DIMENSIONS'
4759 include 'DIMENSIONS.ZSCOPT'
4760 include 'COMMON.GEO'
4761 include 'COMMON.LOCAL'
4762 include 'COMMON.VAR'
4763 include 'COMMON.SCROT'
4764 include 'COMMON.INTERACT'
4765 include 'COMMON.DERIV'
4766 include 'COMMON.CHAIN'
4767 include 'COMMON.IOUNITS'
4768 include 'COMMON.NAMES'
4769 include 'COMMON.FFIELD'
4770 include 'COMMON.CONTROL'
4771 include 'COMMON.VECTORS'
4772 double precision x_prime(3),y_prime(3),z_prime(3)
4773 & , sumene,dsc_i,dp2_i,x(65),
4774 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4775 & de_dxx,de_dyy,de_dzz,de_dt
4776 double precision s1_t,s1_6_t,s2_t,s2_6_t
4778 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4779 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4780 & dt_dCi(3),dt_dCi1(3)
4781 common /sccalc/ time11,time12,time112,theti,it,nlobit
4784 do i=loc_start,loc_end
4785 if (itype(i).eq.ntyp1) cycle
4786 costtab(i+1) =dcos(theta(i+1))
4787 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4788 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4789 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4790 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4791 cosfac=dsqrt(cosfac2)
4792 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4793 sinfac=dsqrt(sinfac2)
4795 if (it.eq.10) goto 1
4797 C Compute the axes of tghe local cartesian coordinates system; store in
4798 c x_prime, y_prime and z_prime
4805 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4806 C & dc_norm(3,i+nres)
4808 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4809 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4812 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4815 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4816 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4817 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4818 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4819 c & " xy",scalar(x_prime(1),y_prime(1)),
4820 c & " xz",scalar(x_prime(1),z_prime(1)),
4821 c & " yy",scalar(y_prime(1),y_prime(1)),
4822 c & " yz",scalar(y_prime(1),z_prime(1)),
4823 c & " zz",scalar(z_prime(1),z_prime(1))
4825 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4826 C to local coordinate system. Store in xx, yy, zz.
4832 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4833 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4834 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4841 C Compute the energy of the ith side cbain
4843 c write (2,*) "xx",xx," yy",yy," zz",zz
4846 x(j) = sc_parmin(j,it)
4849 Cc diagnostics - remove later
4851 yy1 = dsin(alph(2))*dcos(omeg(2))
4852 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4853 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4854 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4856 C," --- ", xx_w,yy_w,zz_w
4859 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4860 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4862 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4863 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4865 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4866 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4867 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4868 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4869 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4871 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4872 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4873 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4874 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4875 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4877 dsc_i = 0.743d0+x(61)
4879 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4880 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4881 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4882 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4883 s1=(1+x(63))/(0.1d0 + dscp1)
4884 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4885 s2=(1+x(65))/(0.1d0 + dscp2)
4886 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4887 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4888 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4889 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4891 c & dscp1,dscp2,sumene
4892 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4893 escloc = escloc + sumene
4894 c write (2,*) "escloc",escloc
4895 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4897 if (.not. calc_grad) goto 1
4900 C This section to check the numerical derivatives of the energy of ith side
4901 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4902 C #define DEBUG in the code to turn it on.
4904 write (2,*) "sumene =",sumene
4908 write (2,*) xx,yy,zz
4909 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4910 de_dxx_num=(sumenep-sumene)/aincr
4912 write (2,*) "xx+ sumene from enesc=",sumenep
4915 write (2,*) xx,yy,zz
4916 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4917 de_dyy_num=(sumenep-sumene)/aincr
4919 write (2,*) "yy+ sumene from enesc=",sumenep
4922 write (2,*) xx,yy,zz
4923 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4924 de_dzz_num=(sumenep-sumene)/aincr
4926 write (2,*) "zz+ sumene from enesc=",sumenep
4927 costsave=cost2tab(i+1)
4928 sintsave=sint2tab(i+1)
4929 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4930 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4931 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4932 de_dt_num=(sumenep-sumene)/aincr
4933 write (2,*) " t+ sumene from enesc=",sumenep
4934 cost2tab(i+1)=costsave
4935 sint2tab(i+1)=sintsave
4936 C End of diagnostics section.
4939 C Compute the gradient of esc
4941 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4942 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4943 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4944 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4945 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4946 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4947 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4948 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4949 pom1=(sumene3*sint2tab(i+1)+sumene1)
4950 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4951 pom2=(sumene4*cost2tab(i+1)+sumene2)
4952 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4953 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4954 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4955 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4957 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4958 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4959 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4961 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4962 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4963 & +(pom1+pom2)*pom_dx
4965 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4968 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4969 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4970 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4972 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4973 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4974 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4975 & +x(59)*zz**2 +x(60)*xx*zz
4976 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4977 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4978 & +(pom1-pom2)*pom_dy
4980 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4983 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4984 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4985 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4986 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4987 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4988 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4989 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4990 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4992 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4995 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4996 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4997 & +pom1*pom_dt1+pom2*pom_dt2
4999 write(2,*), "de_dt = ", de_dt,de_dt_num
5003 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5004 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5005 cosfac2xx=cosfac2*xx
5006 sinfac2yy=sinfac2*yy
5008 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5010 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5012 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5013 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5014 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5015 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5016 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5017 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5018 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5019 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5020 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5021 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5025 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5026 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5027 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5028 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5031 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5032 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5033 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5035 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5036 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5040 dXX_Ctab(k,i)=dXX_Ci(k)
5041 dXX_C1tab(k,i)=dXX_Ci1(k)
5042 dYY_Ctab(k,i)=dYY_Ci(k)
5043 dYY_C1tab(k,i)=dYY_Ci1(k)
5044 dZZ_Ctab(k,i)=dZZ_Ci(k)
5045 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5046 dXX_XYZtab(k,i)=dXX_XYZ(k)
5047 dYY_XYZtab(k,i)=dYY_XYZ(k)
5048 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5052 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5053 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5054 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5055 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5056 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5058 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5059 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5060 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5061 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5062 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5063 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5064 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5065 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5067 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5068 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5070 C to check gradient call subroutine check_grad
5077 c------------------------------------------------------------------------------
5078 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5080 C This procedure calculates two-body contact function g(rij) and its derivative:
5083 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5086 C where x=(rij-r0ij)/delta
5088 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5091 double precision rij,r0ij,eps0ij,fcont,fprimcont
5092 double precision x,x2,x4,delta
5096 if (x.lt.-1.0D0) then
5099 else if (x.le.1.0D0) then
5102 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5103 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5110 c------------------------------------------------------------------------------
5111 subroutine splinthet(theti,delta,ss,ssder)
5112 implicit real*8 (a-h,o-z)
5113 include 'DIMENSIONS'
5114 include 'DIMENSIONS.ZSCOPT'
5115 include 'COMMON.VAR'
5116 include 'COMMON.GEO'
5119 if (theti.gt.pipol) then
5120 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5122 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5127 c------------------------------------------------------------------------------
5128 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5130 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5131 double precision ksi,ksi2,ksi3,a1,a2,a3
5132 a1=fprim0*delta/(f1-f0)
5138 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5139 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5142 c------------------------------------------------------------------------------
5143 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5145 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5146 double precision ksi,ksi2,ksi3,a1,a2,a3
5151 a2=3*(f1x-f0x)-2*fprim0x*delta
5152 a3=fprim0x*delta-2*(f1x-f0x)
5153 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5156 C-----------------------------------------------------------------------------
5158 C-----------------------------------------------------------------------------
5159 subroutine etor(etors,edihcnstr,fact)
5160 implicit real*8 (a-h,o-z)
5161 include 'DIMENSIONS'
5162 include 'DIMENSIONS.ZSCOPT'
5163 include 'COMMON.VAR'
5164 include 'COMMON.GEO'
5165 include 'COMMON.LOCAL'
5166 include 'COMMON.TORSION'
5167 include 'COMMON.INTERACT'
5168 include 'COMMON.DERIV'
5169 include 'COMMON.CHAIN'
5170 include 'COMMON.NAMES'
5171 include 'COMMON.IOUNITS'
5172 include 'COMMON.FFIELD'
5173 include 'COMMON.TORCNSTR'
5175 C Set lprn=.true. for debugging
5179 do i=iphi_start,iphi_end
5180 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5181 & .or. itype(i).eq.ntyp1) cycle
5182 itori=itortyp(itype(i-2))
5183 itori1=itortyp(itype(i-1))
5186 C Proline-Proline pair is a special case...
5187 if (itori.eq.3 .and. itori1.eq.3) then
5188 if (phii.gt.-dwapi3) then
5190 fac=1.0D0/(1.0D0-cosphi)
5191 etorsi=v1(1,3,3)*fac
5192 etorsi=etorsi+etorsi
5193 etors=etors+etorsi-v1(1,3,3)
5194 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5197 v1ij=v1(j+1,itori,itori1)
5198 v2ij=v2(j+1,itori,itori1)
5201 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5202 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5206 v1ij=v1(j,itori,itori1)
5207 v2ij=v2(j,itori,itori1)
5210 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5211 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5215 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5216 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5217 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5218 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5219 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5221 ! 6/20/98 - dihedral angle constraints
5224 itori=idih_constr(i)
5227 if (difi.gt.drange(i)) then
5229 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5230 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5231 else if (difi.lt.-drange(i)) then
5233 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5234 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5236 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5237 C & i,itori,rad2deg*phii,
5238 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5240 ! write (iout,*) 'edihcnstr',edihcnstr
5243 c------------------------------------------------------------------------------
5245 subroutine etor(etors,edihcnstr,fact)
5246 implicit real*8 (a-h,o-z)
5247 include 'DIMENSIONS'
5248 include 'DIMENSIONS.ZSCOPT'
5249 include 'COMMON.VAR'
5250 include 'COMMON.GEO'
5251 include 'COMMON.LOCAL'
5252 include 'COMMON.TORSION'
5253 include 'COMMON.INTERACT'
5254 include 'COMMON.DERIV'
5255 include 'COMMON.CHAIN'
5256 include 'COMMON.NAMES'
5257 include 'COMMON.IOUNITS'
5258 include 'COMMON.FFIELD'
5259 include 'COMMON.TORCNSTR'
5261 C Set lprn=.true. for debugging
5265 do i=iphi_start,iphi_end
5267 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5268 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5269 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5270 C & .or. itype(i).eq.ntyp1) cycle
5271 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5272 if (iabs(itype(i)).eq.20) then
5277 itori=itortyp(itype(i-2))
5278 itori1=itortyp(itype(i-1))
5281 C Regular cosine and sine terms
5282 do j=1,nterm(itori,itori1,iblock)
5283 v1ij=v1(j,itori,itori1,iblock)
5284 v2ij=v2(j,itori,itori1,iblock)
5287 etors=etors+v1ij*cosphi+v2ij*sinphi
5288 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5292 C E = SUM ----------------------------------- - v1
5293 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5295 cosphi=dcos(0.5d0*phii)
5296 sinphi=dsin(0.5d0*phii)
5297 do j=1,nlor(itori,itori1,iblock)
5298 vl1ij=vlor1(j,itori,itori1)
5299 vl2ij=vlor2(j,itori,itori1)
5300 vl3ij=vlor3(j,itori,itori1)
5301 pom=vl2ij*cosphi+vl3ij*sinphi
5302 pom1=1.0d0/(pom*pom+1.0d0)
5303 etors=etors+vl1ij*pom1
5304 c if (energy_dec) etors_ii=etors_ii+
5307 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5309 C Subtract the constant term
5310 etors=etors-v0(itori,itori1,iblock)
5312 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5313 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5314 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5315 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5316 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5319 ! 6/20/98 - dihedral angle constraints
5322 itori=idih_constr(i)
5324 difi=pinorm(phii-phi0(i))
5326 if (difi.gt.drange(i)) then
5328 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5329 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5330 edihi=0.25d0*ftors(i)*difi**4
5331 else if (difi.lt.-drange(i)) then
5333 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5334 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5335 edihi=0.25d0*ftors(i)*difi**4
5339 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5340 & i,itori,rad2deg*phii,
5341 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5342 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5344 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5345 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5347 ! write (iout,*) 'edihcnstr',edihcnstr
5350 c----------------------------------------------------------------------------
5351 subroutine etor_d(etors_d,fact2)
5352 C 6/23/01 Compute double torsional energy
5353 implicit real*8 (a-h,o-z)
5354 include 'DIMENSIONS'
5355 include 'DIMENSIONS.ZSCOPT'
5356 include 'COMMON.VAR'
5357 include 'COMMON.GEO'
5358 include 'COMMON.LOCAL'
5359 include 'COMMON.TORSION'
5360 include 'COMMON.INTERACT'
5361 include 'COMMON.DERIV'
5362 include 'COMMON.CHAIN'
5363 include 'COMMON.NAMES'
5364 include 'COMMON.IOUNITS'
5365 include 'COMMON.FFIELD'
5366 include 'COMMON.TORCNSTR'
5368 C Set lprn=.true. for debugging
5372 do i=iphi_start,iphi_end-1
5374 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5375 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5376 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5377 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5378 & (itype(i+1).eq.ntyp1)) cycle
5379 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5381 itori=itortyp(itype(i-2))
5382 itori1=itortyp(itype(i-1))
5383 itori2=itortyp(itype(i))
5389 if (iabs(itype(i+1)).eq.20) iblock=2
5390 C Regular cosine and sine terms
5391 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5392 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5393 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5394 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5395 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5396 cosphi1=dcos(j*phii)
5397 sinphi1=dsin(j*phii)
5398 cosphi2=dcos(j*phii1)
5399 sinphi2=dsin(j*phii1)
5400 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5401 & v2cij*cosphi2+v2sij*sinphi2
5402 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5403 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5405 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5407 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5408 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5409 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5410 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5411 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5412 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5413 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5414 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5415 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5416 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5417 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5418 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5419 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5420 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5423 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5424 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5430 c------------------------------------------------------------------------------
5431 subroutine eback_sc_corr(esccor)
5432 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5433 c conformational states; temporarily implemented as differences
5434 c between UNRES torsional potentials (dependent on three types of
5435 c residues) and the torsional potentials dependent on all 20 types
5436 c of residues computed from AM1 energy surfaces of terminally-blocked
5437 c amino-acid residues.
5438 implicit real*8 (a-h,o-z)
5439 include 'DIMENSIONS'
5440 include 'DIMENSIONS.ZSCOPT'
5441 include 'COMMON.VAR'
5442 include 'COMMON.GEO'
5443 include 'COMMON.LOCAL'
5444 include 'COMMON.TORSION'
5445 include 'COMMON.SCCOR'
5446 include 'COMMON.INTERACT'
5447 include 'COMMON.DERIV'
5448 include 'COMMON.CHAIN'
5449 include 'COMMON.NAMES'
5450 include 'COMMON.IOUNITS'
5451 include 'COMMON.FFIELD'
5452 include 'COMMON.CONTROL'
5454 C Set lprn=.true. for debugging
5457 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5459 do i=itau_start,itau_end
5460 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5462 isccori=isccortyp(itype(i-2))
5463 isccori1=isccortyp(itype(i-1))
5465 do intertyp=1,3 !intertyp
5466 cc Added 09 May 2012 (Adasko)
5467 cc Intertyp means interaction type of backbone mainchain correlation:
5468 c 1 = SC...Ca...Ca...Ca
5469 c 2 = Ca...Ca...Ca...SC
5470 c 3 = SC...Ca...Ca...SCi
5472 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5473 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5474 & (itype(i-1).eq.ntyp1)))
5475 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5476 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5477 & .or.(itype(i).eq.ntyp1)))
5478 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5479 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5480 & (itype(i-3).eq.ntyp1)))) cycle
5481 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5482 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5484 do j=1,nterm_sccor(isccori,isccori1)
5485 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5486 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5487 cosphi=dcos(j*tauangle(intertyp,i))
5488 sinphi=dsin(j*tauangle(intertyp,i))
5489 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5490 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5492 C write (iout,*)"EBACK_SC_COR",esccor,i
5493 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5494 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5495 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5497 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5498 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5499 & (v1sccor(j,1,itori,itori1),j=1,6)
5500 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5501 c gsccor_loc(i-3)=gloci
5506 c------------------------------------------------------------------------------
5507 subroutine multibody(ecorr)
5508 C This subroutine calculates multi-body contributions to energy following
5509 C the idea of Skolnick et al. If side chains I and J make a contact and
5510 C at the same time side chains I+1 and J+1 make a contact, an extra
5511 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5512 implicit real*8 (a-h,o-z)
5513 include 'DIMENSIONS'
5514 include 'COMMON.IOUNITS'
5515 include 'COMMON.DERIV'
5516 include 'COMMON.INTERACT'
5517 include 'COMMON.CONTACTS'
5518 double precision gx(3),gx1(3)
5521 C Set lprn=.true. for debugging
5525 write (iout,'(a)') 'Contact function values:'
5527 write (iout,'(i2,20(1x,i2,f10.5))')
5528 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5543 num_conti=num_cont(i)
5544 num_conti1=num_cont(i1)
5549 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5550 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5551 cd & ' ishift=',ishift
5552 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5553 C The system gains extra energy.
5554 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5555 endif ! j1==j+-ishift
5564 c------------------------------------------------------------------------------
5565 double precision function esccorr(i,j,k,l,jj,kk)
5566 implicit real*8 (a-h,o-z)
5567 include 'DIMENSIONS'
5568 include 'COMMON.IOUNITS'
5569 include 'COMMON.DERIV'
5570 include 'COMMON.INTERACT'
5571 include 'COMMON.CONTACTS'
5572 double precision gx(3),gx1(3)
5577 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5578 C Calculate the multi-body contribution to energy.
5579 C Calculate multi-body contributions to the gradient.
5580 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5581 cd & k,l,(gacont(m,kk,k),m=1,3)
5583 gx(m) =ekl*gacont(m,jj,i)
5584 gx1(m)=eij*gacont(m,kk,k)
5585 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5586 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5587 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5588 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5592 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5597 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5603 c------------------------------------------------------------------------------
5605 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5606 implicit real*8 (a-h,o-z)
5607 include 'DIMENSIONS'
5608 integer dimen1,dimen2,atom,indx
5609 double precision buffer(dimen1,dimen2)
5610 double precision zapas
5611 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5612 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5613 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5614 num_kont=num_cont_hb(atom)
5618 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5621 buffer(i,indx+22)=facont_hb(i,atom)
5622 buffer(i,indx+23)=ees0p(i,atom)
5623 buffer(i,indx+24)=ees0m(i,atom)
5624 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5626 buffer(1,indx+26)=dfloat(num_kont)
5629 c------------------------------------------------------------------------------
5630 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5631 implicit real*8 (a-h,o-z)
5632 include 'DIMENSIONS'
5633 integer dimen1,dimen2,atom,indx
5634 double precision buffer(dimen1,dimen2)
5635 double precision zapas
5636 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5637 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5638 & ees0m(ntyp,maxres),
5639 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5640 num_kont=buffer(1,indx+26)
5641 num_kont_old=num_cont_hb(atom)
5642 num_cont_hb(atom)=num_kont+num_kont_old
5647 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5650 facont_hb(ii,atom)=buffer(i,indx+22)
5651 ees0p(ii,atom)=buffer(i,indx+23)
5652 ees0m(ii,atom)=buffer(i,indx+24)
5653 jcont_hb(ii,atom)=buffer(i,indx+25)
5657 c------------------------------------------------------------------------------
5659 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5660 C This subroutine calculates multi-body contributions to hydrogen-bonding
5661 implicit real*8 (a-h,o-z)
5662 include 'DIMENSIONS'
5663 include 'DIMENSIONS.ZSCOPT'
5664 include 'COMMON.IOUNITS'
5666 include 'COMMON.INFO'
5668 include 'COMMON.FFIELD'
5669 include 'COMMON.DERIV'
5670 include 'COMMON.INTERACT'
5671 include 'COMMON.CONTACTS'
5673 parameter (max_cont=maxconts)
5674 parameter (max_dim=2*(8*3+2))
5675 parameter (msglen1=max_cont*max_dim*4)
5676 parameter (msglen2=2*msglen1)
5677 integer source,CorrelType,CorrelID,Error
5678 double precision buffer(max_cont,max_dim)
5680 double precision gx(3),gx1(3)
5683 C Set lprn=.true. for debugging
5688 if (fgProcs.le.1) goto 30
5690 write (iout,'(a)') 'Contact function values:'
5692 write (iout,'(2i3,50(1x,i2,f5.2))')
5693 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5694 & j=1,num_cont_hb(i))
5697 C Caution! Following code assumes that electrostatic interactions concerning
5698 C a given atom are split among at most two processors!
5708 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5711 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5712 if (MyRank.gt.0) then
5713 C Send correlation contributions to the preceding processor
5715 nn=num_cont_hb(iatel_s)
5716 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5717 cd write (iout,*) 'The BUFFER array:'
5719 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5721 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5723 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5724 C Clear the contacts of the atom passed to the neighboring processor
5725 nn=num_cont_hb(iatel_s+1)
5727 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5729 num_cont_hb(iatel_s)=0
5731 cd write (iout,*) 'Processor ',MyID,MyRank,
5732 cd & ' is sending correlation contribution to processor',MyID-1,
5733 cd & ' msglen=',msglen
5734 cd write (*,*) 'Processor ',MyID,MyRank,
5735 cd & ' is sending correlation contribution to processor',MyID-1,
5736 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5737 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5738 cd write (iout,*) 'Processor ',MyID,
5739 cd & ' has sent correlation contribution to processor',MyID-1,
5740 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5741 cd write (*,*) 'Processor ',MyID,
5742 cd & ' has sent correlation contribution to processor',MyID-1,
5743 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5745 endif ! (MyRank.gt.0)
5749 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5750 if (MyRank.lt.fgProcs-1) then
5751 C Receive correlation contributions from the next processor
5753 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5754 cd write (iout,*) 'Processor',MyID,
5755 cd & ' is receiving correlation contribution from processor',MyID+1,
5756 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5757 cd write (*,*) 'Processor',MyID,
5758 cd & ' is receiving correlation contribution from processor',MyID+1,
5759 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5761 do while (nbytes.le.0)
5762 call mp_probe(MyID+1,CorrelType,nbytes)
5764 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5765 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5766 cd write (iout,*) 'Processor',MyID,
5767 cd & ' has received correlation contribution from processor',MyID+1,
5768 cd & ' msglen=',msglen,' nbytes=',nbytes
5769 cd write (iout,*) 'The received BUFFER array:'
5771 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5773 if (msglen.eq.msglen1) then
5774 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5775 else if (msglen.eq.msglen2) then
5776 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5777 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5780 & 'ERROR!!!! message length changed while processing correlations.'
5782 & 'ERROR!!!! message length changed while processing correlations.'
5783 call mp_stopall(Error)
5784 endif ! msglen.eq.msglen1
5785 endif ! MyRank.lt.fgProcs-1
5792 write (iout,'(a)') 'Contact function values:'
5794 write (iout,'(2i3,50(1x,i2,f5.2))')
5795 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5796 & j=1,num_cont_hb(i))
5800 C Remove the loop below after debugging !!!
5807 C Calculate the local-electrostatic correlation terms
5808 do i=iatel_s,iatel_e+1
5810 num_conti=num_cont_hb(i)
5811 num_conti1=num_cont_hb(i+1)
5816 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5817 c & ' jj=',jj,' kk=',kk
5818 if (j1.eq.j+1 .or. j1.eq.j-1) then
5819 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5820 C The system gains extra energy.
5821 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5823 else if (j1.eq.j) then
5824 C Contacts I-J and I-(J+1) occur simultaneously.
5825 C The system loses extra energy.
5826 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5831 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5832 c & ' jj=',jj,' kk=',kk
5834 C Contacts I-J and (I+1)-J occur simultaneously.
5835 C The system loses extra energy.
5836 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5843 c------------------------------------------------------------------------------
5844 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5846 C This subroutine calculates multi-body contributions to hydrogen-bonding
5847 implicit real*8 (a-h,o-z)
5848 include 'DIMENSIONS'
5849 include 'DIMENSIONS.ZSCOPT'
5850 include 'COMMON.IOUNITS'
5852 include 'COMMON.INFO'
5854 include 'COMMON.FFIELD'
5855 include 'COMMON.DERIV'
5856 include 'COMMON.INTERACT'
5857 include 'COMMON.CONTACTS'
5859 parameter (max_cont=maxconts)
5860 parameter (max_dim=2*(8*3+2))
5861 parameter (msglen1=max_cont*max_dim*4)
5862 parameter (msglen2=2*msglen1)
5863 integer source,CorrelType,CorrelID,Error
5864 double precision buffer(max_cont,max_dim)
5866 double precision gx(3),gx1(3)
5869 C Set lprn=.true. for debugging
5876 if (fgProcs.le.1) goto 30
5878 write (iout,'(a)') 'Contact function values:'
5880 write (iout,'(2i3,50(1x,i2,f5.2))')
5881 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5882 & j=1,num_cont_hb(i))
5885 C Caution! Following code assumes that electrostatic interactions concerning
5886 C a given atom are split among at most two processors!
5896 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5899 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5900 if (MyRank.gt.0) then
5901 C Send correlation contributions to the preceding processor
5903 nn=num_cont_hb(iatel_s)
5904 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5905 cd write (iout,*) 'The BUFFER array:'
5907 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5909 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5911 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5912 C Clear the contacts of the atom passed to the neighboring processor
5913 nn=num_cont_hb(iatel_s+1)
5915 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5917 num_cont_hb(iatel_s)=0
5919 cd write (iout,*) 'Processor ',MyID,MyRank,
5920 cd & ' is sending correlation contribution to processor',MyID-1,
5921 cd & ' msglen=',msglen
5922 cd write (*,*) 'Processor ',MyID,MyRank,
5923 cd & ' is sending correlation contribution to processor',MyID-1,
5924 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5925 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5926 cd write (iout,*) 'Processor ',MyID,
5927 cd & ' has sent correlation contribution to processor',MyID-1,
5928 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5929 cd write (*,*) 'Processor ',MyID,
5930 cd & ' has sent correlation contribution to processor',MyID-1,
5931 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5933 endif ! (MyRank.gt.0)
5937 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5938 if (MyRank.lt.fgProcs-1) then
5939 C Receive correlation contributions from the next processor
5941 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5942 cd write (iout,*) 'Processor',MyID,
5943 cd & ' is receiving correlation contribution from processor',MyID+1,
5944 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5945 cd write (*,*) 'Processor',MyID,
5946 cd & ' is receiving correlation contribution from processor',MyID+1,
5947 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5949 do while (nbytes.le.0)
5950 call mp_probe(MyID+1,CorrelType,nbytes)
5952 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5953 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5954 cd write (iout,*) 'Processor',MyID,
5955 cd & ' has received correlation contribution from processor',MyID+1,
5956 cd & ' msglen=',msglen,' nbytes=',nbytes
5957 cd write (iout,*) 'The received BUFFER array:'
5959 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5961 if (msglen.eq.msglen1) then
5962 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5963 else if (msglen.eq.msglen2) then
5964 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5965 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5968 & 'ERROR!!!! message length changed while processing correlations.'
5970 & 'ERROR!!!! message length changed while processing correlations.'
5971 call mp_stopall(Error)
5972 endif ! msglen.eq.msglen1
5973 endif ! MyRank.lt.fgProcs-1
5980 write (iout,'(a)') 'Contact function values:'
5982 write (iout,'(2i3,50(1x,i2,f5.2))')
5983 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5984 & j=1,num_cont_hb(i))
5990 C Remove the loop below after debugging !!!
5997 C Calculate the dipole-dipole interaction energies
5998 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5999 do i=iatel_s,iatel_e+1
6000 num_conti=num_cont_hb(i)
6007 C Calculate the local-electrostatic correlation terms
6008 do i=iatel_s,iatel_e+1
6010 num_conti=num_cont_hb(i)
6011 num_conti1=num_cont_hb(i+1)
6016 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6017 c & ' jj=',jj,' kk=',kk
6018 if (j1.eq.j+1 .or. j1.eq.j-1) then
6019 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6020 C The system gains extra energy.
6022 sqd1=dsqrt(d_cont(jj,i))
6023 sqd2=dsqrt(d_cont(kk,i1))
6024 sred_geom = sqd1*sqd2
6025 IF (sred_geom.lt.cutoff_corr) THEN
6026 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6028 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6029 c & ' jj=',jj,' kk=',kk
6030 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6031 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6033 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6034 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6037 cd write (iout,*) 'sred_geom=',sred_geom,
6038 cd & ' ekont=',ekont,' fprim=',fprimcont
6039 call calc_eello(i,j,i+1,j1,jj,kk)
6040 if (wcorr4.gt.0.0d0)
6041 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6042 if (wcorr5.gt.0.0d0)
6043 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6044 c print *,"wcorr5",ecorr5
6045 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6046 cd write(2,*)'ijkl',i,j,i+1,j1
6047 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6048 & .or. wturn6.eq.0.0d0))then
6049 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6050 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6051 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6052 cd & 'ecorr6=',ecorr6
6053 cd write (iout,'(4e15.5)') sred_geom,
6054 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6055 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6056 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6057 else if (wturn6.gt.0.0d0
6058 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6059 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6060 eturn6=eturn6+eello_turn6(i,jj,kk)
6061 cd write (2,*) 'multibody_eello:eturn6',eturn6
6062 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6069 else if (j1.eq.j) then
6070 C Contacts I-J and I-(J+1) occur simultaneously.
6071 C The system loses extra energy.
6072 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6077 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6078 c & ' jj=',jj,' kk=',kk
6080 C Contacts I-J and (I+1)-J occur simultaneously.
6081 C The system loses extra energy.
6082 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6087 write (iout,*) "eturn6",eturn6,ecorr6
6090 c------------------------------------------------------------------------------
6091 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6092 implicit real*8 (a-h,o-z)
6093 include 'DIMENSIONS'
6094 include 'COMMON.IOUNITS'
6095 include 'COMMON.DERIV'
6096 include 'COMMON.INTERACT'
6097 include 'COMMON.CONTACTS'
6098 include 'COMMON.CONTROL'
6099 include 'COMMON.SHIELD'
6100 double precision gx(3),gx1(3)
6110 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6111 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6112 C Following 4 lines for diagnostics.
6117 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6119 c write (iout,*)'Contacts have occurred for peptide groups',
6120 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6121 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6122 C Calculate the multi-body contribution to energy.
6123 C ecorr=ecorr+ekont*ees
6125 C Calculate multi-body contributions to the gradient.
6127 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6128 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6129 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6130 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6131 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6132 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6133 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6134 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6135 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6136 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6137 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6138 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6139 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6140 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6144 gradcorr(ll,m)=gradcorr(ll,m)+
6145 & ees*ekl*gacont_hbr(ll,jj,i)-
6146 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6147 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6152 gradcorr(ll,m)=gradcorr(ll,m)+
6153 & ees*eij*gacont_hbr(ll,kk,k)-
6154 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6155 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6158 if (shield_mode.gt.0) then
6161 C print *,i,j,fac_shield(i),fac_shield(j),
6162 C &fac_shield(k),fac_shield(l)
6163 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6164 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6165 do ilist=1,ishield_list(i)
6166 iresshield=shield_list(ilist,i)
6168 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6170 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6172 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6173 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6177 do ilist=1,ishield_list(j)
6178 iresshield=shield_list(ilist,j)
6180 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6182 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6184 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6185 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6189 do ilist=1,ishield_list(k)
6190 iresshield=shield_list(ilist,k)
6192 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6194 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6196 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6197 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6201 do ilist=1,ishield_list(l)
6202 iresshield=shield_list(ilist,l)
6204 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6206 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6208 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6209 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6213 C print *,gshieldx(m,iresshield)
6215 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6216 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6217 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6218 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6219 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6220 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6221 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6222 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6224 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6225 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6226 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6227 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6228 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6229 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6230 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6231 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6240 C---------------------------------------------------------------------------
6241 subroutine dipole(i,j,jj)
6242 implicit real*8 (a-h,o-z)
6243 include 'DIMENSIONS'
6244 include 'DIMENSIONS.ZSCOPT'
6245 include 'COMMON.IOUNITS'
6246 include 'COMMON.CHAIN'
6247 include 'COMMON.FFIELD'
6248 include 'COMMON.DERIV'
6249 include 'COMMON.INTERACT'
6250 include 'COMMON.CONTACTS'
6251 include 'COMMON.TORSION'
6252 include 'COMMON.VAR'
6253 include 'COMMON.GEO'
6254 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6256 iti1 = itortyp(itype(i+1))
6257 if (j.lt.nres-1) then
6258 if (itype(j).le.ntyp) then
6259 itj1 = itortyp(itype(j+1))
6267 dipi(iii,1)=Ub2(iii,i)
6268 dipderi(iii)=Ub2der(iii,i)
6269 dipi(iii,2)=b1(iii,iti1)
6270 dipj(iii,1)=Ub2(iii,j)
6271 dipderj(iii)=Ub2der(iii,j)
6272 dipj(iii,2)=b1(iii,itj1)
6276 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6279 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6282 if (.not.calc_grad) return
6287 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6291 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6296 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6297 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6299 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6301 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6303 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6307 C---------------------------------------------------------------------------
6308 subroutine calc_eello(i,j,k,l,jj,kk)
6310 C This subroutine computes matrices and vectors needed to calculate
6311 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6313 implicit real*8 (a-h,o-z)
6314 include 'DIMENSIONS'
6315 include 'DIMENSIONS.ZSCOPT'
6316 include 'COMMON.IOUNITS'
6317 include 'COMMON.CHAIN'
6318 include 'COMMON.DERIV'
6319 include 'COMMON.INTERACT'
6320 include 'COMMON.CONTACTS'
6321 include 'COMMON.TORSION'
6322 include 'COMMON.VAR'
6323 include 'COMMON.GEO'
6324 include 'COMMON.FFIELD'
6325 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6326 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6329 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6330 cd & ' jj=',jj,' kk=',kk
6331 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6334 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6335 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6338 call transpose2(aa1(1,1),aa1t(1,1))
6339 call transpose2(aa2(1,1),aa2t(1,1))
6342 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6343 & aa1tder(1,1,lll,kkk))
6344 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6345 & aa2tder(1,1,lll,kkk))
6349 C parallel orientation of the two CA-CA-CA frames.
6350 if (i.gt.1 .and. itype(i).le.ntyp) then
6351 iti=itortyp(itype(i))
6355 itk1=itortyp(itype(k+1))
6356 itj=itortyp(itype(j))
6357 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6358 itl1=itortyp(itype(l+1))
6362 C A1 kernel(j+1) A2T
6364 cd write (iout,'(3f10.5,5x,3f10.5)')
6365 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6368 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6369 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6370 C Following matrices are needed only for 6-th order cumulants
6371 IF (wcorr6.gt.0.0d0) THEN
6372 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6373 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6374 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6375 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6376 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6377 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6378 & ADtEAderx(1,1,1,1,1,1))
6380 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6381 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6382 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6383 & ADtEA1derx(1,1,1,1,1,1))
6385 C End 6-th order cumulants
6388 cd write (2,*) 'In calc_eello6'
6390 cd write (2,*) 'iii=',iii
6392 cd write (2,*) 'kkk=',kkk
6394 cd write (2,'(3(2f10.5),5x)')
6395 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6400 call transpose2(EUgder(1,1,k),auxmat(1,1))
6401 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6402 call transpose2(EUg(1,1,k),auxmat(1,1))
6403 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6404 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6408 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6409 & EAEAderx(1,1,lll,kkk,iii,1))
6413 C A1T kernel(i+1) A2
6414 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6415 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6416 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6417 C Following matrices are needed only for 6-th order cumulants
6418 IF (wcorr6.gt.0.0d0) THEN
6419 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6420 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6421 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6422 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6423 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6424 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6425 & ADtEAderx(1,1,1,1,1,2))
6426 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6427 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6428 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6429 & ADtEA1derx(1,1,1,1,1,2))
6431 C End 6-th order cumulants
6432 call transpose2(EUgder(1,1,l),auxmat(1,1))
6433 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6434 call transpose2(EUg(1,1,l),auxmat(1,1))
6435 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6436 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6440 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6441 & EAEAderx(1,1,lll,kkk,iii,2))
6446 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6447 C They are needed only when the fifth- or the sixth-order cumulants are
6449 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6450 call transpose2(AEA(1,1,1),auxmat(1,1))
6451 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6452 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6453 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6454 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6455 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6456 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6457 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6458 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6459 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6460 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6461 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6462 call transpose2(AEA(1,1,2),auxmat(1,1))
6463 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6464 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6465 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6466 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6467 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6468 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6469 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6470 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6471 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6472 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6473 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6474 C Calculate the Cartesian derivatives of the vectors.
6478 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6479 call matvec2(auxmat(1,1),b1(1,iti),
6480 & AEAb1derx(1,lll,kkk,iii,1,1))
6481 call matvec2(auxmat(1,1),Ub2(1,i),
6482 & AEAb2derx(1,lll,kkk,iii,1,1))
6483 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6484 & AEAb1derx(1,lll,kkk,iii,2,1))
6485 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6486 & AEAb2derx(1,lll,kkk,iii,2,1))
6487 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6488 call matvec2(auxmat(1,1),b1(1,itj),
6489 & AEAb1derx(1,lll,kkk,iii,1,2))
6490 call matvec2(auxmat(1,1),Ub2(1,j),
6491 & AEAb2derx(1,lll,kkk,iii,1,2))
6492 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6493 & AEAb1derx(1,lll,kkk,iii,2,2))
6494 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6495 & AEAb2derx(1,lll,kkk,iii,2,2))
6502 C Antiparallel orientation of the two CA-CA-CA frames.
6503 if (i.gt.1 .and. itype(i).le.ntyp) then
6504 iti=itortyp(itype(i))
6508 itk1=itortyp(itype(k+1))
6509 itl=itortyp(itype(l))
6510 itj=itortyp(itype(j))
6511 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6512 itj1=itortyp(itype(j+1))
6516 C A2 kernel(j-1)T A1T
6517 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6518 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6519 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6520 C Following matrices are needed only for 6-th order cumulants
6521 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6522 & j.eq.i+4 .and. l.eq.i+3)) THEN
6523 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6524 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6525 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6526 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6527 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6528 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6529 & ADtEAderx(1,1,1,1,1,1))
6530 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6531 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6532 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6533 & ADtEA1derx(1,1,1,1,1,1))
6535 C End 6-th order cumulants
6536 call transpose2(EUgder(1,1,k),auxmat(1,1))
6537 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6538 call transpose2(EUg(1,1,k),auxmat(1,1))
6539 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6540 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6544 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6545 & EAEAderx(1,1,lll,kkk,iii,1))
6549 C A2T kernel(i+1)T A1
6550 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6551 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6552 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6553 C Following matrices are needed only for 6-th order cumulants
6554 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6555 & j.eq.i+4 .and. l.eq.i+3)) THEN
6556 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6557 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6558 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6559 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6560 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6561 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6562 & ADtEAderx(1,1,1,1,1,2))
6563 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6564 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6565 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6566 & ADtEA1derx(1,1,1,1,1,2))
6568 C End 6-th order cumulants
6569 call transpose2(EUgder(1,1,j),auxmat(1,1))
6570 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6571 call transpose2(EUg(1,1,j),auxmat(1,1))
6572 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6573 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6577 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6578 & EAEAderx(1,1,lll,kkk,iii,2))
6583 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6584 C They are needed only when the fifth- or the sixth-order cumulants are
6586 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6587 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6588 call transpose2(AEA(1,1,1),auxmat(1,1))
6589 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6590 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6591 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6592 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6593 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6594 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6595 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6596 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6597 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6598 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6599 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6600 call transpose2(AEA(1,1,2),auxmat(1,1))
6601 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6602 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6603 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6604 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6605 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6606 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6607 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6608 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6609 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6610 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6611 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6612 C Calculate the Cartesian derivatives of the vectors.
6616 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6617 call matvec2(auxmat(1,1),b1(1,iti),
6618 & AEAb1derx(1,lll,kkk,iii,1,1))
6619 call matvec2(auxmat(1,1),Ub2(1,i),
6620 & AEAb2derx(1,lll,kkk,iii,1,1))
6621 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6622 & AEAb1derx(1,lll,kkk,iii,2,1))
6623 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6624 & AEAb2derx(1,lll,kkk,iii,2,1))
6625 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6626 call matvec2(auxmat(1,1),b1(1,itl),
6627 & AEAb1derx(1,lll,kkk,iii,1,2))
6628 call matvec2(auxmat(1,1),Ub2(1,l),
6629 & AEAb2derx(1,lll,kkk,iii,1,2))
6630 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6631 & AEAb1derx(1,lll,kkk,iii,2,2))
6632 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6633 & AEAb2derx(1,lll,kkk,iii,2,2))
6642 C---------------------------------------------------------------------------
6643 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6644 & KK,KKderg,AKA,AKAderg,AKAderx)
6648 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6649 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6650 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6655 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6657 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6660 cd if (lprn) write (2,*) 'In kernel'
6662 cd if (lprn) write (2,*) 'kkk=',kkk
6664 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6665 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6667 cd write (2,*) 'lll=',lll
6668 cd write (2,*) 'iii=1'
6670 cd write (2,'(3(2f10.5),5x)')
6671 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6674 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6675 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6677 cd write (2,*) 'lll=',lll
6678 cd write (2,*) 'iii=2'
6680 cd write (2,'(3(2f10.5),5x)')
6681 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6688 C---------------------------------------------------------------------------
6689 double precision function eello4(i,j,k,l,jj,kk)
6690 implicit real*8 (a-h,o-z)
6691 include 'DIMENSIONS'
6692 include 'DIMENSIONS.ZSCOPT'
6693 include 'COMMON.IOUNITS'
6694 include 'COMMON.CHAIN'
6695 include 'COMMON.DERIV'
6696 include 'COMMON.INTERACT'
6697 include 'COMMON.CONTACTS'
6698 include 'COMMON.TORSION'
6699 include 'COMMON.VAR'
6700 include 'COMMON.GEO'
6701 double precision pizda(2,2),ggg1(3),ggg2(3)
6702 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6706 cd print *,'eello4:',i,j,k,l,jj,kk
6707 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6708 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6709 cold eij=facont_hb(jj,i)
6710 cold ekl=facont_hb(kk,k)
6712 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6714 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6715 gcorr_loc(k-1)=gcorr_loc(k-1)
6716 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6718 gcorr_loc(l-1)=gcorr_loc(l-1)
6719 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6721 gcorr_loc(j-1)=gcorr_loc(j-1)
6722 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6727 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6728 & -EAEAderx(2,2,lll,kkk,iii,1)
6729 cd derx(lll,kkk,iii)=0.0d0
6733 cd gcorr_loc(l-1)=0.0d0
6734 cd gcorr_loc(j-1)=0.0d0
6735 cd gcorr_loc(k-1)=0.0d0
6737 cd write (iout,*)'Contacts have occurred for peptide groups',
6738 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6739 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6740 if (j.lt.nres-1) then
6747 if (l.lt.nres-1) then
6755 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6756 ggg1(ll)=eel4*g_contij(ll,1)
6757 ggg2(ll)=eel4*g_contij(ll,2)
6758 ghalf=0.5d0*ggg1(ll)
6760 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6761 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6762 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6763 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6764 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6765 ghalf=0.5d0*ggg2(ll)
6767 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6768 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6769 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6770 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6775 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6776 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6781 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6782 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6788 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6793 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6797 cd write (2,*) iii,gcorr_loc(iii)
6801 cd write (2,*) 'ekont',ekont
6802 cd write (iout,*) 'eello4',ekont*eel4
6805 C---------------------------------------------------------------------------
6806 double precision function eello5(i,j,k,l,jj,kk)
6807 implicit real*8 (a-h,o-z)
6808 include 'DIMENSIONS'
6809 include 'DIMENSIONS.ZSCOPT'
6810 include 'COMMON.IOUNITS'
6811 include 'COMMON.CHAIN'
6812 include 'COMMON.DERIV'
6813 include 'COMMON.INTERACT'
6814 include 'COMMON.CONTACTS'
6815 include 'COMMON.TORSION'
6816 include 'COMMON.VAR'
6817 include 'COMMON.GEO'
6818 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6819 double precision ggg1(3),ggg2(3)
6820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6825 C /l\ / \ \ / \ / \ / C
6826 C / \ / \ \ / \ / \ / C
6827 C j| o |l1 | o | o| o | | o |o C
6828 C \ |/k\| |/ \| / |/ \| |/ \| C
6829 C \i/ \ / \ / / \ / \ C
6831 C (I) (II) (III) (IV) C
6833 C eello5_1 eello5_2 eello5_3 eello5_4 C
6835 C Antiparallel chains C
6838 C /j\ / \ \ / \ / \ / C
6839 C / \ / \ \ / \ / \ / C
6840 C j1| o |l | o | o| o | | o |o C
6841 C \ |/k\| |/ \| / |/ \| |/ \| C
6842 C \i/ \ / \ / / \ / \ C
6844 C (I) (II) (III) (IV) C
6846 C eello5_1 eello5_2 eello5_3 eello5_4 C
6848 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6850 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6851 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6856 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6858 itk=itortyp(itype(k))
6859 itl=itortyp(itype(l))
6860 itj=itortyp(itype(j))
6865 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6866 cd & eel5_3_num,eel5_4_num)
6870 derx(lll,kkk,iii)=0.0d0
6874 cd eij=facont_hb(jj,i)
6875 cd ekl=facont_hb(kk,k)
6877 cd write (iout,*)'Contacts have occurred for peptide groups',
6878 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6880 C Contribution from the graph I.
6881 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6882 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6883 call transpose2(EUg(1,1,k),auxmat(1,1))
6884 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6885 vv(1)=pizda(1,1)-pizda(2,2)
6886 vv(2)=pizda(1,2)+pizda(2,1)
6887 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6888 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6890 C Explicit gradient in virtual-dihedral angles.
6891 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6892 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6893 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6894 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6895 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6896 vv(1)=pizda(1,1)-pizda(2,2)
6897 vv(2)=pizda(1,2)+pizda(2,1)
6898 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6899 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6900 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6901 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6902 vv(1)=pizda(1,1)-pizda(2,2)
6903 vv(2)=pizda(1,2)+pizda(2,1)
6905 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6906 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6907 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6909 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6910 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6911 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6913 C Cartesian gradient
6917 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6919 vv(1)=pizda(1,1)-pizda(2,2)
6920 vv(2)=pizda(1,2)+pizda(2,1)
6921 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6922 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6923 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6930 C Contribution from graph II
6931 call transpose2(EE(1,1,itk),auxmat(1,1))
6932 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6933 vv(1)=pizda(1,1)+pizda(2,2)
6934 vv(2)=pizda(2,1)-pizda(1,2)
6935 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6936 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6938 C Explicit gradient in virtual-dihedral angles.
6939 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6940 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6941 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6942 vv(1)=pizda(1,1)+pizda(2,2)
6943 vv(2)=pizda(2,1)-pizda(1,2)
6945 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6946 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6947 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6949 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6950 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6951 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6953 C Cartesian gradient
6957 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6959 vv(1)=pizda(1,1)+pizda(2,2)
6960 vv(2)=pizda(2,1)-pizda(1,2)
6961 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6962 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6963 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6972 C Parallel orientation
6973 C Contribution from graph III
6974 call transpose2(EUg(1,1,l),auxmat(1,1))
6975 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6976 vv(1)=pizda(1,1)-pizda(2,2)
6977 vv(2)=pizda(1,2)+pizda(2,1)
6978 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6979 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6981 C Explicit gradient in virtual-dihedral angles.
6982 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6983 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6984 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6985 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6986 vv(1)=pizda(1,1)-pizda(2,2)
6987 vv(2)=pizda(1,2)+pizda(2,1)
6988 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6989 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6990 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6991 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6992 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6993 vv(1)=pizda(1,1)-pizda(2,2)
6994 vv(2)=pizda(1,2)+pizda(2,1)
6995 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6996 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6997 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6998 C Cartesian gradient
7002 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7004 vv(1)=pizda(1,1)-pizda(2,2)
7005 vv(2)=pizda(1,2)+pizda(2,1)
7006 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7007 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7008 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7014 C Contribution from graph IV
7016 call transpose2(EE(1,1,itl),auxmat(1,1))
7017 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7018 vv(1)=pizda(1,1)+pizda(2,2)
7019 vv(2)=pizda(2,1)-pizda(1,2)
7020 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7021 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7023 C Explicit gradient in virtual-dihedral angles.
7024 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7025 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7026 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7027 vv(1)=pizda(1,1)+pizda(2,2)
7028 vv(2)=pizda(2,1)-pizda(1,2)
7029 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7030 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7031 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7032 C Cartesian gradient
7036 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7038 vv(1)=pizda(1,1)+pizda(2,2)
7039 vv(2)=pizda(2,1)-pizda(1,2)
7040 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7041 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7042 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7048 C Antiparallel orientation
7049 C Contribution from graph III
7051 call transpose2(EUg(1,1,j),auxmat(1,1))
7052 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7053 vv(1)=pizda(1,1)-pizda(2,2)
7054 vv(2)=pizda(1,2)+pizda(2,1)
7055 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7056 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7058 C Explicit gradient in virtual-dihedral angles.
7059 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7060 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7061 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7062 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7063 vv(1)=pizda(1,1)-pizda(2,2)
7064 vv(2)=pizda(1,2)+pizda(2,1)
7065 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7066 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7067 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7068 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7069 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7070 vv(1)=pizda(1,1)-pizda(2,2)
7071 vv(2)=pizda(1,2)+pizda(2,1)
7072 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7073 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7074 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7075 C Cartesian gradient
7079 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7081 vv(1)=pizda(1,1)-pizda(2,2)
7082 vv(2)=pizda(1,2)+pizda(2,1)
7083 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7084 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7085 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7091 C Contribution from graph IV
7093 call transpose2(EE(1,1,itj),auxmat(1,1))
7094 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7095 vv(1)=pizda(1,1)+pizda(2,2)
7096 vv(2)=pizda(2,1)-pizda(1,2)
7097 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7098 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7100 C Explicit gradient in virtual-dihedral angles.
7101 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7102 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7103 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7104 vv(1)=pizda(1,1)+pizda(2,2)
7105 vv(2)=pizda(2,1)-pizda(1,2)
7106 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7107 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7108 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7109 C Cartesian gradient
7113 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7115 vv(1)=pizda(1,1)+pizda(2,2)
7116 vv(2)=pizda(2,1)-pizda(1,2)
7117 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7118 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7119 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7126 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7127 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7128 cd write (2,*) 'ijkl',i,j,k,l
7129 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7130 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7132 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7133 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7134 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7135 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7137 if (j.lt.nres-1) then
7144 if (l.lt.nres-1) then
7154 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7156 ggg1(ll)=eel5*g_contij(ll,1)
7157 ggg2(ll)=eel5*g_contij(ll,2)
7158 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7159 ghalf=0.5d0*ggg1(ll)
7161 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7162 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7163 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7164 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7165 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7166 ghalf=0.5d0*ggg2(ll)
7168 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7169 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7170 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7171 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7176 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7177 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7182 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7183 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7189 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7194 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7198 cd write (2,*) iii,g_corr5_loc(iii)
7202 cd write (2,*) 'ekont',ekont
7203 cd write (iout,*) 'eello5',ekont*eel5
7206 c--------------------------------------------------------------------------
7207 double precision function eello6(i,j,k,l,jj,kk)
7208 implicit real*8 (a-h,o-z)
7209 include 'DIMENSIONS'
7210 include 'DIMENSIONS.ZSCOPT'
7211 include 'COMMON.IOUNITS'
7212 include 'COMMON.CHAIN'
7213 include 'COMMON.DERIV'
7214 include 'COMMON.INTERACT'
7215 include 'COMMON.CONTACTS'
7216 include 'COMMON.TORSION'
7217 include 'COMMON.VAR'
7218 include 'COMMON.GEO'
7219 include 'COMMON.FFIELD'
7220 double precision ggg1(3),ggg2(3)
7221 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7226 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7234 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7235 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7239 derx(lll,kkk,iii)=0.0d0
7243 cd eij=facont_hb(jj,i)
7244 cd ekl=facont_hb(kk,k)
7250 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7251 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7252 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7253 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7254 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7255 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7257 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7258 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7259 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7260 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7261 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7262 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7266 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7268 C If turn contributions are considered, they will be handled separately.
7269 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7270 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7271 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7272 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7273 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7274 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7275 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7278 if (j.lt.nres-1) then
7285 if (l.lt.nres-1) then
7293 ggg1(ll)=eel6*g_contij(ll,1)
7294 ggg2(ll)=eel6*g_contij(ll,2)
7295 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7296 ghalf=0.5d0*ggg1(ll)
7298 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7299 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7300 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7301 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7302 ghalf=0.5d0*ggg2(ll)
7303 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7305 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7306 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7307 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7308 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7313 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7314 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7319 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7320 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7326 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7331 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7335 cd write (2,*) iii,g_corr6_loc(iii)
7339 cd write (2,*) 'ekont',ekont
7340 cd write (iout,*) 'eello6',ekont*eel6
7343 c--------------------------------------------------------------------------
7344 double precision function eello6_graph1(i,j,k,l,imat,swap)
7345 implicit real*8 (a-h,o-z)
7346 include 'DIMENSIONS'
7347 include 'DIMENSIONS.ZSCOPT'
7348 include 'COMMON.IOUNITS'
7349 include 'COMMON.CHAIN'
7350 include 'COMMON.DERIV'
7351 include 'COMMON.INTERACT'
7352 include 'COMMON.CONTACTS'
7353 include 'COMMON.TORSION'
7354 include 'COMMON.VAR'
7355 include 'COMMON.GEO'
7356 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7360 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7362 C Parallel Antiparallel C
7368 C \ j|/k\| / \ |/k\|l / C
7373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7374 itk=itortyp(itype(k))
7375 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7376 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7377 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7378 call transpose2(EUgC(1,1,k),auxmat(1,1))
7379 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7380 vv1(1)=pizda1(1,1)-pizda1(2,2)
7381 vv1(2)=pizda1(1,2)+pizda1(2,1)
7382 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7383 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7384 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7385 s5=scalar2(vv(1),Dtobr2(1,i))
7386 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7387 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7388 if (.not. calc_grad) return
7389 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7390 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7391 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7392 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7393 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7394 & +scalar2(vv(1),Dtobr2der(1,i)))
7395 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7396 vv1(1)=pizda1(1,1)-pizda1(2,2)
7397 vv1(2)=pizda1(1,2)+pizda1(2,1)
7398 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7399 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7401 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7402 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7403 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7404 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7405 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7407 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7408 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7409 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7410 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7411 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7413 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7414 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7415 vv1(1)=pizda1(1,1)-pizda1(2,2)
7416 vv1(2)=pizda1(1,2)+pizda1(2,1)
7417 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7418 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7419 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7420 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7429 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7430 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7431 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7432 call transpose2(EUgC(1,1,k),auxmat(1,1))
7433 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7435 vv1(1)=pizda1(1,1)-pizda1(2,2)
7436 vv1(2)=pizda1(1,2)+pizda1(2,1)
7437 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7438 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7439 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7440 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7441 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7442 s5=scalar2(vv(1),Dtobr2(1,i))
7443 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7449 c----------------------------------------------------------------------------
7450 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7451 implicit real*8 (a-h,o-z)
7452 include 'DIMENSIONS'
7453 include 'DIMENSIONS.ZSCOPT'
7454 include 'COMMON.IOUNITS'
7455 include 'COMMON.CHAIN'
7456 include 'COMMON.DERIV'
7457 include 'COMMON.INTERACT'
7458 include 'COMMON.CONTACTS'
7459 include 'COMMON.TORSION'
7460 include 'COMMON.VAR'
7461 include 'COMMON.GEO'
7463 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7464 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7467 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7469 C Parallel Antiparallel C
7475 C \ j|/k\| \ |/k\|l C
7480 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7481 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7482 C AL 7/4/01 s1 would occur in the sixth-order moment,
7483 C but not in a cluster cumulant
7485 s1=dip(1,jj,i)*dip(1,kk,k)
7487 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7488 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7489 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7490 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7491 call transpose2(EUg(1,1,k),auxmat(1,1))
7492 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7493 vv(1)=pizda(1,1)-pizda(2,2)
7494 vv(2)=pizda(1,2)+pizda(2,1)
7495 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7496 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7498 eello6_graph2=-(s1+s2+s3+s4)
7500 eello6_graph2=-(s2+s3+s4)
7503 if (.not. calc_grad) return
7504 C Derivatives in gamma(i-1)
7507 s1=dipderg(1,jj,i)*dip(1,kk,k)
7509 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7510 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7511 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7512 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7514 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7516 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7518 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7520 C Derivatives in gamma(k-1)
7522 s1=dip(1,jj,i)*dipderg(1,kk,k)
7524 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7525 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7526 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7527 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7528 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7529 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7530 vv(1)=pizda(1,1)-pizda(2,2)
7531 vv(2)=pizda(1,2)+pizda(2,1)
7532 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7534 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7536 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7538 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7539 C Derivatives in gamma(j-1) or gamma(l-1)
7542 s1=dipderg(3,jj,i)*dip(1,kk,k)
7544 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7545 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7546 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7547 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7548 vv(1)=pizda(1,1)-pizda(2,2)
7549 vv(2)=pizda(1,2)+pizda(2,1)
7550 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7553 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7555 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7558 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7559 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7561 C Derivatives in gamma(l-1) or gamma(j-1)
7564 s1=dip(1,jj,i)*dipderg(3,kk,k)
7566 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7567 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7568 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7569 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7570 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7571 vv(1)=pizda(1,1)-pizda(2,2)
7572 vv(2)=pizda(1,2)+pizda(2,1)
7573 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7576 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7578 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7581 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7582 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7584 C Cartesian derivatives.
7586 write (2,*) 'In eello6_graph2'
7588 write (2,*) 'iii=',iii
7590 write (2,*) 'kkk=',kkk
7592 write (2,'(3(2f10.5),5x)')
7593 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7603 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7605 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7608 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7610 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7611 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7613 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7614 call transpose2(EUg(1,1,k),auxmat(1,1))
7615 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(1,2)+pizda(2,1)
7619 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7620 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7622 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7624 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7627 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7629 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7636 c----------------------------------------------------------------------------
7637 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7638 implicit real*8 (a-h,o-z)
7639 include 'DIMENSIONS'
7640 include 'DIMENSIONS.ZSCOPT'
7641 include 'COMMON.IOUNITS'
7642 include 'COMMON.CHAIN'
7643 include 'COMMON.DERIV'
7644 include 'COMMON.INTERACT'
7645 include 'COMMON.CONTACTS'
7646 include 'COMMON.TORSION'
7647 include 'COMMON.VAR'
7648 include 'COMMON.GEO'
7649 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7651 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7653 C Parallel Antiparallel C
7659 C j|/k\| / |/k\|l / C
7664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7666 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7667 C energy moment and not to the cluster cumulant.
7668 iti=itortyp(itype(i))
7669 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7670 itj1=itortyp(itype(j+1))
7674 itk=itortyp(itype(k))
7675 itk1=itortyp(itype(k+1))
7676 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7677 itl1=itortyp(itype(l+1))
7682 s1=dip(4,jj,i)*dip(4,kk,k)
7684 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7685 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7686 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7687 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7688 call transpose2(EE(1,1,itk),auxmat(1,1))
7689 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7690 vv(1)=pizda(1,1)+pizda(2,2)
7691 vv(2)=pizda(2,1)-pizda(1,2)
7692 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7693 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7695 eello6_graph3=-(s1+s2+s3+s4)
7697 eello6_graph3=-(s2+s3+s4)
7700 if (.not. calc_grad) return
7701 C Derivatives in gamma(k-1)
7702 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7703 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7704 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7705 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7706 C Derivatives in gamma(l-1)
7707 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7708 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7709 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)+pizda(2,2)
7711 vv(2)=pizda(2,1)-pizda(1,2)
7712 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7713 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7714 C Cartesian derivatives.
7720 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7722 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7725 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7727 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7728 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7730 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7731 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7733 vv(1)=pizda(1,1)+pizda(2,2)
7734 vv(2)=pizda(2,1)-pizda(1,2)
7735 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7737 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7739 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7742 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7744 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7746 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7752 c----------------------------------------------------------------------------
7753 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7754 implicit real*8 (a-h,o-z)
7755 include 'DIMENSIONS'
7756 include 'DIMENSIONS.ZSCOPT'
7757 include 'COMMON.IOUNITS'
7758 include 'COMMON.CHAIN'
7759 include 'COMMON.DERIV'
7760 include 'COMMON.INTERACT'
7761 include 'COMMON.CONTACTS'
7762 include 'COMMON.TORSION'
7763 include 'COMMON.VAR'
7764 include 'COMMON.GEO'
7765 include 'COMMON.FFIELD'
7766 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7767 & auxvec1(2),auxmat1(2,2)
7769 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7771 C Parallel Antiparallel C
7777 C \ j|/k\| \ |/k\|l C
7782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7784 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7785 C energy moment and not to the cluster cumulant.
7786 cd write (2,*) 'eello_graph4: wturn6',wturn6
7787 iti=itortyp(itype(i))
7788 itj=itortyp(itype(j))
7789 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7790 itj1=itortyp(itype(j+1))
7794 itk=itortyp(itype(k))
7795 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7796 itk1=itortyp(itype(k+1))
7800 itl=itortyp(itype(l))
7801 if (l.lt.nres-1) then
7802 itl1=itortyp(itype(l+1))
7806 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7807 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7808 cd & ' itl',itl,' itl1',itl1
7811 s1=dip(3,jj,i)*dip(3,kk,k)
7813 s1=dip(2,jj,j)*dip(2,kk,l)
7816 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7817 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7819 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7820 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7822 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7823 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7825 call transpose2(EUg(1,1,k),auxmat(1,1))
7826 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7827 vv(1)=pizda(1,1)-pizda(2,2)
7828 vv(2)=pizda(2,1)+pizda(1,2)
7829 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7830 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7832 eello6_graph4=-(s1+s2+s3+s4)
7834 eello6_graph4=-(s2+s3+s4)
7836 if (.not. calc_grad) return
7837 C Derivatives in gamma(i-1)
7841 s1=dipderg(2,jj,i)*dip(3,kk,k)
7843 s1=dipderg(4,jj,j)*dip(2,kk,l)
7846 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7848 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7849 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7851 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7852 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7854 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7855 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7856 cd write (2,*) 'turn6 derivatives'
7858 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7860 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7864 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7866 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7870 C Derivatives in gamma(k-1)
7873 s1=dip(3,jj,i)*dipderg(2,kk,k)
7875 s1=dip(2,jj,j)*dipderg(4,kk,l)
7878 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7879 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7881 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7882 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7884 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7885 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7887 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7888 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7889 vv(1)=pizda(1,1)-pizda(2,2)
7890 vv(2)=pizda(2,1)+pizda(1,2)
7891 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7892 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7894 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7896 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7900 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7902 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7905 C Derivatives in gamma(j-1) or gamma(l-1)
7906 if (l.eq.j+1 .and. l.gt.1) then
7907 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7908 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7909 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7910 vv(1)=pizda(1,1)-pizda(2,2)
7911 vv(2)=pizda(2,1)+pizda(1,2)
7912 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7913 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7914 else if (j.gt.1) then
7915 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7916 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7917 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7918 vv(1)=pizda(1,1)-pizda(2,2)
7919 vv(2)=pizda(2,1)+pizda(1,2)
7920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7921 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7922 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7924 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7927 C Cartesian derivatives.
7934 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7936 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7940 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7942 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7946 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7948 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7950 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7951 & b1(1,itj1),auxvec(1))
7952 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7954 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7955 & b1(1,itl1),auxvec(1))
7956 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7958 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7960 vv(1)=pizda(1,1)-pizda(2,2)
7961 vv(2)=pizda(2,1)+pizda(1,2)
7962 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7964 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7966 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7969 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7972 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7975 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7977 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7979 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7983 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7985 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7988 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7990 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7998 c----------------------------------------------------------------------------
7999 double precision function eello_turn6(i,jj,kk)
8000 implicit real*8 (a-h,o-z)
8001 include 'DIMENSIONS'
8002 include 'DIMENSIONS.ZSCOPT'
8003 include 'COMMON.IOUNITS'
8004 include 'COMMON.CHAIN'
8005 include 'COMMON.DERIV'
8006 include 'COMMON.INTERACT'
8007 include 'COMMON.CONTACTS'
8008 include 'COMMON.TORSION'
8009 include 'COMMON.VAR'
8010 include 'COMMON.GEO'
8011 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8012 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8014 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8015 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8016 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8017 C the respective energy moment and not to the cluster cumulant.
8022 iti=itortyp(itype(i))
8023 itk=itortyp(itype(k))
8024 itk1=itortyp(itype(k+1))
8025 itl=itortyp(itype(l))
8026 itj=itortyp(itype(j))
8027 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8028 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8029 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8034 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8036 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8040 derx_turn(lll,kkk,iii)=0.0d0
8047 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8049 cd write (2,*) 'eello6_5',eello6_5
8051 call transpose2(AEA(1,1,1),auxmat(1,1))
8052 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8053 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8054 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8058 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8059 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8060 s2 = scalar2(b1(1,itk),vtemp1(1))
8062 call transpose2(AEA(1,1,2),atemp(1,1))
8063 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8064 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8065 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8069 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8070 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8071 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8073 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8074 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8075 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8076 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8077 ss13 = scalar2(b1(1,itk),vtemp4(1))
8078 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8082 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8088 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8090 C Derivatives in gamma(i+2)
8092 call transpose2(AEA(1,1,1),auxmatd(1,1))
8093 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8094 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8095 call transpose2(AEAderg(1,1,2),atempd(1,1))
8096 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8097 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8101 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8102 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8103 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8109 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8110 C Derivatives in gamma(i+3)
8112 call transpose2(AEA(1,1,1),auxmatd(1,1))
8113 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8114 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8115 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8119 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8120 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8121 s2d = scalar2(b1(1,itk),vtemp1d(1))
8123 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8124 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8126 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8128 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8129 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8130 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8140 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8141 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8143 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8144 & -0.5d0*ekont*(s2d+s12d)
8146 C Derivatives in gamma(i+4)
8147 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8148 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8149 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8151 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8152 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8153 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8163 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8165 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8167 C Derivatives in gamma(i+5)
8169 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8170 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8171 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8175 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8176 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8177 s2d = scalar2(b1(1,itk),vtemp1d(1))
8179 call transpose2(AEA(1,1,2),atempd(1,1))
8180 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8181 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8185 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8186 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8188 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8189 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8190 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8200 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8201 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8203 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8204 & -0.5d0*ekont*(s2d+s12d)
8206 C Cartesian derivatives
8211 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8212 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8213 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8217 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8218 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8220 s2d = scalar2(b1(1,itk),vtemp1d(1))
8222 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8223 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8224 s8d = -(atempd(1,1)+atempd(2,2))*
8225 & scalar2(cc(1,1,itl),vtemp2(1))
8229 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8231 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8232 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8239 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8242 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8246 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8247 & - 0.5d0*(s8d+s12d)
8249 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8258 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8260 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8261 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8262 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8263 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8264 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8266 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8267 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8268 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8272 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8273 cd & 16*eel_turn6_num
8275 if (j.lt.nres-1) then
8282 if (l.lt.nres-1) then
8290 ggg1(ll)=eel_turn6*g_contij(ll,1)
8291 ggg2(ll)=eel_turn6*g_contij(ll,2)
8292 ghalf=0.5d0*ggg1(ll)
8294 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8295 & +ekont*derx_turn(ll,2,1)
8296 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8297 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8298 & +ekont*derx_turn(ll,4,1)
8299 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8300 ghalf=0.5d0*ggg2(ll)
8302 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8303 & +ekont*derx_turn(ll,2,2)
8304 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8305 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8306 & +ekont*derx_turn(ll,4,2)
8307 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8312 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8317 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8323 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8328 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8332 cd write (2,*) iii,g_corr6_loc(iii)
8335 eello_turn6=ekont*eel_turn6
8336 cd write (2,*) 'ekont',ekont
8337 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8340 crc-------------------------------------------------
8341 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8342 subroutine Eliptransfer(eliptran)
8343 implicit real*8 (a-h,o-z)
8344 include 'DIMENSIONS'
8345 include 'COMMON.GEO'
8346 include 'COMMON.VAR'
8347 include 'COMMON.LOCAL'
8348 include 'COMMON.CHAIN'
8349 include 'COMMON.DERIV'
8350 include 'COMMON.INTERACT'
8351 include 'COMMON.IOUNITS'
8352 include 'COMMON.CALC'
8353 include 'COMMON.CONTROL'
8354 include 'COMMON.SPLITELE'
8355 include 'COMMON.SBRIDGE'
8356 C this is done by Adasko
8360 C--bordliptop-- buffore starts
8361 C--bufliptop--- here true lipid starts
8363 C--buflipbot--- lipid ends buffore starts
8364 C--bordlipbot--buffore ends
8368 if (itype(i).eq.ntyp1) cycle
8370 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8371 if (positi.le.0) positi=positi+boxzsize
8373 C first for peptide groups
8374 c for each residue check if it is in lipid or lipid water border area
8375 if ((positi.gt.bordlipbot)
8376 &.and.(positi.lt.bordliptop)) then
8377 C the energy transfer exist
8378 if (positi.lt.buflipbot) then
8379 C what fraction I am in
8381 & ((positi-bordlipbot)/lipbufthick)
8382 C lipbufthick is thickenes of lipid buffore
8383 sslip=sscalelip(fracinbuf)
8384 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8385 eliptran=eliptran+sslip*pepliptran
8386 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8387 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8388 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8389 elseif (positi.gt.bufliptop) then
8390 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8391 sslip=sscalelip(fracinbuf)
8392 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8393 eliptran=eliptran+sslip*pepliptran
8394 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8395 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8396 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8397 C print *, "doing sscalefor top part"
8398 C print *,i,sslip,fracinbuf,ssgradlip
8400 eliptran=eliptran+pepliptran
8401 C print *,"I am in true lipid"
8404 C eliptran=elpitran+0.0 ! I am in water
8407 C print *, "nic nie bylo w lipidzie?"
8408 C now multiply all by the peptide group transfer factor
8409 C eliptran=eliptran*pepliptran
8410 C now the same for side chains
8413 if (itype(i).eq.ntyp1) cycle
8414 positi=(mod(c(3,i+nres),boxzsize))
8415 if (positi.le.0) positi=positi+boxzsize
8416 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8417 c for each residue check if it is in lipid or lipid water border area
8418 C respos=mod(c(3,i+nres),boxzsize)
8419 C print *,positi,bordlipbot,buflipbot
8420 if ((positi.gt.bordlipbot)
8421 & .and.(positi.lt.bordliptop)) then
8422 C the energy transfer exist
8423 if (positi.lt.buflipbot) then
8425 & ((positi-bordlipbot)/lipbufthick)
8426 C lipbufthick is thickenes of lipid buffore
8427 sslip=sscalelip(fracinbuf)
8428 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8429 eliptran=eliptran+sslip*liptranene(itype(i))
8430 gliptranx(3,i)=gliptranx(3,i)
8431 &+ssgradlip*liptranene(itype(i))
8432 gliptranc(3,i-1)= gliptranc(3,i-1)
8433 &+ssgradlip*liptranene(itype(i))
8434 C print *,"doing sccale for lower part"
8435 elseif (positi.gt.bufliptop) then
8437 &((bordliptop-positi)/lipbufthick)
8438 sslip=sscalelip(fracinbuf)
8439 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8440 eliptran=eliptran+sslip*liptranene(itype(i))
8441 gliptranx(3,i)=gliptranx(3,i)
8442 &+ssgradlip*liptranene(itype(i))
8443 gliptranc(3,i-1)= gliptranc(3,i-1)
8444 &+ssgradlip*liptranene(itype(i))
8445 C print *, "doing sscalefor top part",sslip,fracinbuf
8447 eliptran=eliptran+liptranene(itype(i))
8448 C print *,"I am in true lipid"
8450 endif ! if in lipid or buffor
8452 C eliptran=elpitran+0.0 ! I am in water
8458 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
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)
8652 C-----------------------------------------------------------------------
8653 subroutine set_shield_fac
8654 implicit real*8 (a-h,o-z)
8655 include 'DIMENSIONS'
8656 include 'COMMON.CHAIN'
8657 include 'COMMON.DERIV'
8658 include 'COMMON.IOUNITS'
8659 include 'COMMON.SHIELD'
8660 include 'COMMON.INTERACT'
8661 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8662 double precision div77_81/0.974996043d0/,
8663 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8665 C the vector between center of side_chain and peptide group
8666 double precision pep_side(3),long,side_calf(3),
8667 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8668 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8669 C the line belowe needs to be changed for FGPROC>1
8671 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8673 Cif there two consequtive dummy atoms there is no peptide group between them
8674 C the line below has to be changed for FGPROC>1
8677 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8681 C first lets set vector conecting the ithe side-chain with kth side-chain
8682 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8684 C and vector conecting the side-chain with its proper calfa
8685 side_calf(j)=c(j,k+nres)-c(j,k)
8686 C side_calf(j)=2.0d0
8687 pept_group(j)=c(j,i)-c(j,i+1)
8688 C lets have their lenght
8689 dist_pep_side=pep_side(j)**2+dist_pep_side
8690 dist_side_calf=dist_side_calf+side_calf(j)**2
8691 dist_pept_group=dist_pept_group+pept_group(j)**2
8693 dist_pep_side=dsqrt(dist_pep_side)
8694 dist_pept_group=dsqrt(dist_pept_group)
8695 dist_side_calf=dsqrt(dist_side_calf)
8697 pep_side_norm(j)=pep_side(j)/dist_pep_side
8698 side_calf_norm(j)=dist_side_calf
8700 C now sscale fraction
8701 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8702 C print *,buff_shield,"buff"
8704 if (sh_frac_dist.le.0.0) cycle
8705 C If we reach here it means that this side chain reaches the shielding sphere
8706 C Lets add him to the list for gradient
8707 ishield_list(i)=ishield_list(i)+1
8708 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8709 C this list is essential otherwise problem would be O3
8710 shield_list(ishield_list(i),i)=k
8711 C Lets have the sscale value
8712 if (sh_frac_dist.gt.1.0) then
8713 scale_fac_dist=1.0d0
8715 sh_frac_dist_grad(j)=0.0d0
8718 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8719 & *(2.0*sh_frac_dist-3.0d0)
8720 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8721 & /dist_pep_side/buff_shield*0.5
8722 C remember for the final gradient multiply sh_frac_dist_grad(j)
8723 C for side_chain by factor -2 !
8725 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8726 C print *,"jestem",scale_fac_dist,fac_help_scale,
8727 C & sh_frac_dist_grad(j)
8730 C if ((i.eq.3).and.(k.eq.2)) then
8731 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8735 C this is what is now we have the distance scaling now volume...
8736 short=short_r_sidechain(itype(k))
8737 long=long_r_sidechain(itype(k))
8738 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8741 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8744 costhet_grad(j)=costhet_fac*pep_side(j)
8746 C remember for the final gradient multiply costhet_grad(j)
8747 C for side_chain by factor -2 !
8748 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8749 C pep_side0pept_group is vector multiplication
8750 pep_side0pept_group=0.0
8752 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8754 cosalfa=(pep_side0pept_group/
8755 & (dist_pep_side*dist_side_calf))
8756 fac_alfa_sin=1.0-cosalfa**2
8757 fac_alfa_sin=dsqrt(fac_alfa_sin)
8758 rkprim=fac_alfa_sin*(long-short)+short
8760 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8761 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8764 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8765 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8766 &*(long-short)/fac_alfa_sin*cosalfa/
8767 &((dist_pep_side*dist_side_calf))*
8768 &((side_calf(j))-cosalfa*
8769 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8771 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8772 &*(long-short)/fac_alfa_sin*cosalfa
8773 &/((dist_pep_side*dist_side_calf))*
8775 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8778 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8781 C now the gradient...
8782 C grad_shield is gradient of Calfa for peptide groups
8783 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8785 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8786 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8788 grad_shield(j,i)=grad_shield(j,i)
8789 C gradient po skalowaniu
8790 & +(sh_frac_dist_grad(j)
8791 C gradient po costhet
8792 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8793 &-scale_fac_dist*(cosphi_grad_long(j))
8794 &/(1.0-cosphi) )*div77_81
8796 C grad_shield_side is Cbeta sidechain gradient
8797 grad_shield_side(j,ishield_list(i),i)=
8798 & (sh_frac_dist_grad(j)*-2.0d0
8799 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8800 & +scale_fac_dist*(cosphi_grad_long(j))
8801 & *2.0d0/(1.0-cosphi))
8802 & *div77_81*VofOverlap
8804 grad_shield_loc(j,ishield_list(i),i)=
8805 & scale_fac_dist*cosphi_grad_loc(j)
8806 & *2.0d0/(1.0-cosphi)
8807 & *div77_81*VofOverlap
8809 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8811 fac_shield(i)=VolumeTotal*div77_81+div4_81
8812 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8816 C--------------------------------------------------------------------------
8817 C first for shielding is setting of function of side-chains
8818 subroutine set_shield_fac2
8819 implicit real*8 (a-h,o-z)
8820 include 'DIMENSIONS'
8821 include 'COMMON.CHAIN'
8822 include 'COMMON.DERIV'
8823 include 'COMMON.IOUNITS'
8824 include 'COMMON.SHIELD'
8825 include 'COMMON.INTERACT'
8826 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8827 double precision div77_81/0.974996043d0/,
8828 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8830 C the vector between center of side_chain and peptide group
8831 double precision pep_side(3),long,side_calf(3),
8832 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8833 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8834 C the line belowe needs to be changed for FGPROC>1
8836 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8838 Cif there two consequtive dummy atoms there is no peptide group between them
8839 C the line below has to be changed for FGPROC>1
8842 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8846 C first lets set vector conecting the ithe side-chain with kth side-chain
8847 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8849 C and vector conecting the side-chain with its proper calfa
8850 side_calf(j)=c(j,k+nres)-c(j,k)
8851 C side_calf(j)=2.0d0
8852 pept_group(j)=c(j,i)-c(j,i+1)
8853 C lets have their lenght
8854 dist_pep_side=pep_side(j)**2+dist_pep_side
8855 dist_side_calf=dist_side_calf+side_calf(j)**2
8856 dist_pept_group=dist_pept_group+pept_group(j)**2
8858 dist_pep_side=dsqrt(dist_pep_side)
8859 dist_pept_group=dsqrt(dist_pept_group)
8860 dist_side_calf=dsqrt(dist_side_calf)
8862 pep_side_norm(j)=pep_side(j)/dist_pep_side
8863 side_calf_norm(j)=dist_side_calf
8865 C now sscale fraction
8866 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8867 C print *,buff_shield,"buff"
8869 if (sh_frac_dist.le.0.0) cycle
8870 C If we reach here it means that this side chain reaches the shielding sphere
8871 C Lets add him to the list for gradient
8872 ishield_list(i)=ishield_list(i)+1
8873 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8874 C this list is essential otherwise problem would be O3
8875 shield_list(ishield_list(i),i)=k
8876 C Lets have the sscale value
8877 if (sh_frac_dist.gt.1.0) then
8878 scale_fac_dist=1.0d0
8880 sh_frac_dist_grad(j)=0.0d0
8883 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8884 & *(2.0d0*sh_frac_dist-3.0d0)
8885 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8886 & /dist_pep_side/buff_shield*0.5d0
8887 C remember for the final gradient multiply sh_frac_dist_grad(j)
8888 C for side_chain by factor -2 !
8890 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8891 C sh_frac_dist_grad(j)=0.0d0
8892 C scale_fac_dist=1.0d0
8893 C print *,"jestem",scale_fac_dist,fac_help_scale,
8894 C & sh_frac_dist_grad(j)
8897 C this is what is now we have the distance scaling now volume...
8898 short=short_r_sidechain(itype(k))
8899 long=long_r_sidechain(itype(k))
8900 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8901 sinthet=short/dist_pep_side*costhet
8905 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8906 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8907 C & -short/dist_pep_side**2/costhet)
8910 costhet_grad(j)=costhet_fac*pep_side(j)
8912 C remember for the final gradient multiply costhet_grad(j)
8913 C for side_chain by factor -2 !
8914 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8915 C pep_side0pept_group is vector multiplication
8916 pep_side0pept_group=0.0d0
8918 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8920 cosalfa=(pep_side0pept_group/
8921 & (dist_pep_side*dist_side_calf))
8922 fac_alfa_sin=1.0d0-cosalfa**2
8923 fac_alfa_sin=dsqrt(fac_alfa_sin)
8924 rkprim=fac_alfa_sin*(long-short)+short
8928 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8930 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8931 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8935 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8936 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8937 &*(long-short)/fac_alfa_sin*cosalfa/
8938 &((dist_pep_side*dist_side_calf))*
8939 &((side_calf(j))-cosalfa*
8940 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8941 C cosphi_grad_long(j)=0.0d0
8942 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8943 &*(long-short)/fac_alfa_sin*cosalfa
8944 &/((dist_pep_side*dist_side_calf))*
8946 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8947 C cosphi_grad_loc(j)=0.0d0
8949 C print *,sinphi,sinthet
8950 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8953 C now the gradient...
8955 grad_shield(j,i)=grad_shield(j,i)
8956 C gradient po skalowaniu
8957 & +(sh_frac_dist_grad(j)*VofOverlap
8958 C gradient po costhet
8959 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8960 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8961 & sinphi/sinthet*costhet*costhet_grad(j)
8962 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8964 C grad_shield_side is Cbeta sidechain gradient
8965 grad_shield_side(j,ishield_list(i),i)=
8966 & (sh_frac_dist_grad(j)*-2.0d0
8968 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8969 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8970 & sinphi/sinthet*costhet*costhet_grad(j)
8971 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8974 grad_shield_loc(j,ishield_list(i),i)=
8975 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8976 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8977 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8981 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8983 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8984 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8985 C write(2,*) "TU",rpp(1,1),short,long,buff_shield