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)
3172 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3173 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3174 C changes suggested by Ana to avoid out of bounds
3175 C & .or.((i+5).gt.nres)
3176 C & .or.((i-1).le.0)
3177 C end of changes suggested by Ana
3178 & .or. itype(i+3).eq.ntyp1
3179 & .or. itype(i+4).eq.ntyp1
3180 C & .or. itype(i+5).eq.ntyp1
3181 & .or. itype(i).eq.ntyp1
3182 C & .or. itype(i-1).eq.ntyp1
3184 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3186 C Fourth-order contributions
3194 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3195 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3196 iti1=itortyp(itype(i+1))
3197 iti2=itortyp(itype(i+2))
3198 iti3=itortyp(itype(i+3))
3199 call transpose2(EUg(1,1,i+1),e1t(1,1))
3200 call transpose2(Eug(1,1,i+2),e2t(1,1))
3201 call transpose2(Eug(1,1,i+3),e3t(1,1))
3202 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3203 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3204 s1=scalar2(b1(1,iti2),auxvec(1))
3205 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3206 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3207 s2=scalar2(b1(1,iti1),auxvec(1))
3208 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3209 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3210 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3211 if (shield_mode.eq.0) then
3219 eello_turn4=eello_turn4-(s1+s2+s3)
3220 & *fac_shield(i)*fac_shield(j)
3221 eello_t4=-(s1+s2+s3)
3222 & *fac_shield(i)*fac_shield(j)
3224 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3225 cd & ' eello_turn4_num',8*eello_turn4_num
3226 C Derivatives in gamma(i)
3228 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3229 & (shield_mode.gt.0)) then
3232 do ilist=1,ishield_list(i)
3233 iresshield=shield_list(ilist,i)
3235 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3237 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3239 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3240 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3244 do ilist=1,ishield_list(j)
3245 iresshield=shield_list(ilist,j)
3247 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3249 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3251 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3252 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3259 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3260 & grad_shield(k,i)*eello_t4/fac_shield(i)
3261 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3262 & grad_shield(k,j)*eello_t4/fac_shield(j)
3263 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3264 & grad_shield(k,i)*eello_t4/fac_shield(i)
3265 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3266 & grad_shield(k,j)*eello_t4/fac_shield(j)
3269 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3270 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3271 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3272 s1=scalar2(b1(1,iti2),auxvec(1))
3273 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3274 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3275 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3276 & *fac_shield(i)*fac_shield(j)
3278 C Derivatives in gamma(i+1)
3279 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3280 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3281 s2=scalar2(b1(1,iti1),auxvec(1))
3282 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3283 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3284 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3285 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3286 & *fac_shield(i)*fac_shield(j)
3288 C Derivatives in gamma(i+2)
3289 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3290 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3291 s1=scalar2(b1(1,iti2),auxvec(1))
3292 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3293 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3294 s2=scalar2(b1(1,iti1),auxvec(1))
3295 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3296 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3297 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3298 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3299 & *fac_shield(i)*fac_shield(j)
3301 C Cartesian derivatives
3303 C Derivatives of this turn contributions in DC(i+2)
3304 if (j.lt.nres-1) then
3306 a_temp(1,1)=agg(l,1)
3307 a_temp(1,2)=agg(l,2)
3308 a_temp(2,1)=agg(l,3)
3309 a_temp(2,2)=agg(l,4)
3310 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3311 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3312 s1=scalar2(b1(1,iti2),auxvec(1))
3313 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3314 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3315 s2=scalar2(b1(1,iti1),auxvec(1))
3316 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3317 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3318 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3320 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3321 & *fac_shield(i)*fac_shield(j)
3325 C Remaining derivatives of this turn contribution
3327 a_temp(1,1)=aggi(l,1)
3328 a_temp(1,2)=aggi(l,2)
3329 a_temp(2,1)=aggi(l,3)
3330 a_temp(2,2)=aggi(l,4)
3331 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3332 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3333 s1=scalar2(b1(1,iti2),auxvec(1))
3334 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3335 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3336 s2=scalar2(b1(1,iti1),auxvec(1))
3337 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3338 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3339 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3340 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3341 & *fac_shield(i)*fac_shield(j)
3343 a_temp(1,1)=aggi1(l,1)
3344 a_temp(1,2)=aggi1(l,2)
3345 a_temp(2,1)=aggi1(l,3)
3346 a_temp(2,2)=aggi1(l,4)
3347 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3348 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3349 s1=scalar2(b1(1,iti2),auxvec(1))
3350 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3351 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3352 s2=scalar2(b1(1,iti1),auxvec(1))
3353 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3354 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3355 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3356 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3357 & *fac_shield(i)*fac_shield(j)
3359 a_temp(1,1)=aggj(l,1)
3360 a_temp(1,2)=aggj(l,2)
3361 a_temp(2,1)=aggj(l,3)
3362 a_temp(2,2)=aggj(l,4)
3363 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3364 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3365 s1=scalar2(b1(1,iti2),auxvec(1))
3366 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3367 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3368 s2=scalar2(b1(1,iti1),auxvec(1))
3369 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3370 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3371 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3372 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3373 & *fac_shield(i)*fac_shield(j)
3375 a_temp(1,1)=aggj1(l,1)
3376 a_temp(1,2)=aggj1(l,2)
3377 a_temp(2,1)=aggj1(l,3)
3378 a_temp(2,2)=aggj1(l,4)
3379 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3380 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3381 s1=scalar2(b1(1,iti2),auxvec(1))
3382 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3383 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3384 s2=scalar2(b1(1,iti1),auxvec(1))
3385 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3386 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3387 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3388 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3389 & *fac_shield(i)*fac_shield(j)
3397 C-----------------------------------------------------------------------------
3398 subroutine vecpr(u,v,w)
3399 implicit real*8(a-h,o-z)
3400 dimension u(3),v(3),w(3)
3401 w(1)=u(2)*v(3)-u(3)*v(2)
3402 w(2)=-u(1)*v(3)+u(3)*v(1)
3403 w(3)=u(1)*v(2)-u(2)*v(1)
3406 C-----------------------------------------------------------------------------
3407 subroutine unormderiv(u,ugrad,unorm,ungrad)
3408 C This subroutine computes the derivatives of a normalized vector u, given
3409 C the derivatives computed without normalization conditions, ugrad. Returns
3412 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3413 double precision vec(3)
3414 double precision scalar
3416 c write (2,*) 'ugrad',ugrad
3419 vec(i)=scalar(ugrad(1,i),u(1))
3421 c write (2,*) 'vec',vec
3424 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3427 c write (2,*) 'ungrad',ungrad
3430 C-----------------------------------------------------------------------------
3431 subroutine escp(evdw2,evdw2_14)
3433 C This subroutine calculates the excluded-volume interaction energy between
3434 C peptide-group centers and side chains and its gradient in virtual-bond and
3435 C side-chain vectors.
3437 implicit real*8 (a-h,o-z)
3438 include 'DIMENSIONS'
3439 include 'DIMENSIONS.ZSCOPT'
3440 include 'COMMON.GEO'
3441 include 'COMMON.VAR'
3442 include 'COMMON.LOCAL'
3443 include 'COMMON.CHAIN'
3444 include 'COMMON.DERIV'
3445 include 'COMMON.INTERACT'
3446 include 'COMMON.FFIELD'
3447 include 'COMMON.IOUNITS'
3451 cd print '(a)','Enter ESCP'
3452 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3453 c & ' scal14',scal14
3454 do i=iatscp_s,iatscp_e
3455 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3457 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3458 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3459 if (iteli.eq.0) goto 1225
3460 xi=0.5D0*(c(1,i)+c(1,i+1))
3461 yi=0.5D0*(c(2,i)+c(2,i+1))
3462 zi=0.5D0*(c(3,i)+c(3,i+1))
3463 C Returning the ith atom to box
3465 if (xi.lt.0) xi=xi+boxxsize
3467 if (yi.lt.0) yi=yi+boxysize
3469 if (zi.lt.0) zi=zi+boxzsize
3470 do iint=1,nscp_gr(i)
3472 do j=iscpstart(i,iint),iscpend(i,iint)
3473 itypj=iabs(itype(j))
3474 if (itypj.eq.ntyp1) cycle
3475 C Uncomment following three lines for SC-p interactions
3479 C Uncomment following three lines for Ca-p interactions
3483 C returning the jth atom to box
3485 if (xj.lt.0) xj=xj+boxxsize
3487 if (yj.lt.0) yj=yj+boxysize
3489 if (zj.lt.0) zj=zj+boxzsize
3490 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3495 C Finding the closest jth atom
3499 xj=xj_safe+xshift*boxxsize
3500 yj=yj_safe+yshift*boxysize
3501 zj=zj_safe+zshift*boxzsize
3502 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3503 if(dist_temp.lt.dist_init) then
3513 if (subchap.eq.1) then
3522 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3523 C sss is scaling function for smoothing the cutoff gradient otherwise
3524 C the gradient would not be continuouse
3525 sss=sscale(1.0d0/(dsqrt(rrij)))
3526 if (sss.le.0.0d0) cycle
3527 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3529 e1=fac*fac*aad(itypj,iteli)
3530 e2=fac*bad(itypj,iteli)
3531 if (iabs(j-i) .le. 2) then
3534 evdw2_14=evdw2_14+(e1+e2)*sss
3537 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3538 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3539 c & bad(itypj,iteli)
3540 evdw2=evdw2+evdwij*sss
3543 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3545 fac=-(evdwij+e1)*rrij*sss
3546 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3551 cd write (iout,*) 'j<i'
3552 C Uncomment following three lines for SC-p interactions
3554 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3557 cd write (iout,*) 'j>i'
3560 C Uncomment following line for SC-p interactions
3561 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3565 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3569 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3570 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3573 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3583 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3584 gradx_scp(j,i)=expon*gradx_scp(j,i)
3587 C******************************************************************************
3591 C To save time the factor EXPON has been extracted from ALL components
3592 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3595 C******************************************************************************
3598 C--------------------------------------------------------------------------
3599 subroutine edis(ehpb)
3601 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3603 implicit real*8 (a-h,o-z)
3604 include 'DIMENSIONS'
3605 include 'DIMENSIONS.ZSCOPT'
3606 include 'COMMON.SBRIDGE'
3607 include 'COMMON.CHAIN'
3608 include 'COMMON.DERIV'
3609 include 'COMMON.VAR'
3610 include 'COMMON.INTERACT'
3611 include 'COMMON.CONTROL'
3612 include 'COMMON.IOUNITS'
3615 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3616 cd print *,'link_start=',link_start,' link_end=',link_end
3617 C write(iout,*) link_end, "link_end"
3618 if (link_end.eq.0) return
3619 do i=link_start,link_end
3620 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3621 C CA-CA distance used in regularization of structure.
3624 C iii and jjj point to the residues for which the distance is assigned.
3625 if (ii.gt.nres) then
3632 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3633 C distance and angle dependent SS bond potential.
3634 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3635 C & iabs(itype(jjj)).eq.1) then
3636 C write(iout,*) constr_dist,"const"
3637 if (.not.dyn_ss .and. i.le.nss) then
3638 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3639 & iabs(itype(jjj)).eq.1) then
3640 call ssbond_ene(iii,jjj,eij)
3643 else if (ii.gt.nres .and. jj.gt.nres) then
3644 c Restraints from contact prediction
3646 if (constr_dist.eq.11) then
3647 C ehpb=ehpb+fordepth(i)**4.0d0
3648 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3649 ehpb=ehpb+fordepth(i)**4.0d0
3650 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3651 fac=fordepth(i)**4.0d0
3652 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3653 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3654 C & ehpb,fordepth(i),dd
3655 C write(iout,*) ehpb,"atu?"
3657 C fac=fordepth(i)**4.0d0
3658 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3660 if (dhpb1(i).gt.0.0d0) then
3661 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3662 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3663 c write (iout,*) "beta nmr",
3664 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3668 C Get the force constant corresponding to this distance.
3670 C Calculate the contribution to energy.
3671 ehpb=ehpb+waga*rdis*rdis
3672 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3674 C Evaluate gradient.
3677 endif !end dhpb1(i).gt.0
3678 endif !end const_dist=11
3680 ggg(j)=fac*(c(j,jj)-c(j,ii))
3683 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3684 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3687 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3688 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3691 C write(iout,*) "before"
3693 C write(iout,*) "after",dd
3694 if (constr_dist.eq.11) then
3695 ehpb=ehpb+fordepth(i)**4.0d0
3696 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3697 fac=fordepth(i)**4.0d0
3698 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3699 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3700 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3701 C print *,ehpb,"tu?"
3702 C write(iout,*) ehpb,"btu?",
3703 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3704 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3705 C & ehpb,fordepth(i),dd
3707 if (dhpb1(i).gt.0.0d0) then
3708 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3709 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3710 c write (iout,*) "alph nmr",
3711 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3714 C Get the force constant corresponding to this distance.
3716 C Calculate the contribution to energy.
3717 ehpb=ehpb+waga*rdis*rdis
3718 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3720 C Evaluate gradient.
3727 ggg(j)=fac*(c(j,jj)-c(j,ii))
3729 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3730 C If this is a SC-SC distance, we need to calculate the contributions to the
3731 C Cartesian gradient in the SC vectors (ghpbx).
3734 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3735 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3740 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3745 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3748 C--------------------------------------------------------------------------
3749 subroutine ssbond_ene(i,j,eij)
3751 C Calculate the distance and angle dependent SS-bond potential energy
3752 C using a free-energy function derived based on RHF/6-31G** ab initio
3753 C calculations of diethyl disulfide.
3755 C A. Liwo and U. Kozlowska, 11/24/03
3757 implicit real*8 (a-h,o-z)
3758 include 'DIMENSIONS'
3759 include 'DIMENSIONS.ZSCOPT'
3760 include 'COMMON.SBRIDGE'
3761 include 'COMMON.CHAIN'
3762 include 'COMMON.DERIV'
3763 include 'COMMON.LOCAL'
3764 include 'COMMON.INTERACT'
3765 include 'COMMON.VAR'
3766 include 'COMMON.IOUNITS'
3767 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3768 itypi=iabs(itype(i))
3772 dxi=dc_norm(1,nres+i)
3773 dyi=dc_norm(2,nres+i)
3774 dzi=dc_norm(3,nres+i)
3775 dsci_inv=dsc_inv(itypi)
3776 itypj=iabs(itype(j))
3777 dscj_inv=dsc_inv(itypj)
3781 dxj=dc_norm(1,nres+j)
3782 dyj=dc_norm(2,nres+j)
3783 dzj=dc_norm(3,nres+j)
3784 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3789 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3790 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3791 om12=dxi*dxj+dyi*dyj+dzi*dzj
3793 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3794 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3800 deltat12=om2-om1+2.0d0
3802 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3803 & +akct*deltad*deltat12
3804 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3805 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3806 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3807 c & " deltat12",deltat12," eij",eij
3808 ed=2*akcm*deltad+akct*deltat12
3810 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3811 eom1=-2*akth*deltat1-pom1-om2*pom2
3812 eom2= 2*akth*deltat2+pom1-om1*pom2
3815 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3818 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3819 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3820 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3821 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3824 C Calculate the components of the gradient in DC and X
3828 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3833 C--------------------------------------------------------------------------
3834 subroutine ebond(estr)
3836 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3838 implicit real*8 (a-h,o-z)
3839 include 'DIMENSIONS'
3840 include 'DIMENSIONS.ZSCOPT'
3841 include 'COMMON.LOCAL'
3842 include 'COMMON.GEO'
3843 include 'COMMON.INTERACT'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.VAR'
3846 include 'COMMON.CHAIN'
3847 include 'COMMON.IOUNITS'
3848 include 'COMMON.NAMES'
3849 include 'COMMON.FFIELD'
3850 include 'COMMON.CONTROL'
3851 logical energy_dec /.false./
3852 double precision u(3),ud(3)
3855 c write (iout,*) "distchainmax",distchainmax
3857 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3858 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3860 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3861 C & *dc(j,i-1)/vbld(i)
3863 C if (energy_dec) write(iout,*)
3864 C & "estr1",i,vbld(i),distchainmax,
3865 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3867 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3868 diff = vbld(i)-vbldpDUM
3869 C write(iout,*) i,diff
3871 diff = vbld(i)-vbldp0
3872 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3876 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3879 C write (iout,'(a7,i5,4f7.3)')
3880 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3882 estr=0.5d0*AKP*estr+estr1
3884 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3888 if (iti.ne.10 .and. iti.ne.ntyp1) then
3891 diff=vbld(i+nres)-vbldsc0(1,iti)
3892 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3893 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3894 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3896 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3900 diff=vbld(i+nres)-vbldsc0(j,iti)
3901 ud(j)=aksc(j,iti)*diff
3902 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3916 uprod2=uprod2*u(k)*u(k)
3920 usumsqder=usumsqder+ud(j)*uprod2
3922 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3923 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3924 estr=estr+uprod/usum
3926 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3934 C--------------------------------------------------------------------------
3935 subroutine ebend(etheta,ethetacnstr)
3937 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3938 C angles gamma and its derivatives in consecutive thetas and gammas.
3940 implicit real*8 (a-h,o-z)
3941 include 'DIMENSIONS'
3942 include 'DIMENSIONS.ZSCOPT'
3943 include 'COMMON.LOCAL'
3944 include 'COMMON.GEO'
3945 include 'COMMON.INTERACT'
3946 include 'COMMON.DERIV'
3947 include 'COMMON.VAR'
3948 include 'COMMON.CHAIN'
3949 include 'COMMON.IOUNITS'
3950 include 'COMMON.NAMES'
3951 include 'COMMON.FFIELD'
3952 include 'COMMON.TORCNSTR'
3953 common /calcthet/ term1,term2,termm,diffak,ratak,
3954 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3955 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3956 double precision y(2),z(2)
3958 c time11=dexp(-2*time)
3961 c write (iout,*) "nres",nres
3962 c write (*,'(a,i2)') 'EBEND ICG=',icg
3963 c write (iout,*) ithet_start,ithet_end
3964 do i=ithet_start,ithet_end
3965 C if (itype(i-1).eq.ntyp1) cycle
3967 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3968 & .or.itype(i).eq.ntyp1) cycle
3969 C Zero the energy function and its derivative at 0 or pi.
3970 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3972 ichir1=isign(1,itype(i-2))
3973 ichir2=isign(1,itype(i))
3974 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3975 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3976 if (itype(i-1).eq.10) then
3977 itype1=isign(10,itype(i-2))
3978 ichir11=isign(1,itype(i-2))
3979 ichir12=isign(1,itype(i-2))
3980 itype2=isign(10,itype(i))
3981 ichir21=isign(1,itype(i))
3982 ichir22=isign(1,itype(i))
3989 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3993 c call proc_proc(phii,icrc)
3994 if (icrc.eq.1) phii=150.0
4005 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4009 c call proc_proc(phii1,icrc)
4010 if (icrc.eq.1) phii1=150.0
4022 C Calculate the "mean" value of theta from the part of the distribution
4023 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4024 C In following comments this theta will be referred to as t_c.
4025 thet_pred_mean=0.0d0
4027 athetk=athet(k,it,ichir1,ichir2)
4028 bthetk=bthet(k,it,ichir1,ichir2)
4030 athetk=athet(k,itype1,ichir11,ichir12)
4031 bthetk=bthet(k,itype2,ichir21,ichir22)
4033 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4035 c write (iout,*) "thet_pred_mean",thet_pred_mean
4036 dthett=thet_pred_mean*ssd
4037 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4038 c write (iout,*) "thet_pred_mean",thet_pred_mean
4039 C Derivatives of the "mean" values in gamma1 and gamma2.
4040 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4041 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4042 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4043 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4045 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4046 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4047 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4048 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4050 if (theta(i).gt.pi-delta) then
4051 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4053 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4054 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4055 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4057 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4059 else if (theta(i).lt.delta) then
4060 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4061 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4062 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4064 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4065 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4068 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4071 etheta=etheta+ethetai
4072 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4073 c & 'ebend',i,ethetai,theta(i),itype(i)
4074 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4075 c & rad2deg*phii,rad2deg*phii1,ethetai
4076 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4077 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4078 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4082 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4083 do i=1,ntheta_constr
4084 itheta=itheta_constr(i)
4085 thetiii=theta(itheta)
4086 difi=pinorm(thetiii-theta_constr0(i))
4087 if (difi.gt.theta_drange(i)) then
4088 difi=difi-theta_drange(i)
4089 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4090 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4091 & +for_thet_constr(i)*difi**3
4092 else if (difi.lt.-drange(i)) then
4094 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4095 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4096 & +for_thet_constr(i)*difi**3
4100 C if (energy_dec) then
4101 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4102 C & i,itheta,rad2deg*thetiii,
4103 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4104 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4105 C & gloc(itheta+nphi-2,icg)
4108 C Ufff.... We've done all this!!!
4111 C---------------------------------------------------------------------------
4112 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4114 implicit real*8 (a-h,o-z)
4115 include 'DIMENSIONS'
4116 include 'COMMON.LOCAL'
4117 include 'COMMON.IOUNITS'
4118 common /calcthet/ term1,term2,termm,diffak,ratak,
4119 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4120 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4121 C Calculate the contributions to both Gaussian lobes.
4122 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4123 C The "polynomial part" of the "standard deviation" of this part of
4127 sig=sig*thet_pred_mean+polthet(j,it)
4129 C Derivative of the "interior part" of the "standard deviation of the"
4130 C gamma-dependent Gaussian lobe in t_c.
4131 sigtc=3*polthet(3,it)
4133 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4136 C Set the parameters of both Gaussian lobes of the distribution.
4137 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4138 fac=sig*sig+sigc0(it)
4141 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4142 sigsqtc=-4.0D0*sigcsq*sigtc
4143 c print *,i,sig,sigtc,sigsqtc
4144 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4145 sigtc=-sigtc/(fac*fac)
4146 C Following variable is sigma(t_c)**(-2)
4147 sigcsq=sigcsq*sigcsq
4149 sig0inv=1.0D0/sig0i**2
4150 delthec=thetai-thet_pred_mean
4151 delthe0=thetai-theta0i
4152 term1=-0.5D0*sigcsq*delthec*delthec
4153 term2=-0.5D0*sig0inv*delthe0*delthe0
4154 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4155 C NaNs in taking the logarithm. We extract the largest exponent which is added
4156 C to the energy (this being the log of the distribution) at the end of energy
4157 C term evaluation for this virtual-bond angle.
4158 if (term1.gt.term2) then
4160 term2=dexp(term2-termm)
4164 term1=dexp(term1-termm)
4167 C The ratio between the gamma-independent and gamma-dependent lobes of
4168 C the distribution is a Gaussian function of thet_pred_mean too.
4169 diffak=gthet(2,it)-thet_pred_mean
4170 ratak=diffak/gthet(3,it)**2
4171 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4172 C Let's differentiate it in thet_pred_mean NOW.
4174 C Now put together the distribution terms to make complete distribution.
4175 termexp=term1+ak*term2
4176 termpre=sigc+ak*sig0i
4177 C Contribution of the bending energy from this theta is just the -log of
4178 C the sum of the contributions from the two lobes and the pre-exponential
4179 C factor. Simple enough, isn't it?
4180 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4181 C NOW the derivatives!!!
4182 C 6/6/97 Take into account the deformation.
4183 E_theta=(delthec*sigcsq*term1
4184 & +ak*delthe0*sig0inv*term2)/termexp
4185 E_tc=((sigtc+aktc*sig0i)/termpre
4186 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4187 & aktc*term2)/termexp)
4190 c-----------------------------------------------------------------------------
4191 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4192 implicit real*8 (a-h,o-z)
4193 include 'DIMENSIONS'
4194 include 'COMMON.LOCAL'
4195 include 'COMMON.IOUNITS'
4196 common /calcthet/ term1,term2,termm,diffak,ratak,
4197 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4198 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4199 delthec=thetai-thet_pred_mean
4200 delthe0=thetai-theta0i
4201 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4202 t3 = thetai-thet_pred_mean
4206 t14 = t12+t6*sigsqtc
4208 t21 = thetai-theta0i
4214 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4215 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4216 & *(-t12*t9-ak*sig0inv*t27)
4220 C--------------------------------------------------------------------------
4221 subroutine ebend(etheta,ethetacnstr)
4223 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4224 C angles gamma and its derivatives in consecutive thetas and gammas.
4225 C ab initio-derived potentials from
4226 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4228 implicit real*8 (a-h,o-z)
4229 include 'DIMENSIONS'
4230 include 'DIMENSIONS.ZSCOPT'
4231 include 'COMMON.LOCAL'
4232 include 'COMMON.GEO'
4233 include 'COMMON.INTERACT'
4234 include 'COMMON.DERIV'
4235 include 'COMMON.VAR'
4236 include 'COMMON.CHAIN'
4237 include 'COMMON.IOUNITS'
4238 include 'COMMON.NAMES'
4239 include 'COMMON.FFIELD'
4240 include 'COMMON.CONTROL'
4241 include 'COMMON.TORCNSTR'
4242 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4243 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4244 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4245 & sinph1ph2(maxdouble,maxdouble)
4246 logical lprn /.false./, lprn1 /.false./
4248 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4249 do i=ithet_start,ithet_end
4251 C if (itype(i-1).eq.ntyp1) cycle
4253 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4254 & .or.itype(i).eq.ntyp1) cycle
4255 if (iabs(itype(i+1)).eq.20) iblock=2
4256 if (iabs(itype(i+1)).ne.20) iblock=1
4260 theti2=0.5d0*theta(i)
4261 ityp2=ithetyp((itype(i-1)))
4263 coskt(k)=dcos(k*theti2)
4264 sinkt(k)=dsin(k*theti2)
4274 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4277 if (phii.ne.phii) phii=150.0
4281 ityp1=ithetyp((itype(i-2)))
4283 cosph1(k)=dcos(k*phii)
4284 sinph1(k)=dsin(k*phii)
4290 ityp1=ithetyp((itype(i-2)))
4296 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4299 if (phii1.ne.phii1) phii1=150.0
4304 ityp3=ithetyp((itype(i)))
4306 cosph2(k)=dcos(k*phii1)
4307 sinph2(k)=dsin(k*phii1)
4312 ityp3=ithetyp((itype(i)))
4318 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4319 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4321 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4324 ccl=cosph1(l)*cosph2(k-l)
4325 ssl=sinph1(l)*sinph2(k-l)
4326 scl=sinph1(l)*cosph2(k-l)
4327 csl=cosph1(l)*sinph2(k-l)
4328 cosph1ph2(l,k)=ccl-ssl
4329 cosph1ph2(k,l)=ccl+ssl
4330 sinph1ph2(l,k)=scl+csl
4331 sinph1ph2(k,l)=scl-csl
4335 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4336 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4337 write (iout,*) "coskt and sinkt"
4339 write (iout,*) k,coskt(k),sinkt(k)
4343 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4344 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4347 & write (iout,*) "k",k,"
4348 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4349 & " ethetai",ethetai
4352 write (iout,*) "cosph and sinph"
4354 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4356 write (iout,*) "cosph1ph2 and sinph2ph2"
4359 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4360 & sinph1ph2(l,k),sinph1ph2(k,l)
4363 write(iout,*) "ethetai",ethetai
4367 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4368 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4369 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4370 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4371 ethetai=ethetai+sinkt(m)*aux
4372 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4373 dephii=dephii+k*sinkt(m)*(
4374 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4375 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4376 dephii1=dephii1+k*sinkt(m)*(
4377 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4378 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4380 & write (iout,*) "m",m," k",k," bbthet",
4381 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4382 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4383 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4384 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4388 & write(iout,*) "ethetai",ethetai
4392 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4393 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4394 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4395 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4396 ethetai=ethetai+sinkt(m)*aux
4397 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4398 dephii=dephii+l*sinkt(m)*(
4399 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4400 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4401 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4402 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4403 dephii1=dephii1+(k-l)*sinkt(m)*(
4404 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4405 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4406 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4407 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4409 write (iout,*) "m",m," k",k," l",l," ffthet",
4410 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4411 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4412 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4413 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4414 & " ethetai",ethetai
4415 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4416 & cosph1ph2(k,l)*sinkt(m),
4417 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4423 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4424 & i,theta(i)*rad2deg,phii*rad2deg,
4425 & phii1*rad2deg,ethetai
4426 etheta=etheta+ethetai
4427 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4428 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4429 c gloc(nphi+i-2,icg)=wang*dethetai
4430 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4434 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4435 do i=1,ntheta_constr
4436 itheta=itheta_constr(i)
4437 thetiii=theta(itheta)
4438 difi=pinorm(thetiii-theta_constr0(i))
4439 if (difi.gt.theta_drange(i)) then
4440 difi=difi-theta_drange(i)
4441 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4442 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4443 & +for_thet_constr(i)*difi**3
4444 else if (difi.lt.-drange(i)) then
4446 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4447 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4448 & +for_thet_constr(i)*difi**3
4452 C if (energy_dec) then
4453 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4454 C & i,itheta,rad2deg*thetiii,
4455 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4456 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4457 C & gloc(itheta+nphi-2,icg)
4464 c-----------------------------------------------------------------------------
4465 subroutine esc(escloc)
4466 C Calculate the local energy of a side chain and its derivatives in the
4467 C corresponding virtual-bond valence angles THETA and the spherical angles
4469 implicit real*8 (a-h,o-z)
4470 include 'DIMENSIONS'
4471 include 'DIMENSIONS.ZSCOPT'
4472 include 'COMMON.GEO'
4473 include 'COMMON.LOCAL'
4474 include 'COMMON.VAR'
4475 include 'COMMON.INTERACT'
4476 include 'COMMON.DERIV'
4477 include 'COMMON.CHAIN'
4478 include 'COMMON.IOUNITS'
4479 include 'COMMON.NAMES'
4480 include 'COMMON.FFIELD'
4481 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4482 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4483 common /sccalc/ time11,time12,time112,theti,it,nlobit
4486 C write (iout,*) 'ESC'
4487 do i=loc_start,loc_end
4489 if (it.eq.ntyp1) cycle
4490 if (it.eq.10) goto 1
4491 nlobit=nlob(iabs(it))
4492 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4493 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4494 theti=theta(i+1)-pipol
4498 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4500 if (x(2).gt.pi-delta) then
4504 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4506 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4507 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4509 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4510 & ddersc0(1),dersc(1))
4511 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4512 & ddersc0(3),dersc(3))
4514 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4516 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4517 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4518 & dersc0(2),esclocbi,dersc02)
4519 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4521 call splinthet(x(2),0.5d0*delta,ss,ssd)
4526 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4528 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4529 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4531 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4533 c write (iout,*) escloci
4534 else if (x(2).lt.delta) then
4538 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4540 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4541 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4543 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4544 & ddersc0(1),dersc(1))
4545 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4546 & ddersc0(3),dersc(3))
4548 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4550 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4551 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4552 & dersc0(2),esclocbi,dersc02)
4553 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4558 call splinthet(x(2),0.5d0*delta,ss,ssd)
4560 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4562 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4563 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4565 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4566 C write (iout,*) 'i=',i, escloci
4568 call enesc(x,escloci,dersc,ddummy,.false.)
4571 escloc=escloc+escloci
4572 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4573 write (iout,'(a6,i5,0pf7.3)')
4574 & 'escloc',i,escloci
4576 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4578 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4579 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4584 C---------------------------------------------------------------------------
4585 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4586 implicit real*8 (a-h,o-z)
4587 include 'DIMENSIONS'
4588 include 'COMMON.GEO'
4589 include 'COMMON.LOCAL'
4590 include 'COMMON.IOUNITS'
4591 common /sccalc/ time11,time12,time112,theti,it,nlobit
4592 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4593 double precision contr(maxlob,-1:1)
4595 c write (iout,*) 'it=',it,' nlobit=',nlobit
4599 if (mixed) ddersc(j)=0.0d0
4603 C Because of periodicity of the dependence of the SC energy in omega we have
4604 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4605 C To avoid underflows, first compute & store the exponents.
4613 z(k)=x(k)-censc(k,j,it)
4618 Axk=Axk+gaussc(l,k,j,it)*z(l)
4624 expfac=expfac+Ax(k,j,iii)*z(k)
4632 C As in the case of ebend, we want to avoid underflows in exponentiation and
4633 C subsequent NaNs and INFs in energy calculation.
4634 C Find the largest exponent
4638 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4642 cd print *,'it=',it,' emin=',emin
4644 C Compute the contribution to SC energy and derivatives
4648 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4649 cd print *,'j=',j,' expfac=',expfac
4650 escloc_i=escloc_i+expfac
4652 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4656 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4657 & +gaussc(k,2,j,it))*expfac
4664 dersc(1)=dersc(1)/cos(theti)**2
4665 ddersc(1)=ddersc(1)/cos(theti)**2
4668 escloci=-(dlog(escloc_i)-emin)
4670 dersc(j)=dersc(j)/escloc_i
4674 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4679 C------------------------------------------------------------------------------
4680 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4681 implicit real*8 (a-h,o-z)
4682 include 'DIMENSIONS'
4683 include 'COMMON.GEO'
4684 include 'COMMON.LOCAL'
4685 include 'COMMON.IOUNITS'
4686 common /sccalc/ time11,time12,time112,theti,it,nlobit
4687 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4688 double precision contr(maxlob)
4699 z(k)=x(k)-censc(k,j,it)
4705 Axk=Axk+gaussc(l,k,j,it)*z(l)
4711 expfac=expfac+Ax(k,j)*z(k)
4716 C As in the case of ebend, we want to avoid underflows in exponentiation and
4717 C subsequent NaNs and INFs in energy calculation.
4718 C Find the largest exponent
4721 if (emin.gt.contr(j)) emin=contr(j)
4725 C Compute the contribution to SC energy and derivatives
4729 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4730 escloc_i=escloc_i+expfac
4732 dersc(k)=dersc(k)+Ax(k,j)*expfac
4734 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4735 & +gaussc(1,2,j,it))*expfac
4739 dersc(1)=dersc(1)/cos(theti)**2
4740 dersc12=dersc12/cos(theti)**2
4741 escloci=-(dlog(escloc_i)-emin)
4743 dersc(j)=dersc(j)/escloc_i
4745 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4749 c----------------------------------------------------------------------------------
4750 subroutine esc(escloc)
4751 C Calculate the local energy of a side chain and its derivatives in the
4752 C corresponding virtual-bond valence angles THETA and the spherical angles
4753 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4754 C added by Urszula Kozlowska. 07/11/2007
4756 implicit real*8 (a-h,o-z)
4757 include 'DIMENSIONS'
4758 include 'DIMENSIONS.ZSCOPT'
4759 include 'COMMON.GEO'
4760 include 'COMMON.LOCAL'
4761 include 'COMMON.VAR'
4762 include 'COMMON.SCROT'
4763 include 'COMMON.INTERACT'
4764 include 'COMMON.DERIV'
4765 include 'COMMON.CHAIN'
4766 include 'COMMON.IOUNITS'
4767 include 'COMMON.NAMES'
4768 include 'COMMON.FFIELD'
4769 include 'COMMON.CONTROL'
4770 include 'COMMON.VECTORS'
4771 double precision x_prime(3),y_prime(3),z_prime(3)
4772 & , sumene,dsc_i,dp2_i,x(65),
4773 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4774 & de_dxx,de_dyy,de_dzz,de_dt
4775 double precision s1_t,s1_6_t,s2_t,s2_6_t
4777 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4778 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4779 & dt_dCi(3),dt_dCi1(3)
4780 common /sccalc/ time11,time12,time112,theti,it,nlobit
4783 do i=loc_start,loc_end
4784 if (itype(i).eq.ntyp1) cycle
4785 costtab(i+1) =dcos(theta(i+1))
4786 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4787 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4788 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4789 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4790 cosfac=dsqrt(cosfac2)
4791 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4792 sinfac=dsqrt(sinfac2)
4794 if (it.eq.10) goto 1
4796 C Compute the axes of tghe local cartesian coordinates system; store in
4797 c x_prime, y_prime and z_prime
4804 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4805 C & dc_norm(3,i+nres)
4807 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4808 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4811 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4814 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4815 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4816 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4817 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4818 c & " xy",scalar(x_prime(1),y_prime(1)),
4819 c & " xz",scalar(x_prime(1),z_prime(1)),
4820 c & " yy",scalar(y_prime(1),y_prime(1)),
4821 c & " yz",scalar(y_prime(1),z_prime(1)),
4822 c & " zz",scalar(z_prime(1),z_prime(1))
4824 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4825 C to local coordinate system. Store in xx, yy, zz.
4831 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4832 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4833 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4840 C Compute the energy of the ith side cbain
4842 c write (2,*) "xx",xx," yy",yy," zz",zz
4845 x(j) = sc_parmin(j,it)
4848 Cc diagnostics - remove later
4850 yy1 = dsin(alph(2))*dcos(omeg(2))
4851 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4852 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4853 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4855 C," --- ", xx_w,yy_w,zz_w
4858 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4859 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4861 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4862 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4864 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4865 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4866 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4867 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4868 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4870 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4871 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4872 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4873 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4874 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4876 dsc_i = 0.743d0+x(61)
4878 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4879 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4880 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4881 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4882 s1=(1+x(63))/(0.1d0 + dscp1)
4883 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4884 s2=(1+x(65))/(0.1d0 + dscp2)
4885 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4886 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4887 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4888 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4890 c & dscp1,dscp2,sumene
4891 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4892 escloc = escloc + sumene
4893 c write (2,*) "escloc",escloc
4894 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4896 if (.not. calc_grad) goto 1
4899 C This section to check the numerical derivatives of the energy of ith side
4900 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4901 C #define DEBUG in the code to turn it on.
4903 write (2,*) "sumene =",sumene
4907 write (2,*) xx,yy,zz
4908 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4909 de_dxx_num=(sumenep-sumene)/aincr
4911 write (2,*) "xx+ sumene from enesc=",sumenep
4914 write (2,*) xx,yy,zz
4915 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4916 de_dyy_num=(sumenep-sumene)/aincr
4918 write (2,*) "yy+ sumene from enesc=",sumenep
4921 write (2,*) xx,yy,zz
4922 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4923 de_dzz_num=(sumenep-sumene)/aincr
4925 write (2,*) "zz+ sumene from enesc=",sumenep
4926 costsave=cost2tab(i+1)
4927 sintsave=sint2tab(i+1)
4928 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4929 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4930 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4931 de_dt_num=(sumenep-sumene)/aincr
4932 write (2,*) " t+ sumene from enesc=",sumenep
4933 cost2tab(i+1)=costsave
4934 sint2tab(i+1)=sintsave
4935 C End of diagnostics section.
4938 C Compute the gradient of esc
4940 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4941 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4942 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4943 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4944 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4945 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4946 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4947 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4948 pom1=(sumene3*sint2tab(i+1)+sumene1)
4949 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4950 pom2=(sumene4*cost2tab(i+1)+sumene2)
4951 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4952 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4953 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4954 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4956 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4957 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4958 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4960 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4961 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4962 & +(pom1+pom2)*pom_dx
4964 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4967 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4968 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4969 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4971 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4972 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4973 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4974 & +x(59)*zz**2 +x(60)*xx*zz
4975 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4976 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4977 & +(pom1-pom2)*pom_dy
4979 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4982 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4983 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4984 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4985 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4986 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4987 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4988 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4989 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4991 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4994 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4995 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4996 & +pom1*pom_dt1+pom2*pom_dt2
4998 write(2,*), "de_dt = ", de_dt,de_dt_num
5002 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5003 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5004 cosfac2xx=cosfac2*xx
5005 sinfac2yy=sinfac2*yy
5007 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5009 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5011 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5012 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5013 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5014 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5015 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5016 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5017 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5018 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5019 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5020 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5024 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5025 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5026 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5027 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5030 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5031 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5032 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5034 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5035 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5039 dXX_Ctab(k,i)=dXX_Ci(k)
5040 dXX_C1tab(k,i)=dXX_Ci1(k)
5041 dYY_Ctab(k,i)=dYY_Ci(k)
5042 dYY_C1tab(k,i)=dYY_Ci1(k)
5043 dZZ_Ctab(k,i)=dZZ_Ci(k)
5044 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5045 dXX_XYZtab(k,i)=dXX_XYZ(k)
5046 dYY_XYZtab(k,i)=dYY_XYZ(k)
5047 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5051 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5052 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5053 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5054 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5055 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5057 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5058 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5059 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5060 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5061 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5062 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5063 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5064 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5066 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5067 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5069 C to check gradient call subroutine check_grad
5076 c------------------------------------------------------------------------------
5077 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5079 C This procedure calculates two-body contact function g(rij) and its derivative:
5082 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5085 C where x=(rij-r0ij)/delta
5087 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5090 double precision rij,r0ij,eps0ij,fcont,fprimcont
5091 double precision x,x2,x4,delta
5095 if (x.lt.-1.0D0) then
5098 else if (x.le.1.0D0) then
5101 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5102 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5109 c------------------------------------------------------------------------------
5110 subroutine splinthet(theti,delta,ss,ssder)
5111 implicit real*8 (a-h,o-z)
5112 include 'DIMENSIONS'
5113 include 'DIMENSIONS.ZSCOPT'
5114 include 'COMMON.VAR'
5115 include 'COMMON.GEO'
5118 if (theti.gt.pipol) then
5119 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5121 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5126 c------------------------------------------------------------------------------
5127 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5129 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5130 double precision ksi,ksi2,ksi3,a1,a2,a3
5131 a1=fprim0*delta/(f1-f0)
5137 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5138 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5141 c------------------------------------------------------------------------------
5142 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5144 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5145 double precision ksi,ksi2,ksi3,a1,a2,a3
5150 a2=3*(f1x-f0x)-2*fprim0x*delta
5151 a3=fprim0x*delta-2*(f1x-f0x)
5152 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5155 C-----------------------------------------------------------------------------
5157 C-----------------------------------------------------------------------------
5158 subroutine etor(etors,edihcnstr,fact)
5159 implicit real*8 (a-h,o-z)
5160 include 'DIMENSIONS'
5161 include 'DIMENSIONS.ZSCOPT'
5162 include 'COMMON.VAR'
5163 include 'COMMON.GEO'
5164 include 'COMMON.LOCAL'
5165 include 'COMMON.TORSION'
5166 include 'COMMON.INTERACT'
5167 include 'COMMON.DERIV'
5168 include 'COMMON.CHAIN'
5169 include 'COMMON.NAMES'
5170 include 'COMMON.IOUNITS'
5171 include 'COMMON.FFIELD'
5172 include 'COMMON.TORCNSTR'
5174 C Set lprn=.true. for debugging
5178 do i=iphi_start,iphi_end
5179 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5180 & .or. itype(i).eq.ntyp1) cycle
5181 itori=itortyp(itype(i-2))
5182 itori1=itortyp(itype(i-1))
5185 C Proline-Proline pair is a special case...
5186 if (itori.eq.3 .and. itori1.eq.3) then
5187 if (phii.gt.-dwapi3) then
5189 fac=1.0D0/(1.0D0-cosphi)
5190 etorsi=v1(1,3,3)*fac
5191 etorsi=etorsi+etorsi
5192 etors=etors+etorsi-v1(1,3,3)
5193 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5196 v1ij=v1(j+1,itori,itori1)
5197 v2ij=v2(j+1,itori,itori1)
5200 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5201 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5205 v1ij=v1(j,itori,itori1)
5206 v2ij=v2(j,itori,itori1)
5209 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5210 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5214 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5215 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5216 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5217 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5218 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5220 ! 6/20/98 - dihedral angle constraints
5223 itori=idih_constr(i)
5226 if (difi.gt.drange(i)) then
5228 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5229 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5230 else if (difi.lt.-drange(i)) then
5232 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5233 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5235 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5236 C & i,itori,rad2deg*phii,
5237 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5239 ! write (iout,*) 'edihcnstr',edihcnstr
5242 c------------------------------------------------------------------------------
5244 subroutine etor(etors,edihcnstr,fact)
5245 implicit real*8 (a-h,o-z)
5246 include 'DIMENSIONS'
5247 include 'DIMENSIONS.ZSCOPT'
5248 include 'COMMON.VAR'
5249 include 'COMMON.GEO'
5250 include 'COMMON.LOCAL'
5251 include 'COMMON.TORSION'
5252 include 'COMMON.INTERACT'
5253 include 'COMMON.DERIV'
5254 include 'COMMON.CHAIN'
5255 include 'COMMON.NAMES'
5256 include 'COMMON.IOUNITS'
5257 include 'COMMON.FFIELD'
5258 include 'COMMON.TORCNSTR'
5260 C Set lprn=.true. for debugging
5264 do i=iphi_start,iphi_end
5266 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5267 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5268 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5269 C & .or. itype(i).eq.ntyp1) cycle
5270 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5271 if (iabs(itype(i)).eq.20) then
5276 itori=itortyp(itype(i-2))
5277 itori1=itortyp(itype(i-1))
5280 C Regular cosine and sine terms
5281 do j=1,nterm(itori,itori1,iblock)
5282 v1ij=v1(j,itori,itori1,iblock)
5283 v2ij=v2(j,itori,itori1,iblock)
5286 etors=etors+v1ij*cosphi+v2ij*sinphi
5287 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5291 C E = SUM ----------------------------------- - v1
5292 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5294 cosphi=dcos(0.5d0*phii)
5295 sinphi=dsin(0.5d0*phii)
5296 do j=1,nlor(itori,itori1,iblock)
5297 vl1ij=vlor1(j,itori,itori1)
5298 vl2ij=vlor2(j,itori,itori1)
5299 vl3ij=vlor3(j,itori,itori1)
5300 pom=vl2ij*cosphi+vl3ij*sinphi
5301 pom1=1.0d0/(pom*pom+1.0d0)
5302 etors=etors+vl1ij*pom1
5303 c if (energy_dec) etors_ii=etors_ii+
5306 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5308 C Subtract the constant term
5309 etors=etors-v0(itori,itori1,iblock)
5311 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5312 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5313 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5314 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5315 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5318 ! 6/20/98 - dihedral angle constraints
5321 itori=idih_constr(i)
5323 difi=pinorm(phii-phi0(i))
5325 if (difi.gt.drange(i)) then
5327 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5328 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5329 edihi=0.25d0*ftors(i)*difi**4
5330 else if (difi.lt.-drange(i)) then
5332 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5333 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5334 edihi=0.25d0*ftors(i)*difi**4
5338 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5339 & i,itori,rad2deg*phii,
5340 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5341 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5343 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5344 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5346 ! write (iout,*) 'edihcnstr',edihcnstr
5349 c----------------------------------------------------------------------------
5350 subroutine etor_d(etors_d,fact2)
5351 C 6/23/01 Compute double torsional energy
5352 implicit real*8 (a-h,o-z)
5353 include 'DIMENSIONS'
5354 include 'DIMENSIONS.ZSCOPT'
5355 include 'COMMON.VAR'
5356 include 'COMMON.GEO'
5357 include 'COMMON.LOCAL'
5358 include 'COMMON.TORSION'
5359 include 'COMMON.INTERACT'
5360 include 'COMMON.DERIV'
5361 include 'COMMON.CHAIN'
5362 include 'COMMON.NAMES'
5363 include 'COMMON.IOUNITS'
5364 include 'COMMON.FFIELD'
5365 include 'COMMON.TORCNSTR'
5367 C Set lprn=.true. for debugging
5371 do i=iphi_start,iphi_end-1
5373 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5374 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5375 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5376 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5377 & (itype(i+1).eq.ntyp1)) cycle
5378 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5380 itori=itortyp(itype(i-2))
5381 itori1=itortyp(itype(i-1))
5382 itori2=itortyp(itype(i))
5388 if (iabs(itype(i+1)).eq.20) iblock=2
5389 C Regular cosine and sine terms
5390 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5391 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5392 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5393 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5394 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5395 cosphi1=dcos(j*phii)
5396 sinphi1=dsin(j*phii)
5397 cosphi2=dcos(j*phii1)
5398 sinphi2=dsin(j*phii1)
5399 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5400 & v2cij*cosphi2+v2sij*sinphi2
5401 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5402 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5404 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5406 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5407 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5408 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5409 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5410 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5411 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5412 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5413 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5414 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5415 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5416 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5417 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5418 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5419 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5422 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5423 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5429 c------------------------------------------------------------------------------
5430 subroutine eback_sc_corr(esccor)
5431 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5432 c conformational states; temporarily implemented as differences
5433 c between UNRES torsional potentials (dependent on three types of
5434 c residues) and the torsional potentials dependent on all 20 types
5435 c of residues computed from AM1 energy surfaces of terminally-blocked
5436 c amino-acid residues.
5437 implicit real*8 (a-h,o-z)
5438 include 'DIMENSIONS'
5439 include 'DIMENSIONS.ZSCOPT'
5440 include 'COMMON.VAR'
5441 include 'COMMON.GEO'
5442 include 'COMMON.LOCAL'
5443 include 'COMMON.TORSION'
5444 include 'COMMON.SCCOR'
5445 include 'COMMON.INTERACT'
5446 include 'COMMON.DERIV'
5447 include 'COMMON.CHAIN'
5448 include 'COMMON.NAMES'
5449 include 'COMMON.IOUNITS'
5450 include 'COMMON.FFIELD'
5451 include 'COMMON.CONTROL'
5453 C Set lprn=.true. for debugging
5456 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5458 do i=itau_start,itau_end
5459 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5461 isccori=isccortyp(itype(i-2))
5462 isccori1=isccortyp(itype(i-1))
5464 do intertyp=1,3 !intertyp
5465 cc Added 09 May 2012 (Adasko)
5466 cc Intertyp means interaction type of backbone mainchain correlation:
5467 c 1 = SC...Ca...Ca...Ca
5468 c 2 = Ca...Ca...Ca...SC
5469 c 3 = SC...Ca...Ca...SCi
5471 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5472 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5473 & (itype(i-1).eq.ntyp1)))
5474 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5475 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5476 & .or.(itype(i).eq.ntyp1)))
5477 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5478 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5479 & (itype(i-3).eq.ntyp1)))) cycle
5480 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5481 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5483 do j=1,nterm_sccor(isccori,isccori1)
5484 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5485 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5486 cosphi=dcos(j*tauangle(intertyp,i))
5487 sinphi=dsin(j*tauangle(intertyp,i))
5488 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5489 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5491 C write (iout,*)"EBACK_SC_COR",esccor,i
5492 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5493 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5494 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5496 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5497 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5498 & (v1sccor(j,1,itori,itori1),j=1,6)
5499 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5500 c gsccor_loc(i-3)=gloci
5505 c------------------------------------------------------------------------------
5506 subroutine multibody(ecorr)
5507 C This subroutine calculates multi-body contributions to energy following
5508 C the idea of Skolnick et al. If side chains I and J make a contact and
5509 C at the same time side chains I+1 and J+1 make a contact, an extra
5510 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5511 implicit real*8 (a-h,o-z)
5512 include 'DIMENSIONS'
5513 include 'COMMON.IOUNITS'
5514 include 'COMMON.DERIV'
5515 include 'COMMON.INTERACT'
5516 include 'COMMON.CONTACTS'
5517 double precision gx(3),gx1(3)
5520 C Set lprn=.true. for debugging
5524 write (iout,'(a)') 'Contact function values:'
5526 write (iout,'(i2,20(1x,i2,f10.5))')
5527 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5542 num_conti=num_cont(i)
5543 num_conti1=num_cont(i1)
5548 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5549 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5550 cd & ' ishift=',ishift
5551 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5552 C The system gains extra energy.
5553 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5554 endif ! j1==j+-ishift
5563 c------------------------------------------------------------------------------
5564 double precision function esccorr(i,j,k,l,jj,kk)
5565 implicit real*8 (a-h,o-z)
5566 include 'DIMENSIONS'
5567 include 'COMMON.IOUNITS'
5568 include 'COMMON.DERIV'
5569 include 'COMMON.INTERACT'
5570 include 'COMMON.CONTACTS'
5571 double precision gx(3),gx1(3)
5576 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5577 C Calculate the multi-body contribution to energy.
5578 C Calculate multi-body contributions to the gradient.
5579 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5580 cd & k,l,(gacont(m,kk,k),m=1,3)
5582 gx(m) =ekl*gacont(m,jj,i)
5583 gx1(m)=eij*gacont(m,kk,k)
5584 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5585 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5586 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5587 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5591 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5596 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5602 c------------------------------------------------------------------------------
5604 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5605 implicit real*8 (a-h,o-z)
5606 include 'DIMENSIONS'
5607 integer dimen1,dimen2,atom,indx
5608 double precision buffer(dimen1,dimen2)
5609 double precision zapas
5610 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5611 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5612 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5613 num_kont=num_cont_hb(atom)
5617 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5620 buffer(i,indx+22)=facont_hb(i,atom)
5621 buffer(i,indx+23)=ees0p(i,atom)
5622 buffer(i,indx+24)=ees0m(i,atom)
5623 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5625 buffer(1,indx+26)=dfloat(num_kont)
5628 c------------------------------------------------------------------------------
5629 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5630 implicit real*8 (a-h,o-z)
5631 include 'DIMENSIONS'
5632 integer dimen1,dimen2,atom,indx
5633 double precision buffer(dimen1,dimen2)
5634 double precision zapas
5635 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5636 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5637 & ees0m(ntyp,maxres),
5638 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5639 num_kont=buffer(1,indx+26)
5640 num_kont_old=num_cont_hb(atom)
5641 num_cont_hb(atom)=num_kont+num_kont_old
5646 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5649 facont_hb(ii,atom)=buffer(i,indx+22)
5650 ees0p(ii,atom)=buffer(i,indx+23)
5651 ees0m(ii,atom)=buffer(i,indx+24)
5652 jcont_hb(ii,atom)=buffer(i,indx+25)
5656 c------------------------------------------------------------------------------
5658 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5659 C This subroutine calculates multi-body contributions to hydrogen-bonding
5660 implicit real*8 (a-h,o-z)
5661 include 'DIMENSIONS'
5662 include 'DIMENSIONS.ZSCOPT'
5663 include 'COMMON.IOUNITS'
5665 include 'COMMON.INFO'
5667 include 'COMMON.FFIELD'
5668 include 'COMMON.DERIV'
5669 include 'COMMON.INTERACT'
5670 include 'COMMON.CONTACTS'
5672 parameter (max_cont=maxconts)
5673 parameter (max_dim=2*(8*3+2))
5674 parameter (msglen1=max_cont*max_dim*4)
5675 parameter (msglen2=2*msglen1)
5676 integer source,CorrelType,CorrelID,Error
5677 double precision buffer(max_cont,max_dim)
5679 double precision gx(3),gx1(3)
5682 C Set lprn=.true. for debugging
5687 if (fgProcs.le.1) goto 30
5689 write (iout,'(a)') 'Contact function values:'
5691 write (iout,'(2i3,50(1x,i2,f5.2))')
5692 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5693 & j=1,num_cont_hb(i))
5696 C Caution! Following code assumes that electrostatic interactions concerning
5697 C a given atom are split among at most two processors!
5707 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5710 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5711 if (MyRank.gt.0) then
5712 C Send correlation contributions to the preceding processor
5714 nn=num_cont_hb(iatel_s)
5715 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5716 cd write (iout,*) 'The BUFFER array:'
5718 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5720 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5722 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5723 C Clear the contacts of the atom passed to the neighboring processor
5724 nn=num_cont_hb(iatel_s+1)
5726 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5728 num_cont_hb(iatel_s)=0
5730 cd write (iout,*) 'Processor ',MyID,MyRank,
5731 cd & ' is sending correlation contribution to processor',MyID-1,
5732 cd & ' msglen=',msglen
5733 cd write (*,*) 'Processor ',MyID,MyRank,
5734 cd & ' is sending correlation contribution to processor',MyID-1,
5735 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5736 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5737 cd write (iout,*) 'Processor ',MyID,
5738 cd & ' has sent correlation contribution to processor',MyID-1,
5739 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5740 cd write (*,*) 'Processor ',MyID,
5741 cd & ' has sent correlation contribution to processor',MyID-1,
5742 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5744 endif ! (MyRank.gt.0)
5748 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5749 if (MyRank.lt.fgProcs-1) then
5750 C Receive correlation contributions from the next processor
5752 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5753 cd write (iout,*) 'Processor',MyID,
5754 cd & ' is receiving correlation contribution from processor',MyID+1,
5755 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5756 cd write (*,*) 'Processor',MyID,
5757 cd & ' is receiving correlation contribution from processor',MyID+1,
5758 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5760 do while (nbytes.le.0)
5761 call mp_probe(MyID+1,CorrelType,nbytes)
5763 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5764 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5765 cd write (iout,*) 'Processor',MyID,
5766 cd & ' has received correlation contribution from processor',MyID+1,
5767 cd & ' msglen=',msglen,' nbytes=',nbytes
5768 cd write (iout,*) 'The received BUFFER array:'
5770 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5772 if (msglen.eq.msglen1) then
5773 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5774 else if (msglen.eq.msglen2) then
5775 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5776 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5779 & 'ERROR!!!! message length changed while processing correlations.'
5781 & 'ERROR!!!! message length changed while processing correlations.'
5782 call mp_stopall(Error)
5783 endif ! msglen.eq.msglen1
5784 endif ! MyRank.lt.fgProcs-1
5791 write (iout,'(a)') 'Contact function values:'
5793 write (iout,'(2i3,50(1x,i2,f5.2))')
5794 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5795 & j=1,num_cont_hb(i))
5799 C Remove the loop below after debugging !!!
5806 C Calculate the local-electrostatic correlation terms
5807 do i=iatel_s,iatel_e+1
5809 num_conti=num_cont_hb(i)
5810 num_conti1=num_cont_hb(i+1)
5815 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5816 c & ' jj=',jj,' kk=',kk
5817 if (j1.eq.j+1 .or. j1.eq.j-1) then
5818 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5819 C The system gains extra energy.
5820 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5822 else if (j1.eq.j) then
5823 C Contacts I-J and I-(J+1) occur simultaneously.
5824 C The system loses extra energy.
5825 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5830 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5831 c & ' jj=',jj,' kk=',kk
5833 C Contacts I-J and (I+1)-J occur simultaneously.
5834 C The system loses extra energy.
5835 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5842 c------------------------------------------------------------------------------
5843 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5845 C This subroutine calculates multi-body contributions to hydrogen-bonding
5846 implicit real*8 (a-h,o-z)
5847 include 'DIMENSIONS'
5848 include 'DIMENSIONS.ZSCOPT'
5849 include 'COMMON.IOUNITS'
5851 include 'COMMON.INFO'
5853 include 'COMMON.FFIELD'
5854 include 'COMMON.DERIV'
5855 include 'COMMON.INTERACT'
5856 include 'COMMON.CONTACTS'
5858 parameter (max_cont=maxconts)
5859 parameter (max_dim=2*(8*3+2))
5860 parameter (msglen1=max_cont*max_dim*4)
5861 parameter (msglen2=2*msglen1)
5862 integer source,CorrelType,CorrelID,Error
5863 double precision buffer(max_cont,max_dim)
5865 double precision gx(3),gx1(3)
5868 C Set lprn=.true. for debugging
5875 if (fgProcs.le.1) goto 30
5877 write (iout,'(a)') 'Contact function values:'
5879 write (iout,'(2i3,50(1x,i2,f5.2))')
5880 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5881 & j=1,num_cont_hb(i))
5884 C Caution! Following code assumes that electrostatic interactions concerning
5885 C a given atom are split among at most two processors!
5895 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5898 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5899 if (MyRank.gt.0) then
5900 C Send correlation contributions to the preceding processor
5902 nn=num_cont_hb(iatel_s)
5903 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5904 cd write (iout,*) 'The BUFFER array:'
5906 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5908 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5910 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5911 C Clear the contacts of the atom passed to the neighboring processor
5912 nn=num_cont_hb(iatel_s+1)
5914 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5916 num_cont_hb(iatel_s)=0
5918 cd write (iout,*) 'Processor ',MyID,MyRank,
5919 cd & ' is sending correlation contribution to processor',MyID-1,
5920 cd & ' msglen=',msglen
5921 cd write (*,*) 'Processor ',MyID,MyRank,
5922 cd & ' is sending correlation contribution to processor',MyID-1,
5923 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5924 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5925 cd write (iout,*) 'Processor ',MyID,
5926 cd & ' has sent correlation contribution to processor',MyID-1,
5927 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5928 cd write (*,*) 'Processor ',MyID,
5929 cd & ' has sent correlation contribution to processor',MyID-1,
5930 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5932 endif ! (MyRank.gt.0)
5936 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5937 if (MyRank.lt.fgProcs-1) then
5938 C Receive correlation contributions from the next processor
5940 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5941 cd write (iout,*) 'Processor',MyID,
5942 cd & ' is receiving correlation contribution from processor',MyID+1,
5943 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5944 cd write (*,*) 'Processor',MyID,
5945 cd & ' is receiving correlation contribution from processor',MyID+1,
5946 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5948 do while (nbytes.le.0)
5949 call mp_probe(MyID+1,CorrelType,nbytes)
5951 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5952 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5953 cd write (iout,*) 'Processor',MyID,
5954 cd & ' has received correlation contribution from processor',MyID+1,
5955 cd & ' msglen=',msglen,' nbytes=',nbytes
5956 cd write (iout,*) 'The received BUFFER array:'
5958 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5960 if (msglen.eq.msglen1) then
5961 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5962 else if (msglen.eq.msglen2) then
5963 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5964 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5967 & 'ERROR!!!! message length changed while processing correlations.'
5969 & 'ERROR!!!! message length changed while processing correlations.'
5970 call mp_stopall(Error)
5971 endif ! msglen.eq.msglen1
5972 endif ! MyRank.lt.fgProcs-1
5979 write (iout,'(a)') 'Contact function values:'
5981 write (iout,'(2i3,50(1x,i2,f5.2))')
5982 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5983 & j=1,num_cont_hb(i))
5989 C Remove the loop below after debugging !!!
5996 C Calculate the dipole-dipole interaction energies
5997 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5998 do i=iatel_s,iatel_e+1
5999 num_conti=num_cont_hb(i)
6006 C Calculate the local-electrostatic correlation terms
6007 do i=iatel_s,iatel_e+1
6009 num_conti=num_cont_hb(i)
6010 num_conti1=num_cont_hb(i+1)
6015 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6016 c & ' jj=',jj,' kk=',kk
6017 if (j1.eq.j+1 .or. j1.eq.j-1) then
6018 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6019 C The system gains extra energy.
6021 sqd1=dsqrt(d_cont(jj,i))
6022 sqd2=dsqrt(d_cont(kk,i1))
6023 sred_geom = sqd1*sqd2
6024 IF (sred_geom.lt.cutoff_corr) THEN
6025 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6027 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6028 c & ' jj=',jj,' kk=',kk
6029 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6030 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6032 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6033 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6036 cd write (iout,*) 'sred_geom=',sred_geom,
6037 cd & ' ekont=',ekont,' fprim=',fprimcont
6038 call calc_eello(i,j,i+1,j1,jj,kk)
6039 if (wcorr4.gt.0.0d0)
6040 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6041 if (wcorr5.gt.0.0d0)
6042 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6043 c print *,"wcorr5",ecorr5
6044 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6045 cd write(2,*)'ijkl',i,j,i+1,j1
6046 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6047 & .or. wturn6.eq.0.0d0))then
6048 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6049 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6050 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6051 cd & 'ecorr6=',ecorr6
6052 cd write (iout,'(4e15.5)') sred_geom,
6053 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6054 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6055 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6056 else if (wturn6.gt.0.0d0
6057 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6058 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6059 eturn6=eturn6+eello_turn6(i,jj,kk)
6060 cd write (2,*) 'multibody_eello:eturn6',eturn6
6061 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6068 else if (j1.eq.j) then
6069 C Contacts I-J and I-(J+1) occur simultaneously.
6070 C The system loses extra energy.
6071 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6076 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6077 c & ' jj=',jj,' kk=',kk
6079 C Contacts I-J and (I+1)-J occur simultaneously.
6080 C The system loses extra energy.
6081 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6086 write (iout,*) "eturn6",eturn6,ecorr6
6089 c------------------------------------------------------------------------------
6090 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6091 implicit real*8 (a-h,o-z)
6092 include 'DIMENSIONS'
6093 include 'COMMON.IOUNITS'
6094 include 'COMMON.DERIV'
6095 include 'COMMON.INTERACT'
6096 include 'COMMON.CONTACTS'
6097 include 'COMMON.CONTROL'
6098 include 'COMMON.SHIELD'
6099 double precision gx(3),gx1(3)
6109 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6110 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6111 C Following 4 lines for diagnostics.
6116 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6118 c write (iout,*)'Contacts have occurred for peptide groups',
6119 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6120 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6121 C Calculate the multi-body contribution to energy.
6122 C ecorr=ecorr+ekont*ees
6124 C Calculate multi-body contributions to the gradient.
6126 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6127 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6128 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6129 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6130 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6131 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6132 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6133 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6134 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6135 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6136 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6137 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6138 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6139 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6143 gradcorr(ll,m)=gradcorr(ll,m)+
6144 & ees*ekl*gacont_hbr(ll,jj,i)-
6145 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6146 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6151 gradcorr(ll,m)=gradcorr(ll,m)+
6152 & ees*eij*gacont_hbr(ll,kk,k)-
6153 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6154 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6157 if (shield_mode.gt.0) then
6160 C print *,i,j,fac_shield(i),fac_shield(j),
6161 C &fac_shield(k),fac_shield(l)
6162 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6163 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6164 do ilist=1,ishield_list(i)
6165 iresshield=shield_list(ilist,i)
6167 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6169 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6171 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6172 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6176 do ilist=1,ishield_list(j)
6177 iresshield=shield_list(ilist,j)
6179 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6181 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6183 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6184 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6188 do ilist=1,ishield_list(k)
6189 iresshield=shield_list(ilist,k)
6191 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6193 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6195 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6196 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6200 do ilist=1,ishield_list(l)
6201 iresshield=shield_list(ilist,l)
6203 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6205 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6207 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6208 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6212 C print *,gshieldx(m,iresshield)
6214 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6215 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6216 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6217 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6218 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6219 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6220 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6221 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6223 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6224 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6225 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6226 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6227 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6228 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6229 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6230 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6239 C---------------------------------------------------------------------------
6240 subroutine dipole(i,j,jj)
6241 implicit real*8 (a-h,o-z)
6242 include 'DIMENSIONS'
6243 include 'DIMENSIONS.ZSCOPT'
6244 include 'COMMON.IOUNITS'
6245 include 'COMMON.CHAIN'
6246 include 'COMMON.FFIELD'
6247 include 'COMMON.DERIV'
6248 include 'COMMON.INTERACT'
6249 include 'COMMON.CONTACTS'
6250 include 'COMMON.TORSION'
6251 include 'COMMON.VAR'
6252 include 'COMMON.GEO'
6253 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6255 iti1 = itortyp(itype(i+1))
6256 if (j.lt.nres-1) then
6257 if (itype(j).le.ntyp) then
6258 itj1 = itortyp(itype(j+1))
6266 dipi(iii,1)=Ub2(iii,i)
6267 dipderi(iii)=Ub2der(iii,i)
6268 dipi(iii,2)=b1(iii,iti1)
6269 dipj(iii,1)=Ub2(iii,j)
6270 dipderj(iii)=Ub2der(iii,j)
6271 dipj(iii,2)=b1(iii,itj1)
6275 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6278 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6281 if (.not.calc_grad) return
6286 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6290 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6295 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6296 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6298 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6300 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6302 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6306 C---------------------------------------------------------------------------
6307 subroutine calc_eello(i,j,k,l,jj,kk)
6309 C This subroutine computes matrices and vectors needed to calculate
6310 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6312 implicit real*8 (a-h,o-z)
6313 include 'DIMENSIONS'
6314 include 'DIMENSIONS.ZSCOPT'
6315 include 'COMMON.IOUNITS'
6316 include 'COMMON.CHAIN'
6317 include 'COMMON.DERIV'
6318 include 'COMMON.INTERACT'
6319 include 'COMMON.CONTACTS'
6320 include 'COMMON.TORSION'
6321 include 'COMMON.VAR'
6322 include 'COMMON.GEO'
6323 include 'COMMON.FFIELD'
6324 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6325 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6328 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6329 cd & ' jj=',jj,' kk=',kk
6330 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6333 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6334 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6337 call transpose2(aa1(1,1),aa1t(1,1))
6338 call transpose2(aa2(1,1),aa2t(1,1))
6341 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6342 & aa1tder(1,1,lll,kkk))
6343 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6344 & aa2tder(1,1,lll,kkk))
6348 C parallel orientation of the two CA-CA-CA frames.
6349 if (i.gt.1 .and. itype(i).le.ntyp) then
6350 iti=itortyp(itype(i))
6354 itk1=itortyp(itype(k+1))
6355 itj=itortyp(itype(j))
6356 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6357 itl1=itortyp(itype(l+1))
6361 C A1 kernel(j+1) A2T
6363 cd write (iout,'(3f10.5,5x,3f10.5)')
6364 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6366 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6367 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6368 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6369 C Following matrices are needed only for 6-th order cumulants
6370 IF (wcorr6.gt.0.0d0) THEN
6371 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6372 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6373 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6374 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6375 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6376 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6377 & ADtEAderx(1,1,1,1,1,1))
6379 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6380 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6381 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6382 & ADtEA1derx(1,1,1,1,1,1))
6384 C End 6-th order cumulants
6387 cd write (2,*) 'In calc_eello6'
6389 cd write (2,*) 'iii=',iii
6391 cd write (2,*) 'kkk=',kkk
6393 cd write (2,'(3(2f10.5),5x)')
6394 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6399 call transpose2(EUgder(1,1,k),auxmat(1,1))
6400 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6401 call transpose2(EUg(1,1,k),auxmat(1,1))
6402 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6403 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6407 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6408 & EAEAderx(1,1,lll,kkk,iii,1))
6412 C A1T kernel(i+1) A2
6413 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6414 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6415 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6416 C Following matrices are needed only for 6-th order cumulants
6417 IF (wcorr6.gt.0.0d0) THEN
6418 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6419 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6420 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6421 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6422 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6423 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6424 & ADtEAderx(1,1,1,1,1,2))
6425 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6426 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6427 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6428 & ADtEA1derx(1,1,1,1,1,2))
6430 C End 6-th order cumulants
6431 call transpose2(EUgder(1,1,l),auxmat(1,1))
6432 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6433 call transpose2(EUg(1,1,l),auxmat(1,1))
6434 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6435 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6439 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6440 & EAEAderx(1,1,lll,kkk,iii,2))
6445 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6446 C They are needed only when the fifth- or the sixth-order cumulants are
6448 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6449 call transpose2(AEA(1,1,1),auxmat(1,1))
6450 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6451 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6452 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6453 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6454 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6455 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6456 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6457 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6458 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6459 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6460 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6461 call transpose2(AEA(1,1,2),auxmat(1,1))
6462 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6463 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6464 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6465 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6466 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6467 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6468 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6469 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6470 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6471 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6472 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6473 C Calculate the Cartesian derivatives of the vectors.
6477 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6478 call matvec2(auxmat(1,1),b1(1,iti),
6479 & AEAb1derx(1,lll,kkk,iii,1,1))
6480 call matvec2(auxmat(1,1),Ub2(1,i),
6481 & AEAb2derx(1,lll,kkk,iii,1,1))
6482 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6483 & AEAb1derx(1,lll,kkk,iii,2,1))
6484 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6485 & AEAb2derx(1,lll,kkk,iii,2,1))
6486 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6487 call matvec2(auxmat(1,1),b1(1,itj),
6488 & AEAb1derx(1,lll,kkk,iii,1,2))
6489 call matvec2(auxmat(1,1),Ub2(1,j),
6490 & AEAb2derx(1,lll,kkk,iii,1,2))
6491 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6492 & AEAb1derx(1,lll,kkk,iii,2,2))
6493 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6494 & AEAb2derx(1,lll,kkk,iii,2,2))
6501 C Antiparallel orientation of the two CA-CA-CA frames.
6502 if (i.gt.1 .and. itype(i).le.ntyp) then
6503 iti=itortyp(itype(i))
6507 itk1=itortyp(itype(k+1))
6508 itl=itortyp(itype(l))
6509 itj=itortyp(itype(j))
6510 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6511 itj1=itortyp(itype(j+1))
6515 C A2 kernel(j-1)T A1T
6516 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6517 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6518 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6519 C Following matrices are needed only for 6-th order cumulants
6520 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6521 & j.eq.i+4 .and. l.eq.i+3)) THEN
6522 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6523 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6524 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6525 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6526 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6527 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6528 & ADtEAderx(1,1,1,1,1,1))
6529 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6530 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6531 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6532 & ADtEA1derx(1,1,1,1,1,1))
6534 C End 6-th order cumulants
6535 call transpose2(EUgder(1,1,k),auxmat(1,1))
6536 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6537 call transpose2(EUg(1,1,k),auxmat(1,1))
6538 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6539 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6543 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6544 & EAEAderx(1,1,lll,kkk,iii,1))
6548 C A2T kernel(i+1)T A1
6549 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6550 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6551 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6552 C Following matrices are needed only for 6-th order cumulants
6553 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6554 & j.eq.i+4 .and. l.eq.i+3)) THEN
6555 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6556 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6557 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6558 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6559 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6560 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6561 & ADtEAderx(1,1,1,1,1,2))
6562 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6563 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6564 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6565 & ADtEA1derx(1,1,1,1,1,2))
6567 C End 6-th order cumulants
6568 call transpose2(EUgder(1,1,j),auxmat(1,1))
6569 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6570 call transpose2(EUg(1,1,j),auxmat(1,1))
6571 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6572 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6576 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6577 & EAEAderx(1,1,lll,kkk,iii,2))
6582 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6583 C They are needed only when the fifth- or the sixth-order cumulants are
6585 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6586 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6587 call transpose2(AEA(1,1,1),auxmat(1,1))
6588 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6589 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6590 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6591 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6592 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6593 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6594 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6595 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6596 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6597 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6598 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6599 call transpose2(AEA(1,1,2),auxmat(1,1))
6600 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6601 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6602 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6603 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6604 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6605 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6606 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6607 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6608 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6609 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6610 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6611 C Calculate the Cartesian derivatives of the vectors.
6615 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6616 call matvec2(auxmat(1,1),b1(1,iti),
6617 & AEAb1derx(1,lll,kkk,iii,1,1))
6618 call matvec2(auxmat(1,1),Ub2(1,i),
6619 & AEAb2derx(1,lll,kkk,iii,1,1))
6620 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6621 & AEAb1derx(1,lll,kkk,iii,2,1))
6622 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6623 & AEAb2derx(1,lll,kkk,iii,2,1))
6624 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6625 call matvec2(auxmat(1,1),b1(1,itl),
6626 & AEAb1derx(1,lll,kkk,iii,1,2))
6627 call matvec2(auxmat(1,1),Ub2(1,l),
6628 & AEAb2derx(1,lll,kkk,iii,1,2))
6629 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6630 & AEAb1derx(1,lll,kkk,iii,2,2))
6631 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6632 & AEAb2derx(1,lll,kkk,iii,2,2))
6641 C---------------------------------------------------------------------------
6642 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6643 & KK,KKderg,AKA,AKAderg,AKAderx)
6647 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6648 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6649 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6654 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6656 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6659 cd if (lprn) write (2,*) 'In kernel'
6661 cd if (lprn) write (2,*) 'kkk=',kkk
6663 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6664 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6666 cd write (2,*) 'lll=',lll
6667 cd write (2,*) 'iii=1'
6669 cd write (2,'(3(2f10.5),5x)')
6670 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6673 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6674 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6676 cd write (2,*) 'lll=',lll
6677 cd write (2,*) 'iii=2'
6679 cd write (2,'(3(2f10.5),5x)')
6680 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6687 C---------------------------------------------------------------------------
6688 double precision function eello4(i,j,k,l,jj,kk)
6689 implicit real*8 (a-h,o-z)
6690 include 'DIMENSIONS'
6691 include 'DIMENSIONS.ZSCOPT'
6692 include 'COMMON.IOUNITS'
6693 include 'COMMON.CHAIN'
6694 include 'COMMON.DERIV'
6695 include 'COMMON.INTERACT'
6696 include 'COMMON.CONTACTS'
6697 include 'COMMON.TORSION'
6698 include 'COMMON.VAR'
6699 include 'COMMON.GEO'
6700 double precision pizda(2,2),ggg1(3),ggg2(3)
6701 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6705 cd print *,'eello4:',i,j,k,l,jj,kk
6706 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6707 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6708 cold eij=facont_hb(jj,i)
6709 cold ekl=facont_hb(kk,k)
6711 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6713 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6714 gcorr_loc(k-1)=gcorr_loc(k-1)
6715 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6717 gcorr_loc(l-1)=gcorr_loc(l-1)
6718 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6720 gcorr_loc(j-1)=gcorr_loc(j-1)
6721 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6726 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6727 & -EAEAderx(2,2,lll,kkk,iii,1)
6728 cd derx(lll,kkk,iii)=0.0d0
6732 cd gcorr_loc(l-1)=0.0d0
6733 cd gcorr_loc(j-1)=0.0d0
6734 cd gcorr_loc(k-1)=0.0d0
6736 cd write (iout,*)'Contacts have occurred for peptide groups',
6737 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6738 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6739 if (j.lt.nres-1) then
6746 if (l.lt.nres-1) then
6754 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6755 ggg1(ll)=eel4*g_contij(ll,1)
6756 ggg2(ll)=eel4*g_contij(ll,2)
6757 ghalf=0.5d0*ggg1(ll)
6759 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6760 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6761 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6762 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6763 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6764 ghalf=0.5d0*ggg2(ll)
6766 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6767 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6768 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6769 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6774 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6775 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6780 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6781 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6787 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6792 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6796 cd write (2,*) iii,gcorr_loc(iii)
6800 cd write (2,*) 'ekont',ekont
6801 cd write (iout,*) 'eello4',ekont*eel4
6804 C---------------------------------------------------------------------------
6805 double precision function eello5(i,j,k,l,jj,kk)
6806 implicit real*8 (a-h,o-z)
6807 include 'DIMENSIONS'
6808 include 'DIMENSIONS.ZSCOPT'
6809 include 'COMMON.IOUNITS'
6810 include 'COMMON.CHAIN'
6811 include 'COMMON.DERIV'
6812 include 'COMMON.INTERACT'
6813 include 'COMMON.CONTACTS'
6814 include 'COMMON.TORSION'
6815 include 'COMMON.VAR'
6816 include 'COMMON.GEO'
6817 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6818 double precision ggg1(3),ggg2(3)
6819 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6824 C /l\ / \ \ / \ / \ / C
6825 C / \ / \ \ / \ / \ / C
6826 C j| o |l1 | o | o| o | | o |o C
6827 C \ |/k\| |/ \| / |/ \| |/ \| C
6828 C \i/ \ / \ / / \ / \ C
6830 C (I) (II) (III) (IV) C
6832 C eello5_1 eello5_2 eello5_3 eello5_4 C
6834 C Antiparallel chains C
6837 C /j\ / \ \ / \ / \ / C
6838 C / \ / \ \ / \ / \ / C
6839 C j1| o |l | o | o| o | | o |o C
6840 C \ |/k\| |/ \| / |/ \| |/ \| C
6841 C \i/ \ / \ / / \ / \ C
6843 C (I) (II) (III) (IV) C
6845 C eello5_1 eello5_2 eello5_3 eello5_4 C
6847 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6849 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6850 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6855 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6857 itk=itortyp(itype(k))
6858 itl=itortyp(itype(l))
6859 itj=itortyp(itype(j))
6864 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6865 cd & eel5_3_num,eel5_4_num)
6869 derx(lll,kkk,iii)=0.0d0
6873 cd eij=facont_hb(jj,i)
6874 cd ekl=facont_hb(kk,k)
6876 cd write (iout,*)'Contacts have occurred for peptide groups',
6877 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6879 C Contribution from the graph I.
6880 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6881 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6882 call transpose2(EUg(1,1,k),auxmat(1,1))
6883 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6884 vv(1)=pizda(1,1)-pizda(2,2)
6885 vv(2)=pizda(1,2)+pizda(2,1)
6886 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6887 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6889 C Explicit gradient in virtual-dihedral angles.
6890 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6891 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6892 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6893 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6894 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6895 vv(1)=pizda(1,1)-pizda(2,2)
6896 vv(2)=pizda(1,2)+pizda(2,1)
6897 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6898 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6899 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6900 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6901 vv(1)=pizda(1,1)-pizda(2,2)
6902 vv(2)=pizda(1,2)+pizda(2,1)
6904 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6905 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6906 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6908 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6909 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6910 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6912 C Cartesian gradient
6916 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6918 vv(1)=pizda(1,1)-pizda(2,2)
6919 vv(2)=pizda(1,2)+pizda(2,1)
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6921 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6922 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6929 C Contribution from graph II
6930 call transpose2(EE(1,1,itk),auxmat(1,1))
6931 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6932 vv(1)=pizda(1,1)+pizda(2,2)
6933 vv(2)=pizda(2,1)-pizda(1,2)
6934 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6935 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6937 C Explicit gradient in virtual-dihedral angles.
6938 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6939 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6940 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6941 vv(1)=pizda(1,1)+pizda(2,2)
6942 vv(2)=pizda(2,1)-pizda(1,2)
6944 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6945 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6946 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6948 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6949 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6950 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6952 C Cartesian gradient
6956 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6958 vv(1)=pizda(1,1)+pizda(2,2)
6959 vv(2)=pizda(2,1)-pizda(1,2)
6960 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6961 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6962 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6971 C Parallel orientation
6972 C Contribution from graph III
6973 call transpose2(EUg(1,1,l),auxmat(1,1))
6974 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6975 vv(1)=pizda(1,1)-pizda(2,2)
6976 vv(2)=pizda(1,2)+pizda(2,1)
6977 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6978 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6980 C Explicit gradient in virtual-dihedral angles.
6981 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6982 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6983 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6984 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6985 vv(1)=pizda(1,1)-pizda(2,2)
6986 vv(2)=pizda(1,2)+pizda(2,1)
6987 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6988 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6989 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6990 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6991 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6992 vv(1)=pizda(1,1)-pizda(2,2)
6993 vv(2)=pizda(1,2)+pizda(2,1)
6994 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6995 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6996 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6997 C Cartesian gradient
7001 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7003 vv(1)=pizda(1,1)-pizda(2,2)
7004 vv(2)=pizda(1,2)+pizda(2,1)
7005 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7006 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7007 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7013 C Contribution from graph IV
7015 call transpose2(EE(1,1,itl),auxmat(1,1))
7016 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7017 vv(1)=pizda(1,1)+pizda(2,2)
7018 vv(2)=pizda(2,1)-pizda(1,2)
7019 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7020 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7022 C Explicit gradient in virtual-dihedral angles.
7023 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7024 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7025 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7026 vv(1)=pizda(1,1)+pizda(2,2)
7027 vv(2)=pizda(2,1)-pizda(1,2)
7028 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7029 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7030 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7031 C Cartesian gradient
7035 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7037 vv(1)=pizda(1,1)+pizda(2,2)
7038 vv(2)=pizda(2,1)-pizda(1,2)
7039 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7040 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7041 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7047 C Antiparallel orientation
7048 C Contribution from graph III
7050 call transpose2(EUg(1,1,j),auxmat(1,1))
7051 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7052 vv(1)=pizda(1,1)-pizda(2,2)
7053 vv(2)=pizda(1,2)+pizda(2,1)
7054 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7055 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7057 C Explicit gradient in virtual-dihedral angles.
7058 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7059 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7060 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7061 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7062 vv(1)=pizda(1,1)-pizda(2,2)
7063 vv(2)=pizda(1,2)+pizda(2,1)
7064 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7065 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7066 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7067 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7068 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7069 vv(1)=pizda(1,1)-pizda(2,2)
7070 vv(2)=pizda(1,2)+pizda(2,1)
7071 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7072 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7073 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7074 C Cartesian gradient
7078 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7080 vv(1)=pizda(1,1)-pizda(2,2)
7081 vv(2)=pizda(1,2)+pizda(2,1)
7082 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7083 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7084 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7090 C Contribution from graph IV
7092 call transpose2(EE(1,1,itj),auxmat(1,1))
7093 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7094 vv(1)=pizda(1,1)+pizda(2,2)
7095 vv(2)=pizda(2,1)-pizda(1,2)
7096 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7097 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7099 C Explicit gradient in virtual-dihedral angles.
7100 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7101 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7102 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7103 vv(1)=pizda(1,1)+pizda(2,2)
7104 vv(2)=pizda(2,1)-pizda(1,2)
7105 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7106 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7107 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7108 C Cartesian gradient
7112 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7114 vv(1)=pizda(1,1)+pizda(2,2)
7115 vv(2)=pizda(2,1)-pizda(1,2)
7116 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7117 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7118 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7125 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7126 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7127 cd write (2,*) 'ijkl',i,j,k,l
7128 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7129 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7131 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7132 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7133 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7134 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7136 if (j.lt.nres-1) then
7143 if (l.lt.nres-1) then
7153 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7155 ggg1(ll)=eel5*g_contij(ll,1)
7156 ggg2(ll)=eel5*g_contij(ll,2)
7157 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7158 ghalf=0.5d0*ggg1(ll)
7160 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7161 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7162 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7163 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7164 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7165 ghalf=0.5d0*ggg2(ll)
7167 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7168 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7169 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7170 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7175 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7176 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7181 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7182 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7188 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7193 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7197 cd write (2,*) iii,g_corr5_loc(iii)
7201 cd write (2,*) 'ekont',ekont
7202 cd write (iout,*) 'eello5',ekont*eel5
7205 c--------------------------------------------------------------------------
7206 double precision function eello6(i,j,k,l,jj,kk)
7207 implicit real*8 (a-h,o-z)
7208 include 'DIMENSIONS'
7209 include 'DIMENSIONS.ZSCOPT'
7210 include 'COMMON.IOUNITS'
7211 include 'COMMON.CHAIN'
7212 include 'COMMON.DERIV'
7213 include 'COMMON.INTERACT'
7214 include 'COMMON.CONTACTS'
7215 include 'COMMON.TORSION'
7216 include 'COMMON.VAR'
7217 include 'COMMON.GEO'
7218 include 'COMMON.FFIELD'
7219 double precision ggg1(3),ggg2(3)
7220 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7225 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7233 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7234 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7238 derx(lll,kkk,iii)=0.0d0
7242 cd eij=facont_hb(jj,i)
7243 cd ekl=facont_hb(kk,k)
7249 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7250 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7251 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7252 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7253 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7254 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7256 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7257 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7258 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7259 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7260 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7261 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7265 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7267 C If turn contributions are considered, they will be handled separately.
7268 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7269 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7270 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7271 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7272 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7273 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7274 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7277 if (j.lt.nres-1) then
7284 if (l.lt.nres-1) then
7292 ggg1(ll)=eel6*g_contij(ll,1)
7293 ggg2(ll)=eel6*g_contij(ll,2)
7294 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7295 ghalf=0.5d0*ggg1(ll)
7297 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7298 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7299 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7300 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7301 ghalf=0.5d0*ggg2(ll)
7302 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7304 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7305 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7306 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7307 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7312 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7313 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7318 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7319 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7325 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7330 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7334 cd write (2,*) iii,g_corr6_loc(iii)
7338 cd write (2,*) 'ekont',ekont
7339 cd write (iout,*) 'eello6',ekont*eel6
7342 c--------------------------------------------------------------------------
7343 double precision function eello6_graph1(i,j,k,l,imat,swap)
7344 implicit real*8 (a-h,o-z)
7345 include 'DIMENSIONS'
7346 include 'DIMENSIONS.ZSCOPT'
7347 include 'COMMON.IOUNITS'
7348 include 'COMMON.CHAIN'
7349 include 'COMMON.DERIV'
7350 include 'COMMON.INTERACT'
7351 include 'COMMON.CONTACTS'
7352 include 'COMMON.TORSION'
7353 include 'COMMON.VAR'
7354 include 'COMMON.GEO'
7355 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7359 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7361 C Parallel Antiparallel C
7367 C \ j|/k\| / \ |/k\|l / C
7372 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7373 itk=itortyp(itype(k))
7374 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7375 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7376 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7377 call transpose2(EUgC(1,1,k),auxmat(1,1))
7378 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7379 vv1(1)=pizda1(1,1)-pizda1(2,2)
7380 vv1(2)=pizda1(1,2)+pizda1(2,1)
7381 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7382 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7383 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7384 s5=scalar2(vv(1),Dtobr2(1,i))
7385 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7386 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7387 if (.not. calc_grad) return
7388 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7389 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7390 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7391 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7392 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7393 & +scalar2(vv(1),Dtobr2der(1,i)))
7394 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7395 vv1(1)=pizda1(1,1)-pizda1(2,2)
7396 vv1(2)=pizda1(1,2)+pizda1(2,1)
7397 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7398 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7400 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7401 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7402 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7403 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7404 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7406 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7407 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7408 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7409 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7410 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7412 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7413 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7414 vv1(1)=pizda1(1,1)-pizda1(2,2)
7415 vv1(2)=pizda1(1,2)+pizda1(2,1)
7416 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7417 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7418 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7419 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7428 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7429 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7430 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7431 call transpose2(EUgC(1,1,k),auxmat(1,1))
7432 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7434 vv1(1)=pizda1(1,1)-pizda1(2,2)
7435 vv1(2)=pizda1(1,2)+pizda1(2,1)
7436 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7437 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7438 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7439 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7440 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7441 s5=scalar2(vv(1),Dtobr2(1,i))
7442 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7448 c----------------------------------------------------------------------------
7449 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7450 implicit real*8 (a-h,o-z)
7451 include 'DIMENSIONS'
7452 include 'DIMENSIONS.ZSCOPT'
7453 include 'COMMON.IOUNITS'
7454 include 'COMMON.CHAIN'
7455 include 'COMMON.DERIV'
7456 include 'COMMON.INTERACT'
7457 include 'COMMON.CONTACTS'
7458 include 'COMMON.TORSION'
7459 include 'COMMON.VAR'
7460 include 'COMMON.GEO'
7462 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7463 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7468 C Parallel Antiparallel C
7474 C \ j|/k\| \ |/k\|l C
7479 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7480 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7481 C AL 7/4/01 s1 would occur in the sixth-order moment,
7482 C but not in a cluster cumulant
7484 s1=dip(1,jj,i)*dip(1,kk,k)
7486 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7487 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7488 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7489 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7490 call transpose2(EUg(1,1,k),auxmat(1,1))
7491 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7492 vv(1)=pizda(1,1)-pizda(2,2)
7493 vv(2)=pizda(1,2)+pizda(2,1)
7494 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7495 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7497 eello6_graph2=-(s1+s2+s3+s4)
7499 eello6_graph2=-(s2+s3+s4)
7502 if (.not. calc_grad) return
7503 C Derivatives in gamma(i-1)
7506 s1=dipderg(1,jj,i)*dip(1,kk,k)
7508 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7509 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7510 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7511 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7513 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7515 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7517 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7519 C Derivatives in gamma(k-1)
7521 s1=dip(1,jj,i)*dipderg(1,kk,k)
7523 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7524 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7525 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7526 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7527 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7528 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7529 vv(1)=pizda(1,1)-pizda(2,2)
7530 vv(2)=pizda(1,2)+pizda(2,1)
7531 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7533 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7537 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7538 C Derivatives in gamma(j-1) or gamma(l-1)
7541 s1=dipderg(3,jj,i)*dip(1,kk,k)
7543 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7544 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7545 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7546 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7549 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7552 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7554 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7557 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7558 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7560 C Derivatives in gamma(l-1) or gamma(j-1)
7563 s1=dip(1,jj,i)*dipderg(3,kk,k)
7565 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7566 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7567 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7568 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7569 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7570 vv(1)=pizda(1,1)-pizda(2,2)
7571 vv(2)=pizda(1,2)+pizda(2,1)
7572 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7575 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7577 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7580 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7581 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7583 C Cartesian derivatives.
7585 write (2,*) 'In eello6_graph2'
7587 write (2,*) 'iii=',iii
7589 write (2,*) 'kkk=',kkk
7591 write (2,'(3(2f10.5),5x)')
7592 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7602 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7604 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7607 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7609 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7610 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7612 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7613 call transpose2(EUg(1,1,k),auxmat(1,1))
7614 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7616 vv(1)=pizda(1,1)-pizda(2,2)
7617 vv(2)=pizda(1,2)+pizda(2,1)
7618 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7619 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7621 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7626 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7628 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7635 c----------------------------------------------------------------------------
7636 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7637 implicit real*8 (a-h,o-z)
7638 include 'DIMENSIONS'
7639 include 'DIMENSIONS.ZSCOPT'
7640 include 'COMMON.IOUNITS'
7641 include 'COMMON.CHAIN'
7642 include 'COMMON.DERIV'
7643 include 'COMMON.INTERACT'
7644 include 'COMMON.CONTACTS'
7645 include 'COMMON.TORSION'
7646 include 'COMMON.VAR'
7647 include 'COMMON.GEO'
7648 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7652 C Parallel Antiparallel C
7658 C j|/k\| / |/k\|l / C
7663 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7665 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7666 C energy moment and not to the cluster cumulant.
7667 iti=itortyp(itype(i))
7668 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7669 itj1=itortyp(itype(j+1))
7673 itk=itortyp(itype(k))
7674 itk1=itortyp(itype(k+1))
7675 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7676 itl1=itortyp(itype(l+1))
7681 s1=dip(4,jj,i)*dip(4,kk,k)
7683 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7684 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7685 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7686 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7687 call transpose2(EE(1,1,itk),auxmat(1,1))
7688 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7689 vv(1)=pizda(1,1)+pizda(2,2)
7690 vv(2)=pizda(2,1)-pizda(1,2)
7691 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7692 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7694 eello6_graph3=-(s1+s2+s3+s4)
7696 eello6_graph3=-(s2+s3+s4)
7699 if (.not. calc_grad) return
7700 C Derivatives in gamma(k-1)
7701 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7702 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7703 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7704 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7705 C Derivatives in gamma(l-1)
7706 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7707 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7708 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7709 vv(1)=pizda(1,1)+pizda(2,2)
7710 vv(2)=pizda(2,1)-pizda(1,2)
7711 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7712 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7713 C Cartesian derivatives.
7719 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7721 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7724 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7726 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7727 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7729 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7730 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7732 vv(1)=pizda(1,1)+pizda(2,2)
7733 vv(2)=pizda(2,1)-pizda(1,2)
7734 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7736 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7738 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7741 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7743 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7745 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7751 c----------------------------------------------------------------------------
7752 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7753 implicit real*8 (a-h,o-z)
7754 include 'DIMENSIONS'
7755 include 'DIMENSIONS.ZSCOPT'
7756 include 'COMMON.IOUNITS'
7757 include 'COMMON.CHAIN'
7758 include 'COMMON.DERIV'
7759 include 'COMMON.INTERACT'
7760 include 'COMMON.CONTACTS'
7761 include 'COMMON.TORSION'
7762 include 'COMMON.VAR'
7763 include 'COMMON.GEO'
7764 include 'COMMON.FFIELD'
7765 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7766 & auxvec1(2),auxmat1(2,2)
7768 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7770 C Parallel Antiparallel C
7776 C \ j|/k\| \ |/k\|l C
7781 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7783 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7784 C energy moment and not to the cluster cumulant.
7785 cd write (2,*) 'eello_graph4: wturn6',wturn6
7786 iti=itortyp(itype(i))
7787 itj=itortyp(itype(j))
7788 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7789 itj1=itortyp(itype(j+1))
7793 itk=itortyp(itype(k))
7794 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7795 itk1=itortyp(itype(k+1))
7799 itl=itortyp(itype(l))
7800 if (l.lt.nres-1) then
7801 itl1=itortyp(itype(l+1))
7805 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7806 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7807 cd & ' itl',itl,' itl1',itl1
7810 s1=dip(3,jj,i)*dip(3,kk,k)
7812 s1=dip(2,jj,j)*dip(2,kk,l)
7815 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7816 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7818 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7819 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7821 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7822 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7824 call transpose2(EUg(1,1,k),auxmat(1,1))
7825 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7826 vv(1)=pizda(1,1)-pizda(2,2)
7827 vv(2)=pizda(2,1)+pizda(1,2)
7828 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7829 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7831 eello6_graph4=-(s1+s2+s3+s4)
7833 eello6_graph4=-(s2+s3+s4)
7835 if (.not. calc_grad) return
7836 C Derivatives in gamma(i-1)
7840 s1=dipderg(2,jj,i)*dip(3,kk,k)
7842 s1=dipderg(4,jj,j)*dip(2,kk,l)
7845 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7847 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7848 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7850 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7851 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7853 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7854 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7855 cd write (2,*) 'turn6 derivatives'
7857 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7859 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7863 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7865 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7869 C Derivatives in gamma(k-1)
7872 s1=dip(3,jj,i)*dipderg(2,kk,k)
7874 s1=dip(2,jj,j)*dipderg(4,kk,l)
7877 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7878 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7880 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7881 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7883 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7884 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7886 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7887 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7888 vv(1)=pizda(1,1)-pizda(2,2)
7889 vv(2)=pizda(2,1)+pizda(1,2)
7890 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7891 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7893 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7895 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7899 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7901 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7904 C Derivatives in gamma(j-1) or gamma(l-1)
7905 if (l.eq.j+1 .and. l.gt.1) then
7906 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7907 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7908 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7909 vv(1)=pizda(1,1)-pizda(2,2)
7910 vv(2)=pizda(2,1)+pizda(1,2)
7911 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7912 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7913 else if (j.gt.1) then
7914 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7915 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7916 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7917 vv(1)=pizda(1,1)-pizda(2,2)
7918 vv(2)=pizda(2,1)+pizda(1,2)
7919 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7920 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7921 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7923 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7926 C Cartesian derivatives.
7933 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7935 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7939 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7941 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7945 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7947 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7949 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7950 & b1(1,itj1),auxvec(1))
7951 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7953 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7954 & b1(1,itl1),auxvec(1))
7955 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7957 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7959 vv(1)=pizda(1,1)-pizda(2,2)
7960 vv(2)=pizda(2,1)+pizda(1,2)
7961 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7963 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7965 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7968 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7971 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7974 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7976 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7978 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7982 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7984 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7987 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7989 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7997 c----------------------------------------------------------------------------
7998 double precision function eello_turn6(i,jj,kk)
7999 implicit real*8 (a-h,o-z)
8000 include 'DIMENSIONS'
8001 include 'DIMENSIONS.ZSCOPT'
8002 include 'COMMON.IOUNITS'
8003 include 'COMMON.CHAIN'
8004 include 'COMMON.DERIV'
8005 include 'COMMON.INTERACT'
8006 include 'COMMON.CONTACTS'
8007 include 'COMMON.TORSION'
8008 include 'COMMON.VAR'
8009 include 'COMMON.GEO'
8010 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8011 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8013 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8014 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8015 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8016 C the respective energy moment and not to the cluster cumulant.
8021 iti=itortyp(itype(i))
8022 itk=itortyp(itype(k))
8023 itk1=itortyp(itype(k+1))
8024 itl=itortyp(itype(l))
8025 itj=itortyp(itype(j))
8026 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8027 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8028 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8033 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8035 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8039 derx_turn(lll,kkk,iii)=0.0d0
8046 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8048 cd write (2,*) 'eello6_5',eello6_5
8050 call transpose2(AEA(1,1,1),auxmat(1,1))
8051 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8052 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8053 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8057 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8058 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8059 s2 = scalar2(b1(1,itk),vtemp1(1))
8061 call transpose2(AEA(1,1,2),atemp(1,1))
8062 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8063 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8064 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8068 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8069 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8070 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8072 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8073 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8074 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8075 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8076 ss13 = scalar2(b1(1,itk),vtemp4(1))
8077 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8081 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8087 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8089 C Derivatives in gamma(i+2)
8091 call transpose2(AEA(1,1,1),auxmatd(1,1))
8092 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8093 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8094 call transpose2(AEAderg(1,1,2),atempd(1,1))
8095 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8096 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8100 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8101 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8102 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8108 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8109 C Derivatives in gamma(i+3)
8111 call transpose2(AEA(1,1,1),auxmatd(1,1))
8112 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8113 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8114 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8118 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8119 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8120 s2d = scalar2(b1(1,itk),vtemp1d(1))
8122 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8123 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8125 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8127 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8128 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8129 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8139 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8140 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8142 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8143 & -0.5d0*ekont*(s2d+s12d)
8145 C Derivatives in gamma(i+4)
8146 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8147 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8148 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8150 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8151 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8152 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8162 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8164 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8166 C Derivatives in gamma(i+5)
8168 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8169 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8170 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8174 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8175 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8176 s2d = scalar2(b1(1,itk),vtemp1d(1))
8178 call transpose2(AEA(1,1,2),atempd(1,1))
8179 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8180 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8184 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8185 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8187 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8188 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8189 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8199 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8200 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8202 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8203 & -0.5d0*ekont*(s2d+s12d)
8205 C Cartesian derivatives
8210 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8211 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8212 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8216 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8217 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8219 s2d = scalar2(b1(1,itk),vtemp1d(1))
8221 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8222 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8223 s8d = -(atempd(1,1)+atempd(2,2))*
8224 & scalar2(cc(1,1,itl),vtemp2(1))
8228 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8230 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8231 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8238 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8241 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8245 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8246 & - 0.5d0*(s8d+s12d)
8248 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8257 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8259 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8260 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8261 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8262 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8263 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8265 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8266 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8267 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8271 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8272 cd & 16*eel_turn6_num
8274 if (j.lt.nres-1) then
8281 if (l.lt.nres-1) then
8289 ggg1(ll)=eel_turn6*g_contij(ll,1)
8290 ggg2(ll)=eel_turn6*g_contij(ll,2)
8291 ghalf=0.5d0*ggg1(ll)
8293 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8294 & +ekont*derx_turn(ll,2,1)
8295 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8296 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8297 & +ekont*derx_turn(ll,4,1)
8298 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8299 ghalf=0.5d0*ggg2(ll)
8301 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8302 & +ekont*derx_turn(ll,2,2)
8303 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8304 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8305 & +ekont*derx_turn(ll,4,2)
8306 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8311 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8316 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8322 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8327 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8331 cd write (2,*) iii,g_corr6_loc(iii)
8334 eello_turn6=ekont*eel_turn6
8335 cd write (2,*) 'ekont',ekont
8336 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8339 crc-------------------------------------------------
8340 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8341 subroutine Eliptransfer(eliptran)
8342 implicit real*8 (a-h,o-z)
8343 include 'DIMENSIONS'
8344 include 'COMMON.GEO'
8345 include 'COMMON.VAR'
8346 include 'COMMON.LOCAL'
8347 include 'COMMON.CHAIN'
8348 include 'COMMON.DERIV'
8349 include 'COMMON.INTERACT'
8350 include 'COMMON.IOUNITS'
8351 include 'COMMON.CALC'
8352 include 'COMMON.CONTROL'
8353 include 'COMMON.SPLITELE'
8354 include 'COMMON.SBRIDGE'
8355 C this is done by Adasko
8359 C--bordliptop-- buffore starts
8360 C--bufliptop--- here true lipid starts
8362 C--buflipbot--- lipid ends buffore starts
8363 C--bordlipbot--buffore ends
8367 if (itype(i).eq.ntyp1) cycle
8369 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8370 if (positi.le.0) positi=positi+boxzsize
8372 C first for peptide groups
8373 c for each residue check if it is in lipid or lipid water border area
8374 if ((positi.gt.bordlipbot)
8375 &.and.(positi.lt.bordliptop)) then
8376 C the energy transfer exist
8377 if (positi.lt.buflipbot) then
8378 C what fraction I am in
8380 & ((positi-bordlipbot)/lipbufthick)
8381 C lipbufthick is thickenes of lipid buffore
8382 sslip=sscalelip(fracinbuf)
8383 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8384 eliptran=eliptran+sslip*pepliptran
8385 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8386 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8387 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8388 elseif (positi.gt.bufliptop) then
8389 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8390 sslip=sscalelip(fracinbuf)
8391 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8392 eliptran=eliptran+sslip*pepliptran
8393 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8394 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8395 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8396 C print *, "doing sscalefor top part"
8397 C print *,i,sslip,fracinbuf,ssgradlip
8399 eliptran=eliptran+pepliptran
8400 C print *,"I am in true lipid"
8403 C eliptran=elpitran+0.0 ! I am in water
8406 C print *, "nic nie bylo w lipidzie?"
8407 C now multiply all by the peptide group transfer factor
8408 C eliptran=eliptran*pepliptran
8409 C now the same for side chains
8412 if (itype(i).eq.ntyp1) cycle
8413 positi=(mod(c(3,i+nres),boxzsize))
8414 if (positi.le.0) positi=positi+boxzsize
8415 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8416 c for each residue check if it is in lipid or lipid water border area
8417 C respos=mod(c(3,i+nres),boxzsize)
8418 C print *,positi,bordlipbot,buflipbot
8419 if ((positi.gt.bordlipbot)
8420 & .and.(positi.lt.bordliptop)) then
8421 C the energy transfer exist
8422 if (positi.lt.buflipbot) then
8424 & ((positi-bordlipbot)/lipbufthick)
8425 C lipbufthick is thickenes of lipid buffore
8426 sslip=sscalelip(fracinbuf)
8427 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8428 eliptran=eliptran+sslip*liptranene(itype(i))
8429 gliptranx(3,i)=gliptranx(3,i)
8430 &+ssgradlip*liptranene(itype(i))
8431 gliptranc(3,i-1)= gliptranc(3,i-1)
8432 &+ssgradlip*liptranene(itype(i))
8433 C print *,"doing sccale for lower part"
8434 elseif (positi.gt.bufliptop) then
8436 &((bordliptop-positi)/lipbufthick)
8437 sslip=sscalelip(fracinbuf)
8438 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8439 eliptran=eliptran+sslip*liptranene(itype(i))
8440 gliptranx(3,i)=gliptranx(3,i)
8441 &+ssgradlip*liptranene(itype(i))
8442 gliptranc(3,i-1)= gliptranc(3,i-1)
8443 &+ssgradlip*liptranene(itype(i))
8444 C print *, "doing sscalefor top part",sslip,fracinbuf
8446 eliptran=eliptran+liptranene(itype(i))
8447 C print *,"I am in true lipid"
8449 endif ! if in lipid or buffor
8451 C eliptran=elpitran+0.0 ! I am in water
8457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8459 SUBROUTINE MATVEC2(A1,V1,V2)
8460 implicit real*8 (a-h,o-z)
8461 include 'DIMENSIONS'
8462 DIMENSION A1(2,2),V1(2),V2(2)
8466 c 3 VI=VI+A1(I,K)*V1(K)
8470 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8471 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8476 C---------------------------------------
8477 SUBROUTINE MATMAT2(A1,A2,A3)
8478 implicit real*8 (a-h,o-z)
8479 include 'DIMENSIONS'
8480 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8481 c DIMENSION AI3(2,2)
8485 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8491 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8492 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8493 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8494 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8502 c-------------------------------------------------------------------------
8503 double precision function scalar2(u,v)
8505 double precision u(2),v(2)
8508 scalar2=u(1)*v(1)+u(2)*v(2)
8512 C-----------------------------------------------------------------------------
8514 subroutine transpose2(a,at)
8516 double precision a(2,2),at(2,2)
8523 c--------------------------------------------------------------------------
8524 subroutine transpose(n,a,at)
8527 double precision a(n,n),at(n,n)
8535 C---------------------------------------------------------------------------
8536 subroutine prodmat3(a1,a2,kk,transp,prod)
8539 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8541 crc double precision auxmat(2,2),prod_(2,2)
8544 crc call transpose2(kk(1,1),auxmat(1,1))
8545 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8546 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8548 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8549 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8550 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8551 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8552 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8553 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8554 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8555 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8558 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8559 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8561 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8562 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8563 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8564 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8565 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8566 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8567 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8568 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8571 c call transpose2(a2(1,1),a2t(1,1))
8574 crc print *,((prod_(i,j),i=1,2),j=1,2)
8575 crc print *,((prod(i,j),i=1,2),j=1,2)
8579 C-----------------------------------------------------------------------------
8580 double precision function scalar(u,v)
8582 double precision u(3),v(3)
8592 C-----------------------------------------------------------------------
8593 double precision function sscale(r)
8594 double precision r,gamm
8595 include "COMMON.SPLITELE"
8596 if(r.lt.r_cut-rlamb) then
8598 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8599 gamm=(r-(r_cut-rlamb))/rlamb
8600 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8606 C-----------------------------------------------------------------------
8607 C-----------------------------------------------------------------------
8608 double precision function sscagrad(r)
8609 double precision r,gamm
8610 include "COMMON.SPLITELE"
8611 if(r.lt.r_cut-rlamb) then
8613 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8614 gamm=(r-(r_cut-rlamb))/rlamb
8615 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8621 C-----------------------------------------------------------------------
8622 C-----------------------------------------------------------------------
8623 double precision function sscalelip(r)
8624 double precision r,gamm
8625 include "COMMON.SPLITELE"
8626 C if(r.lt.r_cut-rlamb) then
8628 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8629 C gamm=(r-(r_cut-rlamb))/rlamb
8630 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8636 C-----------------------------------------------------------------------
8637 double precision function sscagradlip(r)
8638 double precision r,gamm
8639 include "COMMON.SPLITELE"
8640 C if(r.lt.r_cut-rlamb) then
8642 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8643 C gamm=(r-(r_cut-rlamb))/rlamb
8644 sscagradlip=r*(6*r-6.0d0)
8651 C-----------------------------------------------------------------------
8652 subroutine set_shield_fac
8653 implicit real*8 (a-h,o-z)
8654 include 'DIMENSIONS'
8655 include 'COMMON.CHAIN'
8656 include 'COMMON.DERIV'
8657 include 'COMMON.IOUNITS'
8658 include 'COMMON.SHIELD'
8659 include 'COMMON.INTERACT'
8660 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8661 double precision div77_81/0.974996043d0/,
8662 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8664 C the vector between center of side_chain and peptide group
8665 double precision pep_side(3),long,side_calf(3),
8666 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8667 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8668 C the line belowe needs to be changed for FGPROC>1
8670 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8672 Cif there two consequtive dummy atoms there is no peptide group between them
8673 C the line below has to be changed for FGPROC>1
8676 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8680 C first lets set vector conecting the ithe side-chain with kth side-chain
8681 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8683 C and vector conecting the side-chain with its proper calfa
8684 side_calf(j)=c(j,k+nres)-c(j,k)
8685 C side_calf(j)=2.0d0
8686 pept_group(j)=c(j,i)-c(j,i+1)
8687 C lets have their lenght
8688 dist_pep_side=pep_side(j)**2+dist_pep_side
8689 dist_side_calf=dist_side_calf+side_calf(j)**2
8690 dist_pept_group=dist_pept_group+pept_group(j)**2
8692 dist_pep_side=dsqrt(dist_pep_side)
8693 dist_pept_group=dsqrt(dist_pept_group)
8694 dist_side_calf=dsqrt(dist_side_calf)
8696 pep_side_norm(j)=pep_side(j)/dist_pep_side
8697 side_calf_norm(j)=dist_side_calf
8699 C now sscale fraction
8700 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8701 C print *,buff_shield,"buff"
8703 if (sh_frac_dist.le.0.0) cycle
8704 C If we reach here it means that this side chain reaches the shielding sphere
8705 C Lets add him to the list for gradient
8706 ishield_list(i)=ishield_list(i)+1
8707 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8708 C this list is essential otherwise problem would be O3
8709 shield_list(ishield_list(i),i)=k
8710 C Lets have the sscale value
8711 if (sh_frac_dist.gt.1.0) then
8712 scale_fac_dist=1.0d0
8714 sh_frac_dist_grad(j)=0.0d0
8717 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8718 & *(2.0*sh_frac_dist-3.0d0)
8719 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8720 & /dist_pep_side/buff_shield*0.5
8721 C remember for the final gradient multiply sh_frac_dist_grad(j)
8722 C for side_chain by factor -2 !
8724 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8725 C print *,"jestem",scale_fac_dist,fac_help_scale,
8726 C & sh_frac_dist_grad(j)
8729 C if ((i.eq.3).and.(k.eq.2)) then
8730 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8734 C this is what is now we have the distance scaling now volume...
8735 short=short_r_sidechain(itype(k))
8736 long=long_r_sidechain(itype(k))
8737 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8740 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8743 costhet_grad(j)=costhet_fac*pep_side(j)
8745 C remember for the final gradient multiply costhet_grad(j)
8746 C for side_chain by factor -2 !
8747 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8748 C pep_side0pept_group is vector multiplication
8749 pep_side0pept_group=0.0
8751 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8753 cosalfa=(pep_side0pept_group/
8754 & (dist_pep_side*dist_side_calf))
8755 fac_alfa_sin=1.0-cosalfa**2
8756 fac_alfa_sin=dsqrt(fac_alfa_sin)
8757 rkprim=fac_alfa_sin*(long-short)+short
8759 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8760 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8763 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8764 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8765 &*(long-short)/fac_alfa_sin*cosalfa/
8766 &((dist_pep_side*dist_side_calf))*
8767 &((side_calf(j))-cosalfa*
8768 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8770 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8771 &*(long-short)/fac_alfa_sin*cosalfa
8772 &/((dist_pep_side*dist_side_calf))*
8774 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8777 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8780 C now the gradient...
8781 C grad_shield is gradient of Calfa for peptide groups
8782 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8784 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8785 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8787 grad_shield(j,i)=grad_shield(j,i)
8788 C gradient po skalowaniu
8789 & +(sh_frac_dist_grad(j)
8790 C gradient po costhet
8791 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8792 &-scale_fac_dist*(cosphi_grad_long(j))
8793 &/(1.0-cosphi) )*div77_81
8795 C grad_shield_side is Cbeta sidechain gradient
8796 grad_shield_side(j,ishield_list(i),i)=
8797 & (sh_frac_dist_grad(j)*-2.0d0
8798 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8799 & +scale_fac_dist*(cosphi_grad_long(j))
8800 & *2.0d0/(1.0-cosphi))
8801 & *div77_81*VofOverlap
8803 grad_shield_loc(j,ishield_list(i),i)=
8804 & scale_fac_dist*cosphi_grad_loc(j)
8805 & *2.0d0/(1.0-cosphi)
8806 & *div77_81*VofOverlap
8808 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8810 fac_shield(i)=VolumeTotal*div77_81+div4_81
8811 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8815 C--------------------------------------------------------------------------
8816 C first for shielding is setting of function of side-chains
8817 subroutine set_shield_fac2
8818 implicit real*8 (a-h,o-z)
8819 include 'DIMENSIONS'
8820 include 'COMMON.CHAIN'
8821 include 'COMMON.DERIV'
8822 include 'COMMON.IOUNITS'
8823 include 'COMMON.SHIELD'
8824 include 'COMMON.INTERACT'
8825 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8826 double precision div77_81/0.974996043d0/,
8827 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8829 C the vector between center of side_chain and peptide group
8830 double precision pep_side(3),long,side_calf(3),
8831 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8832 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8833 C the line belowe needs to be changed for FGPROC>1
8835 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8837 Cif there two consequtive dummy atoms there is no peptide group between them
8838 C the line below has to be changed for FGPROC>1
8841 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8845 C first lets set vector conecting the ithe side-chain with kth side-chain
8846 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8848 C and vector conecting the side-chain with its proper calfa
8849 side_calf(j)=c(j,k+nres)-c(j,k)
8850 C side_calf(j)=2.0d0
8851 pept_group(j)=c(j,i)-c(j,i+1)
8852 C lets have their lenght
8853 dist_pep_side=pep_side(j)**2+dist_pep_side
8854 dist_side_calf=dist_side_calf+side_calf(j)**2
8855 dist_pept_group=dist_pept_group+pept_group(j)**2
8857 dist_pep_side=dsqrt(dist_pep_side)
8858 dist_pept_group=dsqrt(dist_pept_group)
8859 dist_side_calf=dsqrt(dist_side_calf)
8861 pep_side_norm(j)=pep_side(j)/dist_pep_side
8862 side_calf_norm(j)=dist_side_calf
8864 C now sscale fraction
8865 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8866 C print *,buff_shield,"buff"
8868 if (sh_frac_dist.le.0.0) cycle
8869 C If we reach here it means that this side chain reaches the shielding sphere
8870 C Lets add him to the list for gradient
8871 ishield_list(i)=ishield_list(i)+1
8872 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8873 C this list is essential otherwise problem would be O3
8874 shield_list(ishield_list(i),i)=k
8875 C Lets have the sscale value
8876 if (sh_frac_dist.gt.1.0) then
8877 scale_fac_dist=1.0d0
8879 sh_frac_dist_grad(j)=0.0d0
8882 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8883 & *(2.0d0*sh_frac_dist-3.0d0)
8884 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8885 & /dist_pep_side/buff_shield*0.5d0
8886 C remember for the final gradient multiply sh_frac_dist_grad(j)
8887 C for side_chain by factor -2 !
8889 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8890 C sh_frac_dist_grad(j)=0.0d0
8891 C scale_fac_dist=1.0d0
8892 C print *,"jestem",scale_fac_dist,fac_help_scale,
8893 C & sh_frac_dist_grad(j)
8896 C this is what is now we have the distance scaling now volume...
8897 short=short_r_sidechain(itype(k))
8898 long=long_r_sidechain(itype(k))
8899 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8900 sinthet=short/dist_pep_side*costhet
8904 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8905 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8906 C & -short/dist_pep_side**2/costhet)
8909 costhet_grad(j)=costhet_fac*pep_side(j)
8911 C remember for the final gradient multiply costhet_grad(j)
8912 C for side_chain by factor -2 !
8913 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8914 C pep_side0pept_group is vector multiplication
8915 pep_side0pept_group=0.0d0
8917 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8919 cosalfa=(pep_side0pept_group/
8920 & (dist_pep_side*dist_side_calf))
8921 fac_alfa_sin=1.0d0-cosalfa**2
8922 fac_alfa_sin=dsqrt(fac_alfa_sin)
8923 rkprim=fac_alfa_sin*(long-short)+short
8927 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8929 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8930 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8934 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8935 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8936 &*(long-short)/fac_alfa_sin*cosalfa/
8937 &((dist_pep_side*dist_side_calf))*
8938 &((side_calf(j))-cosalfa*
8939 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8940 C cosphi_grad_long(j)=0.0d0
8941 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8942 &*(long-short)/fac_alfa_sin*cosalfa
8943 &/((dist_pep_side*dist_side_calf))*
8945 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8946 C cosphi_grad_loc(j)=0.0d0
8948 C print *,sinphi,sinthet
8949 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8952 C now the gradient...
8954 grad_shield(j,i)=grad_shield(j,i)
8955 C gradient po skalowaniu
8956 & +(sh_frac_dist_grad(j)*VofOverlap
8957 C gradient po costhet
8958 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8959 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8960 & sinphi/sinthet*costhet*costhet_grad(j)
8961 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8963 C grad_shield_side is Cbeta sidechain gradient
8964 grad_shield_side(j,ishield_list(i),i)=
8965 & (sh_frac_dist_grad(j)*-2.0d0
8967 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8968 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8969 & sinphi/sinthet*costhet*costhet_grad(j)
8970 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8973 grad_shield_loc(j,ishield_list(i),i)=
8974 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8975 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8976 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8980 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8982 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8983 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8984 C write(2,*) "TU",rpp(1,1),short,long,buff_shield