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'
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,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1038 C checking the distance
1039 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1044 C finding the closest
1048 xj=xj_safe+xshift*boxxsize
1049 yj=yj_safe+yshift*boxysize
1050 zj=zj_safe+zshift*boxzsize
1051 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1052 if(dist_temp.lt.dist_init) then
1062 if (subchap.eq.1) then
1072 dxj=dc_norm(1,nres+j)
1073 dyj=dc_norm(2,nres+j)
1074 dzj=dc_norm(3,nres+j)
1075 c write (iout,*) i,j,xj,yj,zj
1076 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1078 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1079 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1080 if (sss.le.0.0) cycle
1081 C Calculate angle-dependent terms of energy and contributions to their
1086 sig=sig0ij*dsqrt(sigsq)
1087 rij_shift=1.0D0/rij-sig+sig0ij
1088 C I hate to put IF's in the loops, but here don't have another choice!!!!
1089 if (rij_shift.le.0.0D0) then
1094 c---------------------------------------------------------------
1095 rij_shift=1.0D0/rij_shift
1096 fac=rij_shift**expon
1099 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1100 eps2der=evdwij*eps3rt
1101 eps3der=evdwij*eps2rt
1102 evdwij=evdwij*eps2rt*eps3rt
1104 evdw=evdw+evdwij*sss
1106 evdw_t=evdw_t+evdwij*sss
1108 ij=icant(itypi,itypj)
1109 aux=eps1*eps2rt**2*eps3rt**2
1110 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1111 & /dabs(eps(itypi,itypj))
1112 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1113 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1114 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1115 c & aux*e2/eps(itypi,itypj)
1117 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1120 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1121 & restyp(itypi),i,restyp(itypj),j,
1122 & epsi,sigm,chi1,chi2,chip1,chip2,
1123 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1124 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1126 write (iout,*) "partial sum", evdw, evdw_t
1130 C Calculate gradient components.
1131 e1=e1*eps1*eps2rt**2*eps3rt**2
1132 fac=-expon*(e1+evdwij)*rij_shift
1135 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1136 C Calculate the radial part of the gradient
1140 C Calculate angular part of the gradient.
1143 C write(iout,*) "partial sum", evdw, evdw_t
1150 C-----------------------------------------------------------------------------
1151 subroutine egbv(evdw,evdw_t)
1153 C This subroutine calculates the interaction energy of nonbonded side chains
1154 C assuming the Gay-Berne-Vorobjev potential of interaction.
1156 implicit real*8 (a-h,o-z)
1157 include 'DIMENSIONS'
1158 include 'DIMENSIONS.ZSCOPT'
1159 include "DIMENSIONS.COMPAR"
1160 include 'COMMON.GEO'
1161 include 'COMMON.VAR'
1162 include 'COMMON.LOCAL'
1163 include 'COMMON.CHAIN'
1164 include 'COMMON.DERIV'
1165 include 'COMMON.NAMES'
1166 include 'COMMON.INTERACT'
1167 include 'COMMON.ENEPS'
1168 include 'COMMON.IOUNITS'
1169 include 'COMMON.CALC'
1170 common /srutu/ icall
1176 eneps_temp(j,i)=0.0d0
1181 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1184 c if (icall.gt.0) lprn=.true.
1186 do i=iatsc_s,iatsc_e
1187 itypi=iabs(itype(i))
1188 if (itypi.eq.ntyp1) cycle
1189 itypi1=iabs(itype(i+1))
1193 dxi=dc_norm(1,nres+i)
1194 dyi=dc_norm(2,nres+i)
1195 dzi=dc_norm(3,nres+i)
1196 dsci_inv=vbld_inv(i+nres)
1198 C Calculate SC interaction energy.
1200 do iint=1,nint_gr(i)
1201 do j=istart(i,iint),iend(i,iint)
1203 itypj=iabs(itype(j))
1204 if (itypj.eq.ntyp1) cycle
1205 dscj_inv=vbld_inv(j+nres)
1206 sig0ij=sigma(itypi,itypj)
1207 r0ij=r0(itypi,itypj)
1208 chi1=chi(itypi,itypj)
1209 chi2=chi(itypj,itypi)
1216 alf12=0.5D0*(alf1+alf2)
1217 C For diagnostics only!!!
1230 dxj=dc_norm(1,nres+j)
1231 dyj=dc_norm(2,nres+j)
1232 dzj=dc_norm(3,nres+j)
1233 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1235 C Calculate angle-dependent terms of energy and contributions to their
1239 sig=sig0ij*dsqrt(sigsq)
1240 rij_shift=1.0D0/rij-sig+r0ij
1241 C I hate to put IF's in the loops, but here don't have another choice!!!!
1242 if (rij_shift.le.0.0D0) then
1247 c---------------------------------------------------------------
1248 rij_shift=1.0D0/rij_shift
1249 fac=rij_shift**expon
1252 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1253 eps2der=evdwij*eps3rt
1254 eps3der=evdwij*eps2rt
1255 fac_augm=rrij**expon
1256 e_augm=augm(itypi,itypj)*fac_augm
1257 evdwij=evdwij*eps2rt*eps3rt
1258 if (bb.gt.0.0d0) then
1259 evdw=evdw+evdwij+e_augm
1261 evdw_t=evdw_t+evdwij+e_augm
1263 ij=icant(itypi,itypj)
1264 aux=eps1*eps2rt**2*eps3rt**2
1265 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1266 & /dabs(eps(itypi,itypj))
1267 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1268 c eneps_temp(ij)=eneps_temp(ij)
1269 c & +(evdwij+e_augm)/eps(itypi,itypj)
1271 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1272 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1273 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1274 c & restyp(itypi),i,restyp(itypj),j,
1275 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1276 c & chi1,chi2,chip1,chip2,
1277 c & eps1,eps2rt**2,eps3rt**2,
1278 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1282 C Calculate gradient components.
1283 e1=e1*eps1*eps2rt**2*eps3rt**2
1284 fac=-expon*(e1+evdwij)*rij_shift
1286 fac=rij*fac-2*expon*rrij*e_augm
1287 C Calculate the radial part of the gradient
1291 C Calculate angular part of the gradient.
1299 C-----------------------------------------------------------------------------
1300 subroutine sc_angular
1301 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1302 C om12. Called by ebp, egb, and egbv.
1304 include 'COMMON.CALC'
1308 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1309 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1310 om12=dxi*dxj+dyi*dyj+dzi*dzj
1312 C Calculate eps1(om12) and its derivative in om12
1313 faceps1=1.0D0-om12*chiom12
1314 faceps1_inv=1.0D0/faceps1
1315 eps1=dsqrt(faceps1_inv)
1316 C Following variable is eps1*deps1/dom12
1317 eps1_om12=faceps1_inv*chiom12
1318 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1323 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1324 sigsq=1.0D0-facsig*faceps1_inv
1325 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1326 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1327 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1328 C Calculate eps2 and its derivatives in om1, om2, and om12.
1331 chipom12=chip12*om12
1332 facp=1.0D0-om12*chipom12
1334 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1335 C Following variable is the square root of eps2
1336 eps2rt=1.0D0-facp1*facp_inv
1337 C Following three variables are the derivatives of the square root of eps
1338 C in om1, om2, and om12.
1339 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1340 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1341 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1342 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1343 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1344 C Calculate whole angle-dependent part of epsilon and contributions
1345 C to its derivatives
1348 C----------------------------------------------------------------------------
1350 implicit real*8 (a-h,o-z)
1351 include 'DIMENSIONS'
1352 include 'DIMENSIONS.ZSCOPT'
1353 include 'COMMON.CHAIN'
1354 include 'COMMON.DERIV'
1355 include 'COMMON.CALC'
1356 double precision dcosom1(3),dcosom2(3)
1357 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1358 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1359 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1360 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1362 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1363 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1366 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1369 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1370 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1371 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1372 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1373 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1374 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1377 C Calculate the components of the gradient in DC and X
1381 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1386 c------------------------------------------------------------------------------
1387 subroutine vec_and_deriv
1388 implicit real*8 (a-h,o-z)
1389 include 'DIMENSIONS'
1390 include 'DIMENSIONS.ZSCOPT'
1391 include 'COMMON.IOUNITS'
1392 include 'COMMON.GEO'
1393 include 'COMMON.VAR'
1394 include 'COMMON.LOCAL'
1395 include 'COMMON.CHAIN'
1396 include 'COMMON.VECTORS'
1397 include 'COMMON.DERIV'
1398 include 'COMMON.INTERACT'
1399 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1400 C Compute the local reference systems. For reference system (i), the
1401 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1402 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1404 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1405 if (i.eq.nres-1) then
1406 C Case of the last full residue
1407 C Compute the Z-axis
1408 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1409 costh=dcos(pi-theta(nres))
1410 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1415 C Compute the derivatives of uz
1417 uzder(2,1,1)=-dc_norm(3,i-1)
1418 uzder(3,1,1)= dc_norm(2,i-1)
1419 uzder(1,2,1)= dc_norm(3,i-1)
1421 uzder(3,2,1)=-dc_norm(1,i-1)
1422 uzder(1,3,1)=-dc_norm(2,i-1)
1423 uzder(2,3,1)= dc_norm(1,i-1)
1426 uzder(2,1,2)= dc_norm(3,i)
1427 uzder(3,1,2)=-dc_norm(2,i)
1428 uzder(1,2,2)=-dc_norm(3,i)
1430 uzder(3,2,2)= dc_norm(1,i)
1431 uzder(1,3,2)= dc_norm(2,i)
1432 uzder(2,3,2)=-dc_norm(1,i)
1435 C Compute the Y-axis
1438 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1441 C Compute the derivatives of uy
1444 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1445 & -dc_norm(k,i)*dc_norm(j,i-1)
1446 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1448 uyder(j,j,1)=uyder(j,j,1)-costh
1449 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1454 uygrad(l,k,j,i)=uyder(l,k,j)
1455 uzgrad(l,k,j,i)=uzder(l,k,j)
1459 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1460 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1461 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1462 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1466 C Compute the Z-axis
1467 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1468 costh=dcos(pi-theta(i+2))
1469 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1474 C Compute the derivatives of uz
1476 uzder(2,1,1)=-dc_norm(3,i+1)
1477 uzder(3,1,1)= dc_norm(2,i+1)
1478 uzder(1,2,1)= dc_norm(3,i+1)
1480 uzder(3,2,1)=-dc_norm(1,i+1)
1481 uzder(1,3,1)=-dc_norm(2,i+1)
1482 uzder(2,3,1)= dc_norm(1,i+1)
1485 uzder(2,1,2)= dc_norm(3,i)
1486 uzder(3,1,2)=-dc_norm(2,i)
1487 uzder(1,2,2)=-dc_norm(3,i)
1489 uzder(3,2,2)= dc_norm(1,i)
1490 uzder(1,3,2)= dc_norm(2,i)
1491 uzder(2,3,2)=-dc_norm(1,i)
1494 C Compute the Y-axis
1497 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1500 C Compute the derivatives of uy
1503 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1504 & -dc_norm(k,i)*dc_norm(j,i+1)
1505 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1507 uyder(j,j,1)=uyder(j,j,1)-costh
1508 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1513 uygrad(l,k,j,i)=uyder(l,k,j)
1514 uzgrad(l,k,j,i)=uzder(l,k,j)
1518 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1519 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1520 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1521 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1527 vbld_inv_temp(1)=vbld_inv(i+1)
1528 if (i.lt.nres-1) then
1529 vbld_inv_temp(2)=vbld_inv(i+2)
1531 vbld_inv_temp(2)=vbld_inv(i)
1536 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1537 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1545 C-----------------------------------------------------------------------------
1546 subroutine vec_and_deriv_test
1547 implicit real*8 (a-h,o-z)
1548 include 'DIMENSIONS'
1549 include 'DIMENSIONS.ZSCOPT'
1550 include 'COMMON.IOUNITS'
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.VECTORS'
1556 dimension uyder(3,3,2),uzder(3,3,2)
1557 C Compute the local reference systems. For reference system (i), the
1558 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1559 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1561 if (i.eq.nres-1) then
1562 C Case of the last full residue
1563 C Compute the Z-axis
1564 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1565 costh=dcos(pi-theta(nres))
1566 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1567 c write (iout,*) 'fac',fac,
1568 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1569 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1573 C Compute the derivatives of uz
1575 uzder(2,1,1)=-dc_norm(3,i-1)
1576 uzder(3,1,1)= dc_norm(2,i-1)
1577 uzder(1,2,1)= dc_norm(3,i-1)
1579 uzder(3,2,1)=-dc_norm(1,i-1)
1580 uzder(1,3,1)=-dc_norm(2,i-1)
1581 uzder(2,3,1)= dc_norm(1,i-1)
1584 uzder(2,1,2)= dc_norm(3,i)
1585 uzder(3,1,2)=-dc_norm(2,i)
1586 uzder(1,2,2)=-dc_norm(3,i)
1588 uzder(3,2,2)= dc_norm(1,i)
1589 uzder(1,3,2)= dc_norm(2,i)
1590 uzder(2,3,2)=-dc_norm(1,i)
1592 C Compute the Y-axis
1594 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1597 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1598 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1599 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1601 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1604 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1605 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1608 c write (iout,*) 'facy',facy,
1609 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1610 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1612 uy(k,i)=facy*uy(k,i)
1614 C Compute the derivatives of uy
1617 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1618 & -dc_norm(k,i)*dc_norm(j,i-1)
1619 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1621 c uyder(j,j,1)=uyder(j,j,1)-costh
1622 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1623 uyder(j,j,1)=uyder(j,j,1)
1624 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1625 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1631 uygrad(l,k,j,i)=uyder(l,k,j)
1632 uzgrad(l,k,j,i)=uzder(l,k,j)
1636 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1637 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1638 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1639 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1642 C Compute the Z-axis
1643 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1644 costh=dcos(pi-theta(i+2))
1645 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1646 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1650 C Compute the derivatives of uz
1652 uzder(2,1,1)=-dc_norm(3,i+1)
1653 uzder(3,1,1)= dc_norm(2,i+1)
1654 uzder(1,2,1)= dc_norm(3,i+1)
1656 uzder(3,2,1)=-dc_norm(1,i+1)
1657 uzder(1,3,1)=-dc_norm(2,i+1)
1658 uzder(2,3,1)= dc_norm(1,i+1)
1661 uzder(2,1,2)= dc_norm(3,i)
1662 uzder(3,1,2)=-dc_norm(2,i)
1663 uzder(1,2,2)=-dc_norm(3,i)
1665 uzder(3,2,2)= dc_norm(1,i)
1666 uzder(1,3,2)= dc_norm(2,i)
1667 uzder(2,3,2)=-dc_norm(1,i)
1669 C Compute the Y-axis
1671 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1672 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1673 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1675 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1678 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1679 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1682 c write (iout,*) 'facy',facy,
1683 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1684 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1686 uy(k,i)=facy*uy(k,i)
1688 C Compute the derivatives of uy
1691 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1692 & -dc_norm(k,i)*dc_norm(j,i+1)
1693 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1695 c uyder(j,j,1)=uyder(j,j,1)-costh
1696 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1697 uyder(j,j,1)=uyder(j,j,1)
1698 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1699 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1705 uygrad(l,k,j,i)=uyder(l,k,j)
1706 uzgrad(l,k,j,i)=uzder(l,k,j)
1710 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1711 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1712 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1713 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1720 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1721 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1728 C-----------------------------------------------------------------------------
1729 subroutine check_vecgrad
1730 implicit real*8 (a-h,o-z)
1731 include 'DIMENSIONS'
1732 include 'DIMENSIONS.ZSCOPT'
1733 include 'COMMON.IOUNITS'
1734 include 'COMMON.GEO'
1735 include 'COMMON.VAR'
1736 include 'COMMON.LOCAL'
1737 include 'COMMON.CHAIN'
1738 include 'COMMON.VECTORS'
1739 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1740 dimension uyt(3,maxres),uzt(3,maxres)
1741 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1742 double precision delta /1.0d-7/
1745 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1746 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1747 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1748 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1749 cd & (dc_norm(if90,i),if90=1,3)
1750 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1751 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1752 cd write(iout,'(a)')
1758 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1759 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1772 cd write (iout,*) 'i=',i
1774 erij(k)=dc_norm(k,i)
1778 dc_norm(k,i)=erij(k)
1780 dc_norm(j,i)=dc_norm(j,i)+delta
1781 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1783 c dc_norm(k,i)=dc_norm(k,i)/fac
1785 c write (iout,*) (dc_norm(k,i),k=1,3)
1786 c write (iout,*) (erij(k),k=1,3)
1789 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1790 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1791 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1792 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1794 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1795 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1796 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1799 dc_norm(k,i)=erij(k)
1802 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1803 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1804 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1805 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1806 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1807 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1808 cd write (iout,'(a)')
1813 C--------------------------------------------------------------------------
1814 subroutine set_matrices
1815 implicit real*8 (a-h,o-z)
1816 include 'DIMENSIONS'
1817 include 'DIMENSIONS.ZSCOPT'
1818 include 'COMMON.IOUNITS'
1819 include 'COMMON.GEO'
1820 include 'COMMON.VAR'
1821 include 'COMMON.LOCAL'
1822 include 'COMMON.CHAIN'
1823 include 'COMMON.DERIV'
1824 include 'COMMON.INTERACT'
1825 include 'COMMON.CONTACTS'
1826 include 'COMMON.TORSION'
1827 include 'COMMON.VECTORS'
1828 include 'COMMON.FFIELD'
1829 double precision auxvec(2),auxmat(2,2)
1831 C Compute the virtual-bond-torsional-angle dependent quantities needed
1832 C to calculate the el-loc multibody terms of various order.
1835 if (i .lt. nres+1) then
1872 if (i .gt. 3 .and. i .lt. nres+1) then
1873 obrot_der(1,i-2)=-sin1
1874 obrot_der(2,i-2)= cos1
1875 Ugder(1,1,i-2)= sin1
1876 Ugder(1,2,i-2)=-cos1
1877 Ugder(2,1,i-2)=-cos1
1878 Ugder(2,2,i-2)=-sin1
1881 obrot2_der(1,i-2)=-dwasin2
1882 obrot2_der(2,i-2)= dwacos2
1883 Ug2der(1,1,i-2)= dwasin2
1884 Ug2der(1,2,i-2)=-dwacos2
1885 Ug2der(2,1,i-2)=-dwacos2
1886 Ug2der(2,2,i-2)=-dwasin2
1888 obrot_der(1,i-2)=0.0d0
1889 obrot_der(2,i-2)=0.0d0
1890 Ugder(1,1,i-2)=0.0d0
1891 Ugder(1,2,i-2)=0.0d0
1892 Ugder(2,1,i-2)=0.0d0
1893 Ugder(2,2,i-2)=0.0d0
1894 obrot2_der(1,i-2)=0.0d0
1895 obrot2_der(2,i-2)=0.0d0
1896 Ug2der(1,1,i-2)=0.0d0
1897 Ug2der(1,2,i-2)=0.0d0
1898 Ug2der(2,1,i-2)=0.0d0
1899 Ug2der(2,2,i-2)=0.0d0
1901 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1902 if (itype(i-2).le.ntyp) then
1903 iti = itortyp(itype(i-2))
1910 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1911 if (itype(i-1).le.ntyp) then
1912 iti1 = itortyp(itype(i-1))
1919 cd write (iout,*) '*******i',i,' iti1',iti
1920 cd write (iout,*) 'b1',b1(:,iti)
1921 cd write (iout,*) 'b2',b2(:,iti)
1922 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1923 c print *,"itilde1 i iti iti1",i,iti,iti1
1924 if (i .gt. iatel_s+2) then
1925 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1926 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1927 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1928 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1929 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1930 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1931 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1941 DtUg2(l,k,i-2)=0.0d0
1945 c print *,"itilde2 i iti iti1",i,iti,iti1
1946 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1947 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1948 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1949 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1950 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1951 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1952 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1953 c print *,"itilde3 i iti iti1",i,iti,iti1
1955 muder(k,i-2)=Ub2der(k,i-2)
1957 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1958 if (itype(i-1).le.ntyp) then
1959 iti1 = itortyp(itype(i-1))
1967 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1969 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
1971 C Vectors and matrices dependent on a single virtual-bond dihedral.
1972 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1973 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1974 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1975 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1976 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1977 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1978 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1979 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1980 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1981 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1982 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1984 C Matrices dependent on two consecutive virtual-bond dihedrals.
1985 C The order of matrices is from left to right.
1987 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1988 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1989 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1990 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1991 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1992 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1993 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1994 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1997 cd iti = itortyp(itype(i))
2000 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2001 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2006 C--------------------------------------------------------------------------
2007 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2009 C This subroutine calculates the average interaction energy and its gradient
2010 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2011 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2012 C The potential depends both on the distance of peptide-group centers and on
2013 C the orientation of the CA-CA virtual bonds.
2015 implicit real*8 (a-h,o-z)
2016 include 'DIMENSIONS'
2017 include 'DIMENSIONS.ZSCOPT'
2018 include 'COMMON.CONTROL'
2019 include 'COMMON.IOUNITS'
2020 include 'COMMON.GEO'
2021 include 'COMMON.VAR'
2022 include 'COMMON.LOCAL'
2023 include 'COMMON.CHAIN'
2024 include 'COMMON.DERIV'
2025 include 'COMMON.INTERACT'
2026 include 'COMMON.CONTACTS'
2027 include 'COMMON.TORSION'
2028 include 'COMMON.VECTORS'
2029 include 'COMMON.FFIELD'
2030 include 'COMMON.SHIELD'
2031 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2032 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2033 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2034 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2035 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2036 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2037 double precision scal_el /0.5d0/
2039 C 13-go grudnia roku pamietnego...
2040 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2041 & 0.0d0,1.0d0,0.0d0,
2042 & 0.0d0,0.0d0,1.0d0/
2043 cd write(iout,*) 'In EELEC'
2045 cd write(iout,*) 'Type',i
2046 cd write(iout,*) 'B1',B1(:,i)
2047 cd write(iout,*) 'B2',B2(:,i)
2048 cd write(iout,*) 'CC',CC(:,:,i)
2049 cd write(iout,*) 'DD',DD(:,:,i)
2050 cd write(iout,*) 'EE',EE(:,:,i)
2052 cd call check_vecgrad
2054 if (icheckgrad.eq.1) then
2056 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2058 dc_norm(k,i)=dc(k,i)*fac
2060 c write (iout,*) 'i',i,' fac',fac
2063 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2064 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2065 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2066 cd if (wel_loc.gt.0.0d0) then
2067 if (icheckgrad.eq.1) then
2068 call vec_and_deriv_test
2075 cd write (iout,*) 'i=',i
2077 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2080 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2081 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2094 C print '(a)','Enter EELEC'
2095 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2097 gel_loc_loc(i)=0.0d0
2100 do i=iatel_s,iatel_e
2102 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2103 & .or. itype(i+2).eq.ntyp1) cycle
2105 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2106 & .or. itype(i+2).eq.ntyp1
2107 & .or. itype(i-1).eq.ntyp1
2110 if (itel(i).eq.0) goto 1215
2114 dx_normi=dc_norm(1,i)
2115 dy_normi=dc_norm(2,i)
2116 dz_normi=dc_norm(3,i)
2117 xmedi=c(1,i)+0.5d0*dxi
2118 ymedi=c(2,i)+0.5d0*dyi
2119 zmedi=c(3,i)+0.5d0*dzi
2120 xmedi=mod(xmedi,boxxsize)
2121 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2122 ymedi=mod(ymedi,boxysize)
2123 if (ymedi.lt.0) ymedi=ymedi+boxysize
2124 zmedi=mod(zmedi,boxzsize)
2125 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2127 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2128 do j=ielstart(i),ielend(i)
2130 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2131 & .or.itype(j+2).eq.ntyp1
2134 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2135 & .or.itype(j+2).eq.ntyp1
2136 & .or.itype(j-1).eq.ntyp1
2141 if (itel(j).eq.0) goto 1216
2145 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2146 aaa=app(iteli,itelj)
2147 bbb=bpp(iteli,itelj)
2148 C Diagnostics only!!!
2154 ael6i=ael6(iteli,itelj)
2155 ael3i=ael3(iteli,itelj)
2159 dx_normj=dc_norm(1,j)
2160 dy_normj=dc_norm(2,j)
2161 dz_normj=dc_norm(3,j)
2166 if (xj.lt.0) xj=xj+boxxsize
2168 if (yj.lt.0) yj=yj+boxysize
2170 if (zj.lt.0) zj=zj+boxzsize
2171 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2179 xj=xj_safe+xshift*boxxsize
2180 yj=yj_safe+yshift*boxysize
2181 zj=zj_safe+zshift*boxzsize
2182 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2183 if(dist_temp.lt.dist_init) then
2193 if (isubchap.eq.1) then
2202 rij=xj*xj+yj*yj+zj*zj
2203 sss=sscale(sqrt(rij))
2204 sssgrad=sscagrad(sqrt(rij))
2210 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2211 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2212 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2213 fac=cosa-3.0D0*cosb*cosg
2215 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2216 if (j.eq.i+2) ev1=scal_el*ev1
2221 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2224 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2225 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2226 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2227 if (shield_mode.gt.0) then
2230 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2231 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2240 evdw1=evdw1+evdwij*sss
2241 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2242 c &'evdw1',i,j,evdwij
2243 c &,iteli,itelj,aaa,evdw1
2245 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2246 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2247 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2248 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2249 c & xmedi,ymedi,zmedi,xj,yj,zj
2251 C Calculate contributions to the Cartesian gradient.
2254 facvdw=-6*rrmij*(ev1+evdwij)*sss
2255 facel=-3*rrmij*(el1+eesij)
2262 * Radial derivatives. First process both termini of the fragment (i,j)
2267 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2268 & (shield_mode.gt.0)) then
2270 do ilist=1,ishield_list(i)
2271 iresshield=shield_list(ilist,i)
2273 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2275 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2277 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2278 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2279 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2280 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2281 C if (iresshield.gt.i) then
2282 C do ishi=i+1,iresshield-1
2283 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2284 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2288 C do ishi=iresshield,i
2289 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2290 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2296 do ilist=1,ishield_list(j)
2297 iresshield=shield_list(ilist,j)
2299 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2301 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2303 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2304 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2309 gshieldc(k,i)=gshieldc(k,i)+
2310 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2311 gshieldc(k,j)=gshieldc(k,j)+
2312 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2313 gshieldc(k,i-1)=gshieldc(k,i-1)+
2314 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2315 gshieldc(k,j-1)=gshieldc(k,j-1)+
2316 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2323 gelc(k,i)=gelc(k,i)+ghalf
2324 gelc(k,j)=gelc(k,j)+ghalf
2327 * Loop over residues i+1 thru j-1.
2331 gelc(l,k)=gelc(l,k)+ggg(l)
2337 if (sss.gt.0.0) then
2338 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2339 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2340 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2348 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2349 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2352 * Loop over residues i+1 thru j-1.
2356 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2360 facvdw=(ev1+evdwij)*sss
2363 fac=-3*rrmij*(facvdw+facvdw+facel)
2369 * Radial derivatives. First process both termini of the fragment (i,j)
2376 gelc(k,i)=gelc(k,i)+ghalf
2377 gelc(k,j)=gelc(k,j)+ghalf
2380 * Loop over residues i+1 thru j-1.
2384 gelc(l,k)=gelc(l,k)+ggg(l)
2391 ecosa=2.0D0*fac3*fac1+fac4
2394 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2395 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2397 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2398 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2400 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2401 cd & (dcosg(k),k=1,3)
2403 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2404 & *fac_shield(i)**2*fac_shield(j)**2
2408 gelc(k,i)=gelc(k,i)+ghalf
2409 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2410 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2411 & *fac_shield(i)**2*fac_shield(j)**2
2413 gelc(k,j)=gelc(k,j)+ghalf
2414 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2415 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2416 & *fac_shield(i)**2*fac_shield(j)**2
2420 gelc(l,k)=gelc(l,k)+ggg(l)
2425 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2426 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2427 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2429 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2430 C energy of a peptide unit is assumed in the form of a second-order
2431 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2432 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2433 C are computed for EVERY pair of non-contiguous peptide groups.
2435 if (j.lt.nres-1) then
2446 muij(kkk)=mu(k,i)*mu(l,j)
2449 cd write (iout,*) 'EELEC: i',i,' j',j
2450 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2451 cd write(iout,*) 'muij',muij
2452 ury=scalar(uy(1,i),erij)
2453 urz=scalar(uz(1,i),erij)
2454 vry=scalar(uy(1,j),erij)
2455 vrz=scalar(uz(1,j),erij)
2456 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2457 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2458 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2459 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2460 C For diagnostics only
2465 fac=dsqrt(-ael6i)*r3ij
2466 cd write (2,*) 'fac=',fac
2467 C For diagnostics only
2473 cd write (iout,'(4i5,4f10.5)')
2474 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2475 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2476 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2477 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2478 cd write (iout,'(4f10.5)')
2479 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2480 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2481 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2482 cd write (iout,'(2i3,9f10.5/)') i,j,
2483 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2485 C Derivatives of the elements of A in virtual-bond vectors
2486 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2493 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2494 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2495 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2496 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2497 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2498 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2499 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2500 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2501 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2502 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2503 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2504 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2514 C Compute radial contributions to the gradient
2536 C Add the contributions coming from er
2539 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2540 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2541 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2542 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2545 C Derivatives in DC(i)
2546 ghalf1=0.5d0*agg(k,1)
2547 ghalf2=0.5d0*agg(k,2)
2548 ghalf3=0.5d0*agg(k,3)
2549 ghalf4=0.5d0*agg(k,4)
2550 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2551 & -3.0d0*uryg(k,2)*vry)+ghalf1
2552 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2553 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2554 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2555 & -3.0d0*urzg(k,2)*vry)+ghalf3
2556 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2557 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2558 C Derivatives in DC(i+1)
2559 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2560 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2561 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2562 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2563 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2564 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2565 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2566 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2567 C Derivatives in DC(j)
2568 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2569 & -3.0d0*vryg(k,2)*ury)+ghalf1
2570 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2571 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2572 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2573 & -3.0d0*vryg(k,2)*urz)+ghalf3
2574 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2575 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2576 C Derivatives in DC(j+1) or DC(nres-1)
2577 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2578 & -3.0d0*vryg(k,3)*ury)
2579 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2580 & -3.0d0*vrzg(k,3)*ury)
2581 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2582 & -3.0d0*vryg(k,3)*urz)
2583 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2584 & -3.0d0*vrzg(k,3)*urz)
2589 C Derivatives in DC(i+1)
2590 cd aggi1(k,1)=agg(k,1)
2591 cd aggi1(k,2)=agg(k,2)
2592 cd aggi1(k,3)=agg(k,3)
2593 cd aggi1(k,4)=agg(k,4)
2594 C Derivatives in DC(j)
2599 C Derivatives in DC(j+1)
2604 if (j.eq.nres-1 .and. i.lt.j-2) then
2606 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2607 cd aggj1(k,l)=agg(k,l)
2613 C Check the loc-el terms by numerical integration
2623 aggi(k,l)=-aggi(k,l)
2624 aggi1(k,l)=-aggi1(k,l)
2625 aggj(k,l)=-aggj(k,l)
2626 aggj1(k,l)=-aggj1(k,l)
2629 if (j.lt.nres-1) then
2635 aggi(k,l)=-aggi(k,l)
2636 aggi1(k,l)=-aggi1(k,l)
2637 aggj(k,l)=-aggj(k,l)
2638 aggj1(k,l)=-aggj1(k,l)
2649 aggi(k,l)=-aggi(k,l)
2650 aggi1(k,l)=-aggi1(k,l)
2651 aggj(k,l)=-aggj(k,l)
2652 aggj1(k,l)=-aggj1(k,l)
2658 IF (wel_loc.gt.0.0d0) THEN
2659 C Contribution to the local-electrostatic energy coming from the i-j pair
2660 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2662 if (shield_mode.eq.0) then
2669 eel_loc_ij=eel_loc_ij
2670 & *fac_shield(i)*fac_shield(j)
2671 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2672 C write (iout,'(a6,2i5,0pf7.3)')
2673 C & 'eelloc',i,j,eel_loc_ij
2674 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2675 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2676 C eel_loc=eel_loc+eel_loc_ij
2677 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2678 & (shield_mode.gt.0)) then
2681 do ilist=1,ishield_list(i)
2682 iresshield=shield_list(ilist,i)
2684 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2687 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2689 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2690 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2694 do ilist=1,ishield_list(j)
2695 iresshield=shield_list(ilist,j)
2697 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2700 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2702 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2703 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2709 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2710 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2711 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2712 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2713 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2714 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2715 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2716 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2719 eel_loc=eel_loc+eel_loc_ij
2721 C Partial derivatives in virtual-bond dihedral angles gamma
2724 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2725 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2726 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2727 & *fac_shield(i)*fac_shield(j)
2729 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2730 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2731 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2732 & *fac_shield(i)*fac_shield(j)
2734 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2735 cd write(iout,*) 'agg ',agg
2736 cd write(iout,*) 'aggi ',aggi
2737 cd write(iout,*) 'aggi1',aggi1
2738 cd write(iout,*) 'aggj ',aggj
2739 cd write(iout,*) 'aggj1',aggj1
2741 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2743 ggg(l)=(agg(l,1)*muij(1)+
2744 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2745 & *fac_shield(i)*fac_shield(j)
2750 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2753 C Remaining derivatives of eello
2755 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2756 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2757 & *fac_shield(i)*fac_shield(j)
2759 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2760 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2761 & *fac_shield(i)*fac_shield(j)
2763 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2764 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2765 & *fac_shield(i)*fac_shield(j)
2767 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2768 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2769 & *fac_shield(i)*fac_shield(j)
2774 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2775 C Contributions from turns
2780 call eturn34(i,j,eello_turn3,eello_turn4)
2782 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2783 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2785 C Calculate the contact function. The ith column of the array JCONT will
2786 C contain the numbers of atoms that make contacts with the atom I (of numbers
2787 C greater than I). The arrays FACONT and GACONT will contain the values of
2788 C the contact function and its derivative.
2789 c r0ij=1.02D0*rpp(iteli,itelj)
2790 c r0ij=1.11D0*rpp(iteli,itelj)
2791 r0ij=2.20D0*rpp(iteli,itelj)
2792 c r0ij=1.55D0*rpp(iteli,itelj)
2793 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2794 if (fcont.gt.0.0D0) then
2795 num_conti=num_conti+1
2796 if (num_conti.gt.maxconts) then
2797 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2798 & ' will skip next contacts for this conf.'
2800 jcont_hb(num_conti,i)=j
2801 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2802 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2803 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2805 d_cont(num_conti,i)=rij
2806 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2807 C --- Electrostatic-interaction matrix ---
2808 a_chuj(1,1,num_conti,i)=a22
2809 a_chuj(1,2,num_conti,i)=a23
2810 a_chuj(2,1,num_conti,i)=a32
2811 a_chuj(2,2,num_conti,i)=a33
2812 C --- Gradient of rij
2814 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2817 c a_chuj(1,1,num_conti,i)=-0.61d0
2818 c a_chuj(1,2,num_conti,i)= 0.4d0
2819 c a_chuj(2,1,num_conti,i)= 0.65d0
2820 c a_chuj(2,2,num_conti,i)= 0.50d0
2821 c else if (i.eq.2) then
2822 c a_chuj(1,1,num_conti,i)= 0.0d0
2823 c a_chuj(1,2,num_conti,i)= 0.0d0
2824 c a_chuj(2,1,num_conti,i)= 0.0d0
2825 c a_chuj(2,2,num_conti,i)= 0.0d0
2827 C --- and its gradients
2828 cd write (iout,*) 'i',i,' j',j
2830 cd write (iout,*) 'iii 1 kkk',kkk
2831 cd write (iout,*) agg(kkk,:)
2834 cd write (iout,*) 'iii 2 kkk',kkk
2835 cd write (iout,*) aggi(kkk,:)
2838 cd write (iout,*) 'iii 3 kkk',kkk
2839 cd write (iout,*) aggi1(kkk,:)
2842 cd write (iout,*) 'iii 4 kkk',kkk
2843 cd write (iout,*) aggj(kkk,:)
2846 cd write (iout,*) 'iii 5 kkk',kkk
2847 cd write (iout,*) aggj1(kkk,:)
2854 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2855 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2856 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2857 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2858 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2860 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2866 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2867 C Calculate contact energies
2869 wij=cosa-3.0D0*cosb*cosg
2872 c fac3=dsqrt(-ael6i)/r0ij**3
2873 fac3=dsqrt(-ael6i)*r3ij
2874 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2875 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2877 if (shield_mode.eq.0) then
2881 ees0plist(num_conti,i)=j
2882 C fac_shield(i)=0.4d0
2883 C fac_shield(j)=0.6d0
2885 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2886 & *fac_shield(i)*fac_shield(j)
2888 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2889 & *fac_shield(i)*fac_shield(j)
2891 C Diagnostics. Comment out or remove after debugging!
2892 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2893 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2894 c ees0m(num_conti,i)=0.0D0
2896 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2897 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2898 facont_hb(num_conti,i)=fcont
2900 C Angular derivatives of the contact function
2901 ees0pij1=fac3/ees0pij
2902 ees0mij1=fac3/ees0mij
2903 fac3p=-3.0D0*fac3*rrmij
2904 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2905 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2907 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2908 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2909 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2910 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2911 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2912 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2913 ecosap=ecosa1+ecosa2
2914 ecosbp=ecosb1+ecosb2
2915 ecosgp=ecosg1+ecosg2
2916 ecosam=ecosa1-ecosa2
2917 ecosbm=ecosb1-ecosb2
2918 ecosgm=ecosg1-ecosg2
2927 fprimcont=fprimcont/rij
2928 cd facont_hb(num_conti,i)=1.0D0
2929 C Following line is for diagnostics.
2932 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2933 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2936 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2937 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2939 gggp(1)=gggp(1)+ees0pijp*xj
2940 gggp(2)=gggp(2)+ees0pijp*yj
2941 gggp(3)=gggp(3)+ees0pijp*zj
2942 gggm(1)=gggm(1)+ees0mijp*xj
2943 gggm(2)=gggm(2)+ees0mijp*yj
2944 gggm(3)=gggm(3)+ees0mijp*zj
2945 C Derivatives due to the contact function
2946 gacont_hbr(1,num_conti,i)=fprimcont*xj
2947 gacont_hbr(2,num_conti,i)=fprimcont*yj
2948 gacont_hbr(3,num_conti,i)=fprimcont*zj
2950 ghalfp=0.5D0*gggp(k)
2951 ghalfm=0.5D0*gggm(k)
2952 gacontp_hb1(k,num_conti,i)=ghalfp
2953 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2954 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2955 & *fac_shield(i)*fac_shield(j)
2957 gacontp_hb2(k,num_conti,i)=ghalfp
2958 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2959 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2960 & *fac_shield(i)*fac_shield(j)
2962 gacontp_hb3(k,num_conti,i)=gggp(k)
2963 gacontm_hb1(k,num_conti,i)=ghalfm
2964 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2965 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2966 & *fac_shield(i)*fac_shield(j)
2968 gacontm_hb2(k,num_conti,i)=ghalfm
2969 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2970 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2971 & *fac_shield(i)*fac_shield(j)
2973 gacontm_hb3(k,num_conti,i)=gggm(k)
2974 & *fac_shield(i)*fac_shield(j)
2978 C Diagnostics. Comment out or remove after debugging!
2980 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2981 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2982 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2983 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2984 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2985 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2988 endif ! num_conti.le.maxconts
2993 num_cont_hb(i)=num_conti
2997 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2998 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3000 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3001 ccc eel_loc=eel_loc+eello_turn3
3004 C-----------------------------------------------------------------------------
3005 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3006 C Third- and fourth-order contributions from turns
3007 implicit real*8 (a-h,o-z)
3008 include 'DIMENSIONS'
3009 include 'DIMENSIONS.ZSCOPT'
3010 include 'COMMON.IOUNITS'
3011 include 'COMMON.GEO'
3012 include 'COMMON.VAR'
3013 include 'COMMON.LOCAL'
3014 include 'COMMON.CHAIN'
3015 include 'COMMON.DERIV'
3016 include 'COMMON.INTERACT'
3017 include 'COMMON.CONTACTS'
3018 include 'COMMON.TORSION'
3019 include 'COMMON.VECTORS'
3020 include 'COMMON.FFIELD'
3021 include 'COMMON.SHIELD'
3022 include 'COMMON.CONTROL'
3024 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3025 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3026 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3027 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3028 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3029 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3031 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3033 C Third-order contributions
3040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3041 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3042 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3043 call transpose2(auxmat(1,1),auxmat1(1,1))
3044 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3045 if (shield_mode.eq.0) then
3053 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3054 & *fac_shield(i)*fac_shield(j)
3055 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3056 & *fac_shield(i)*fac_shield(j)
3058 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3059 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3060 cd & ' eello_turn3_num',4*eello_turn3_num
3062 C Derivatives in shield mode
3063 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3064 & (shield_mode.gt.0)) then
3067 do ilist=1,ishield_list(i)
3068 iresshield=shield_list(ilist,i)
3070 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3072 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3074 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3075 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3079 do ilist=1,ishield_list(j)
3080 iresshield=shield_list(ilist,j)
3082 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3084 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3086 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3087 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3094 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3095 & grad_shield(k,i)*eello_t3/fac_shield(i)
3096 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3097 & grad_shield(k,j)*eello_t3/fac_shield(j)
3098 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3099 & grad_shield(k,i)*eello_t3/fac_shield(i)
3100 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3101 & grad_shield(k,j)*eello_t3/fac_shield(j)
3105 C Derivatives in gamma(i)
3106 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3107 call transpose2(auxmat2(1,1),pizda(1,1))
3108 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3109 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3110 C Derivatives in gamma(i+1)
3111 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3112 call transpose2(auxmat2(1,1),pizda(1,1))
3113 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3114 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3115 & +0.5d0*(pizda(1,1)+pizda(2,2))
3116 & *fac_shield(i)*fac_shield(j)
3118 C Cartesian derivatives
3120 a_temp(1,1)=aggi(l,1)
3121 a_temp(1,2)=aggi(l,2)
3122 a_temp(2,1)=aggi(l,3)
3123 a_temp(2,2)=aggi(l,4)
3124 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3125 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3126 & +0.5d0*(pizda(1,1)+pizda(2,2))
3127 & *fac_shield(i)*fac_shield(j)
3129 a_temp(1,1)=aggi1(l,1)
3130 a_temp(1,2)=aggi1(l,2)
3131 a_temp(2,1)=aggi1(l,3)
3132 a_temp(2,2)=aggi1(l,4)
3133 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3134 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3135 & +0.5d0*(pizda(1,1)+pizda(2,2))
3136 & *fac_shield(i)*fac_shield(j)
3138 a_temp(1,1)=aggj(l,1)
3139 a_temp(1,2)=aggj(l,2)
3140 a_temp(2,1)=aggj(l,3)
3141 a_temp(2,2)=aggj(l,4)
3142 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3143 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3144 & +0.5d0*(pizda(1,1)+pizda(2,2))
3145 & *fac_shield(i)*fac_shield(j)
3147 a_temp(1,1)=aggj1(l,1)
3148 a_temp(1,2)=aggj1(l,2)
3149 a_temp(2,1)=aggj1(l,3)
3150 a_temp(2,2)=aggj1(l,4)
3151 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3152 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3153 & +0.5d0*(pizda(1,1)+pizda(2,2))
3154 & *fac_shield(i)*fac_shield(j)
3158 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3159 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3160 C changes suggested by Ana to avoid out of bounds
3161 & .or.((i+5).gt.nres)
3163 C end of changes suggested by Ana
3164 & .or. itype(i+3).eq.ntyp1
3165 & .or. itype(i+4).eq.ntyp1
3166 & .or. itype(i+5).eq.ntyp1
3167 & .or. itype(i).eq.ntyp1
3168 & .or. itype(i-1).eq.ntyp1) goto 178
3169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3171 C Fourth-order contributions
3179 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3180 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3181 iti1=itortyp(itype(i+1))
3182 iti2=itortyp(itype(i+2))
3183 iti3=itortyp(itype(i+3))
3184 call transpose2(EUg(1,1,i+1),e1t(1,1))
3185 call transpose2(Eug(1,1,i+2),e2t(1,1))
3186 call transpose2(Eug(1,1,i+3),e3t(1,1))
3187 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3188 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3189 s1=scalar2(b1(1,iti2),auxvec(1))
3190 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3191 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3192 s2=scalar2(b1(1,iti1),auxvec(1))
3193 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3194 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3195 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3196 if (shield_mode.eq.0) then
3204 eello_turn4=eello_turn4-(s1+s2+s3)
3205 & *fac_shield(i)*fac_shield(j)
3206 eello_t4=-(s1+s2+s3)
3207 & *fac_shield(i)*fac_shield(j)
3209 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3210 cd & ' eello_turn4_num',8*eello_turn4_num
3211 C Derivatives in gamma(i)
3213 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3214 & (shield_mode.gt.0)) then
3217 do ilist=1,ishield_list(i)
3218 iresshield=shield_list(ilist,i)
3220 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3222 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3224 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3225 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3229 do ilist=1,ishield_list(j)
3230 iresshield=shield_list(ilist,j)
3232 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3234 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3236 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3237 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3244 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3245 & grad_shield(k,i)*eello_t4/fac_shield(i)
3246 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3247 & grad_shield(k,j)*eello_t4/fac_shield(j)
3248 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3249 & grad_shield(k,i)*eello_t4/fac_shield(i)
3250 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3251 & grad_shield(k,j)*eello_t4/fac_shield(j)
3254 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3255 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3256 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3257 s1=scalar2(b1(1,iti2),auxvec(1))
3258 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3259 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3260 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3261 & *fac_shield(i)*fac_shield(j)
3263 C Derivatives in gamma(i+1)
3264 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3265 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3266 s2=scalar2(b1(1,iti1),auxvec(1))
3267 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3268 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3269 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3270 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3271 & *fac_shield(i)*fac_shield(j)
3273 C Derivatives in gamma(i+2)
3274 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3275 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3276 s1=scalar2(b1(1,iti2),auxvec(1))
3277 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3278 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3279 s2=scalar2(b1(1,iti1),auxvec(1))
3280 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3281 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3282 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3283 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3284 & *fac_shield(i)*fac_shield(j)
3286 C Cartesian derivatives
3288 C Derivatives of this turn contributions in DC(i+2)
3289 if (j.lt.nres-1) then
3291 a_temp(1,1)=agg(l,1)
3292 a_temp(1,2)=agg(l,2)
3293 a_temp(2,1)=agg(l,3)
3294 a_temp(2,2)=agg(l,4)
3295 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3296 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3297 s1=scalar2(b1(1,iti2),auxvec(1))
3298 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3299 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3300 s2=scalar2(b1(1,iti1),auxvec(1))
3301 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3302 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3303 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3305 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3306 & *fac_shield(i)*fac_shield(j)
3310 C Remaining derivatives of this turn contribution
3312 a_temp(1,1)=aggi(l,1)
3313 a_temp(1,2)=aggi(l,2)
3314 a_temp(2,1)=aggi(l,3)
3315 a_temp(2,2)=aggi(l,4)
3316 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3317 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3318 s1=scalar2(b1(1,iti2),auxvec(1))
3319 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3320 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3321 s2=scalar2(b1(1,iti1),auxvec(1))
3322 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3323 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3324 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3325 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3326 & *fac_shield(i)*fac_shield(j)
3328 a_temp(1,1)=aggi1(l,1)
3329 a_temp(1,2)=aggi1(l,2)
3330 a_temp(2,1)=aggi1(l,3)
3331 a_temp(2,2)=aggi1(l,4)
3332 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3333 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3334 s1=scalar2(b1(1,iti2),auxvec(1))
3335 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3336 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3337 s2=scalar2(b1(1,iti1),auxvec(1))
3338 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3339 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3340 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3341 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3342 & *fac_shield(i)*fac_shield(j)
3344 a_temp(1,1)=aggj(l,1)
3345 a_temp(1,2)=aggj(l,2)
3346 a_temp(2,1)=aggj(l,3)
3347 a_temp(2,2)=aggj(l,4)
3348 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3349 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3350 s1=scalar2(b1(1,iti2),auxvec(1))
3351 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3352 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3353 s2=scalar2(b1(1,iti1),auxvec(1))
3354 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3355 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3356 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3357 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3358 & *fac_shield(i)*fac_shield(j)
3360 a_temp(1,1)=aggj1(l,1)
3361 a_temp(1,2)=aggj1(l,2)
3362 a_temp(2,1)=aggj1(l,3)
3363 a_temp(2,2)=aggj1(l,4)
3364 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3365 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3366 s1=scalar2(b1(1,iti2),auxvec(1))
3367 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3368 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3369 s2=scalar2(b1(1,iti1),auxvec(1))
3370 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3371 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3372 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3373 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3374 & *fac_shield(i)*fac_shield(j)
3382 C-----------------------------------------------------------------------------
3383 subroutine vecpr(u,v,w)
3384 implicit real*8(a-h,o-z)
3385 dimension u(3),v(3),w(3)
3386 w(1)=u(2)*v(3)-u(3)*v(2)
3387 w(2)=-u(1)*v(3)+u(3)*v(1)
3388 w(3)=u(1)*v(2)-u(2)*v(1)
3391 C-----------------------------------------------------------------------------
3392 subroutine unormderiv(u,ugrad,unorm,ungrad)
3393 C This subroutine computes the derivatives of a normalized vector u, given
3394 C the derivatives computed without normalization conditions, ugrad. Returns
3397 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3398 double precision vec(3)
3399 double precision scalar
3401 c write (2,*) 'ugrad',ugrad
3404 vec(i)=scalar(ugrad(1,i),u(1))
3406 c write (2,*) 'vec',vec
3409 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3412 c write (2,*) 'ungrad',ungrad
3415 C-----------------------------------------------------------------------------
3416 subroutine escp(evdw2,evdw2_14)
3418 C This subroutine calculates the excluded-volume interaction energy between
3419 C peptide-group centers and side chains and its gradient in virtual-bond and
3420 C side-chain vectors.
3422 implicit real*8 (a-h,o-z)
3423 include 'DIMENSIONS'
3424 include 'DIMENSIONS.ZSCOPT'
3425 include 'COMMON.GEO'
3426 include 'COMMON.VAR'
3427 include 'COMMON.LOCAL'
3428 include 'COMMON.CHAIN'
3429 include 'COMMON.DERIV'
3430 include 'COMMON.INTERACT'
3431 include 'COMMON.FFIELD'
3432 include 'COMMON.IOUNITS'
3436 cd print '(a)','Enter ESCP'
3437 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3438 c & ' scal14',scal14
3439 do i=iatscp_s,iatscp_e
3440 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3442 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3443 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3444 if (iteli.eq.0) goto 1225
3445 xi=0.5D0*(c(1,i)+c(1,i+1))
3446 yi=0.5D0*(c(2,i)+c(2,i+1))
3447 zi=0.5D0*(c(3,i)+c(3,i+1))
3448 C Returning the ith atom to box
3450 if (xi.lt.0) xi=xi+boxxsize
3452 if (yi.lt.0) yi=yi+boxysize
3454 if (zi.lt.0) zi=zi+boxzsize
3455 do iint=1,nscp_gr(i)
3457 do j=iscpstart(i,iint),iscpend(i,iint)
3458 itypj=iabs(itype(j))
3459 if (itypj.eq.ntyp1) cycle
3460 C Uncomment following three lines for SC-p interactions
3464 C Uncomment following three lines for Ca-p interactions
3468 C returning the jth atom to box
3470 if (xj.lt.0) xj=xj+boxxsize
3472 if (yj.lt.0) yj=yj+boxysize
3474 if (zj.lt.0) zj=zj+boxzsize
3475 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3480 C Finding the closest jth atom
3484 xj=xj_safe+xshift*boxxsize
3485 yj=yj_safe+yshift*boxysize
3486 zj=zj_safe+zshift*boxzsize
3487 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3488 if(dist_temp.lt.dist_init) then
3498 if (subchap.eq.1) then
3507 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3508 C sss is scaling function for smoothing the cutoff gradient otherwise
3509 C the gradient would not be continuouse
3510 sss=sscale(1.0d0/(dsqrt(rrij)))
3511 if (sss.le.0.0d0) cycle
3512 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3514 e1=fac*fac*aad(itypj,iteli)
3515 e2=fac*bad(itypj,iteli)
3516 if (iabs(j-i) .le. 2) then
3519 evdw2_14=evdw2_14+(e1+e2)*sss
3522 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3523 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3524 c & bad(itypj,iteli)
3525 evdw2=evdw2+evdwij*sss
3528 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3530 fac=-(evdwij+e1)*rrij*sss
3531 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3536 cd write (iout,*) 'j<i'
3537 C Uncomment following three lines for SC-p interactions
3539 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3542 cd write (iout,*) 'j>i'
3545 C Uncomment following line for SC-p interactions
3546 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3550 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3554 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3555 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3558 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3568 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3569 gradx_scp(j,i)=expon*gradx_scp(j,i)
3572 C******************************************************************************
3576 C To save time the factor EXPON has been extracted from ALL components
3577 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3580 C******************************************************************************
3583 C--------------------------------------------------------------------------
3584 subroutine edis(ehpb)
3586 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3588 implicit real*8 (a-h,o-z)
3589 include 'DIMENSIONS'
3590 include 'DIMENSIONS.ZSCOPT'
3591 include 'COMMON.SBRIDGE'
3592 include 'COMMON.CHAIN'
3593 include 'COMMON.DERIV'
3594 include 'COMMON.VAR'
3595 include 'COMMON.INTERACT'
3596 include 'COMMON.CONTROL'
3597 include 'COMMON.IOUNITS'
3600 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3601 cd print *,'link_start=',link_start,' link_end=',link_end
3602 C write(iout,*) link_end, "link_end"
3603 if (link_end.eq.0) return
3604 do i=link_start,link_end
3605 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3606 C CA-CA distance used in regularization of structure.
3609 C iii and jjj point to the residues for which the distance is assigned.
3610 if (ii.gt.nres) then
3617 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3618 C distance and angle dependent SS bond potential.
3619 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3620 C & iabs(itype(jjj)).eq.1) then
3621 C write(iout,*) constr_dist,"const"
3622 if (.not.dyn_ss .and. i.le.nss) then
3623 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3624 & iabs(itype(jjj)).eq.1) then
3625 call ssbond_ene(iii,jjj,eij)
3628 else if (ii.gt.nres .and. jj.gt.nres) then
3629 c Restraints from contact prediction
3631 if (constr_dist.eq.11) then
3632 C ehpb=ehpb+fordepth(i)**4.0d0
3633 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3634 ehpb=ehpb+fordepth(i)**4.0d0
3635 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3636 fac=fordepth(i)**4.0d0
3637 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3638 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3639 C & ehpb,fordepth(i),dd
3640 C write(iout,*) ehpb,"atu?"
3642 C fac=fordepth(i)**4.0d0
3643 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3645 if (dhpb1(i).gt.0.0d0) then
3646 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3647 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3648 c write (iout,*) "beta nmr",
3649 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3653 C Get the force constant corresponding to this distance.
3655 C Calculate the contribution to energy.
3656 ehpb=ehpb+waga*rdis*rdis
3657 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3659 C Evaluate gradient.
3662 endif !end dhpb1(i).gt.0
3663 endif !end const_dist=11
3665 ggg(j)=fac*(c(j,jj)-c(j,ii))
3668 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3669 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3672 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3673 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3676 C write(iout,*) "before"
3678 C write(iout,*) "after",dd
3679 if (constr_dist.eq.11) then
3680 ehpb=ehpb+fordepth(i)**4.0d0
3681 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3682 fac=fordepth(i)**4.0d0
3683 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3684 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3685 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3686 C print *,ehpb,"tu?"
3687 C write(iout,*) ehpb,"btu?",
3688 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3689 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3690 C & ehpb,fordepth(i),dd
3692 if (dhpb1(i).gt.0.0d0) then
3693 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3694 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3695 c write (iout,*) "alph nmr",
3696 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3699 C Get the force constant corresponding to this distance.
3701 C Calculate the contribution to energy.
3702 ehpb=ehpb+waga*rdis*rdis
3703 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3705 C Evaluate gradient.
3712 ggg(j)=fac*(c(j,jj)-c(j,ii))
3714 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3715 C If this is a SC-SC distance, we need to calculate the contributions to the
3716 C Cartesian gradient in the SC vectors (ghpbx).
3719 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3720 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3725 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3730 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3733 C--------------------------------------------------------------------------
3734 subroutine ssbond_ene(i,j,eij)
3736 C Calculate the distance and angle dependent SS-bond potential energy
3737 C using a free-energy function derived based on RHF/6-31G** ab initio
3738 C calculations of diethyl disulfide.
3740 C A. Liwo and U. Kozlowska, 11/24/03
3742 implicit real*8 (a-h,o-z)
3743 include 'DIMENSIONS'
3744 include 'DIMENSIONS.ZSCOPT'
3745 include 'COMMON.SBRIDGE'
3746 include 'COMMON.CHAIN'
3747 include 'COMMON.DERIV'
3748 include 'COMMON.LOCAL'
3749 include 'COMMON.INTERACT'
3750 include 'COMMON.VAR'
3751 include 'COMMON.IOUNITS'
3752 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3753 itypi=iabs(itype(i))
3757 dxi=dc_norm(1,nres+i)
3758 dyi=dc_norm(2,nres+i)
3759 dzi=dc_norm(3,nres+i)
3760 dsci_inv=dsc_inv(itypi)
3761 itypj=iabs(itype(j))
3762 dscj_inv=dsc_inv(itypj)
3766 dxj=dc_norm(1,nres+j)
3767 dyj=dc_norm(2,nres+j)
3768 dzj=dc_norm(3,nres+j)
3769 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3774 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3775 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3776 om12=dxi*dxj+dyi*dyj+dzi*dzj
3778 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3779 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3785 deltat12=om2-om1+2.0d0
3787 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3788 & +akct*deltad*deltat12
3789 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3790 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3791 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3792 c & " deltat12",deltat12," eij",eij
3793 ed=2*akcm*deltad+akct*deltat12
3795 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3796 eom1=-2*akth*deltat1-pom1-om2*pom2
3797 eom2= 2*akth*deltat2+pom1-om1*pom2
3800 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3803 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3804 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3805 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3806 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3809 C Calculate the components of the gradient in DC and X
3813 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3818 C--------------------------------------------------------------------------
3819 subroutine ebond(estr)
3821 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3823 implicit real*8 (a-h,o-z)
3824 include 'DIMENSIONS'
3825 include 'DIMENSIONS.ZSCOPT'
3826 include 'COMMON.LOCAL'
3827 include 'COMMON.GEO'
3828 include 'COMMON.INTERACT'
3829 include 'COMMON.DERIV'
3830 include 'COMMON.VAR'
3831 include 'COMMON.CHAIN'
3832 include 'COMMON.IOUNITS'
3833 include 'COMMON.NAMES'
3834 include 'COMMON.FFIELD'
3835 include 'COMMON.CONTROL'
3836 logical energy_dec /.false./
3837 double precision u(3),ud(3)
3840 c write (iout,*) "distchainmax",distchainmax
3842 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3843 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3845 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3846 C & *dc(j,i-1)/vbld(i)
3848 C if (energy_dec) write(iout,*)
3849 C & "estr1",i,vbld(i),distchainmax,
3850 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3852 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3853 diff = vbld(i)-vbldpDUM
3855 diff = vbld(i)-vbldp0
3856 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3860 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3863 C write (iout,'(a7,i5,4f7.3)')
3864 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3866 estr=0.5d0*AKP*estr+estr1
3868 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3872 if (iti.ne.10 .and. iti.ne.ntyp1) then
3875 diff=vbld(i+nres)-vbldsc0(1,iti)
3876 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3877 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3878 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3880 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3884 diff=vbld(i+nres)-vbldsc0(j,iti)
3885 ud(j)=aksc(j,iti)*diff
3886 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3900 uprod2=uprod2*u(k)*u(k)
3904 usumsqder=usumsqder+ud(j)*uprod2
3906 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3907 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3908 estr=estr+uprod/usum
3910 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3918 C--------------------------------------------------------------------------
3919 subroutine ebend(etheta,ethetacnstr)
3921 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3922 C angles gamma and its derivatives in consecutive thetas and gammas.
3924 implicit real*8 (a-h,o-z)
3925 include 'DIMENSIONS'
3926 include 'DIMENSIONS.ZSCOPT'
3927 include 'COMMON.LOCAL'
3928 include 'COMMON.GEO'
3929 include 'COMMON.INTERACT'
3930 include 'COMMON.DERIV'
3931 include 'COMMON.VAR'
3932 include 'COMMON.CHAIN'
3933 include 'COMMON.IOUNITS'
3934 include 'COMMON.NAMES'
3935 include 'COMMON.FFIELD'
3936 include 'COMMON.TORCNSTR'
3937 common /calcthet/ term1,term2,termm,diffak,ratak,
3938 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3939 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3940 double precision y(2),z(2)
3942 c time11=dexp(-2*time)
3945 c write (iout,*) "nres",nres
3946 c write (*,'(a,i2)') 'EBEND ICG=',icg
3947 c write (iout,*) ithet_start,ithet_end
3948 do i=ithet_start,ithet_end
3949 C if (itype(i-1).eq.ntyp1) cycle
3951 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3952 & .or.itype(i).eq.ntyp1) cycle
3953 C Zero the energy function and its derivative at 0 or pi.
3954 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3956 ichir1=isign(1,itype(i-2))
3957 ichir2=isign(1,itype(i))
3958 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3959 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3960 if (itype(i-1).eq.10) then
3961 itype1=isign(10,itype(i-2))
3962 ichir11=isign(1,itype(i-2))
3963 ichir12=isign(1,itype(i-2))
3964 itype2=isign(10,itype(i))
3965 ichir21=isign(1,itype(i))
3966 ichir22=isign(1,itype(i))
3973 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3977 c call proc_proc(phii,icrc)
3978 if (icrc.eq.1) phii=150.0
3989 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3993 c call proc_proc(phii1,icrc)
3994 if (icrc.eq.1) phii1=150.0
4006 C Calculate the "mean" value of theta from the part of the distribution
4007 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4008 C In following comments this theta will be referred to as t_c.
4009 thet_pred_mean=0.0d0
4011 athetk=athet(k,it,ichir1,ichir2)
4012 bthetk=bthet(k,it,ichir1,ichir2)
4014 athetk=athet(k,itype1,ichir11,ichir12)
4015 bthetk=bthet(k,itype2,ichir21,ichir22)
4017 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4019 c write (iout,*) "thet_pred_mean",thet_pred_mean
4020 dthett=thet_pred_mean*ssd
4021 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4022 c write (iout,*) "thet_pred_mean",thet_pred_mean
4023 C Derivatives of the "mean" values in gamma1 and gamma2.
4024 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4025 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4026 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4027 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4029 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4030 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4031 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4032 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4034 if (theta(i).gt.pi-delta) then
4035 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4037 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4038 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4039 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4041 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4043 else if (theta(i).lt.delta) then
4044 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4045 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4046 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4048 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4049 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4052 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4055 etheta=etheta+ethetai
4056 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4057 c & 'ebend',i,ethetai,theta(i),itype(i)
4058 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4059 c & rad2deg*phii,rad2deg*phii1,ethetai
4060 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4061 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4062 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4066 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4067 do i=1,ntheta_constr
4068 itheta=itheta_constr(i)
4069 thetiii=theta(itheta)
4070 difi=pinorm(thetiii-theta_constr0(i))
4071 if (difi.gt.theta_drange(i)) then
4072 difi=difi-theta_drange(i)
4073 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4074 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4075 & +for_thet_constr(i)*difi**3
4076 else if (difi.lt.-drange(i)) then
4078 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4079 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4080 & +for_thet_constr(i)*difi**3
4084 C if (energy_dec) then
4085 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4086 C & i,itheta,rad2deg*thetiii,
4087 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4088 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4089 C & gloc(itheta+nphi-2,icg)
4092 C Ufff.... We've done all this!!!
4095 C---------------------------------------------------------------------------
4096 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4098 implicit real*8 (a-h,o-z)
4099 include 'DIMENSIONS'
4100 include 'COMMON.LOCAL'
4101 include 'COMMON.IOUNITS'
4102 common /calcthet/ term1,term2,termm,diffak,ratak,
4103 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4104 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4105 C Calculate the contributions to both Gaussian lobes.
4106 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4107 C The "polynomial part" of the "standard deviation" of this part of
4111 sig=sig*thet_pred_mean+polthet(j,it)
4113 C Derivative of the "interior part" of the "standard deviation of the"
4114 C gamma-dependent Gaussian lobe in t_c.
4115 sigtc=3*polthet(3,it)
4117 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4120 C Set the parameters of both Gaussian lobes of the distribution.
4121 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4122 fac=sig*sig+sigc0(it)
4125 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4126 sigsqtc=-4.0D0*sigcsq*sigtc
4127 c print *,i,sig,sigtc,sigsqtc
4128 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4129 sigtc=-sigtc/(fac*fac)
4130 C Following variable is sigma(t_c)**(-2)
4131 sigcsq=sigcsq*sigcsq
4133 sig0inv=1.0D0/sig0i**2
4134 delthec=thetai-thet_pred_mean
4135 delthe0=thetai-theta0i
4136 term1=-0.5D0*sigcsq*delthec*delthec
4137 term2=-0.5D0*sig0inv*delthe0*delthe0
4138 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4139 C NaNs in taking the logarithm. We extract the largest exponent which is added
4140 C to the energy (this being the log of the distribution) at the end of energy
4141 C term evaluation for this virtual-bond angle.
4142 if (term1.gt.term2) then
4144 term2=dexp(term2-termm)
4148 term1=dexp(term1-termm)
4151 C The ratio between the gamma-independent and gamma-dependent lobes of
4152 C the distribution is a Gaussian function of thet_pred_mean too.
4153 diffak=gthet(2,it)-thet_pred_mean
4154 ratak=diffak/gthet(3,it)**2
4155 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4156 C Let's differentiate it in thet_pred_mean NOW.
4158 C Now put together the distribution terms to make complete distribution.
4159 termexp=term1+ak*term2
4160 termpre=sigc+ak*sig0i
4161 C Contribution of the bending energy from this theta is just the -log of
4162 C the sum of the contributions from the two lobes and the pre-exponential
4163 C factor. Simple enough, isn't it?
4164 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4165 C NOW the derivatives!!!
4166 C 6/6/97 Take into account the deformation.
4167 E_theta=(delthec*sigcsq*term1
4168 & +ak*delthe0*sig0inv*term2)/termexp
4169 E_tc=((sigtc+aktc*sig0i)/termpre
4170 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4171 & aktc*term2)/termexp)
4174 c-----------------------------------------------------------------------------
4175 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4176 implicit real*8 (a-h,o-z)
4177 include 'DIMENSIONS'
4178 include 'COMMON.LOCAL'
4179 include 'COMMON.IOUNITS'
4180 common /calcthet/ term1,term2,termm,diffak,ratak,
4181 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4182 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4183 delthec=thetai-thet_pred_mean
4184 delthe0=thetai-theta0i
4185 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4186 t3 = thetai-thet_pred_mean
4190 t14 = t12+t6*sigsqtc
4192 t21 = thetai-theta0i
4198 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4199 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4200 & *(-t12*t9-ak*sig0inv*t27)
4204 C--------------------------------------------------------------------------
4205 subroutine ebend(etheta,ethetacnstr)
4207 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4208 C angles gamma and its derivatives in consecutive thetas and gammas.
4209 C ab initio-derived potentials from
4210 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4212 implicit real*8 (a-h,o-z)
4213 include 'DIMENSIONS'
4214 include 'DIMENSIONS.ZSCOPT'
4215 include 'COMMON.LOCAL'
4216 include 'COMMON.GEO'
4217 include 'COMMON.INTERACT'
4218 include 'COMMON.DERIV'
4219 include 'COMMON.VAR'
4220 include 'COMMON.CHAIN'
4221 include 'COMMON.IOUNITS'
4222 include 'COMMON.NAMES'
4223 include 'COMMON.FFIELD'
4224 include 'COMMON.CONTROL'
4225 include 'COMMON.TORCNSTR'
4226 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4227 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4228 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4229 & sinph1ph2(maxdouble,maxdouble)
4230 logical lprn /.false./, lprn1 /.false./
4232 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4233 do i=ithet_start,ithet_end
4235 C if (itype(i-1).eq.ntyp1) cycle
4237 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4238 & .or.itype(i).eq.ntyp1) cycle
4239 if (iabs(itype(i+1)).eq.20) iblock=2
4240 if (iabs(itype(i+1)).ne.20) iblock=1
4244 theti2=0.5d0*theta(i)
4245 ityp2=ithetyp((itype(i-1)))
4247 coskt(k)=dcos(k*theti2)
4248 sinkt(k)=dsin(k*theti2)
4258 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4261 if (phii.ne.phii) phii=150.0
4265 ityp1=ithetyp((itype(i-2)))
4267 cosph1(k)=dcos(k*phii)
4268 sinph1(k)=dsin(k*phii)
4274 ityp1=ithetyp((itype(i-2)))
4280 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4283 if (phii1.ne.phii1) phii1=150.0
4288 ityp3=ithetyp((itype(i)))
4290 cosph2(k)=dcos(k*phii1)
4291 sinph2(k)=dsin(k*phii1)
4296 ityp3=ithetyp((itype(i)))
4302 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4303 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4305 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4308 ccl=cosph1(l)*cosph2(k-l)
4309 ssl=sinph1(l)*sinph2(k-l)
4310 scl=sinph1(l)*cosph2(k-l)
4311 csl=cosph1(l)*sinph2(k-l)
4312 cosph1ph2(l,k)=ccl-ssl
4313 cosph1ph2(k,l)=ccl+ssl
4314 sinph1ph2(l,k)=scl+csl
4315 sinph1ph2(k,l)=scl-csl
4319 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4320 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4321 write (iout,*) "coskt and sinkt"
4323 write (iout,*) k,coskt(k),sinkt(k)
4327 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4328 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4331 & write (iout,*) "k",k,"
4332 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4333 & " ethetai",ethetai
4336 write (iout,*) "cosph and sinph"
4338 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4340 write (iout,*) "cosph1ph2 and sinph2ph2"
4343 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4344 & sinph1ph2(l,k),sinph1ph2(k,l)
4347 write(iout,*) "ethetai",ethetai
4351 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4352 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4353 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4354 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4355 ethetai=ethetai+sinkt(m)*aux
4356 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4357 dephii=dephii+k*sinkt(m)*(
4358 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4359 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4360 dephii1=dephii1+k*sinkt(m)*(
4361 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4362 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4364 & write (iout,*) "m",m," k",k," bbthet",
4365 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4366 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4367 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4368 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4372 & write(iout,*) "ethetai",ethetai
4376 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4377 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4378 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4379 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4380 ethetai=ethetai+sinkt(m)*aux
4381 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4382 dephii=dephii+l*sinkt(m)*(
4383 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4384 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4385 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4386 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4387 dephii1=dephii1+(k-l)*sinkt(m)*(
4388 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4389 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4390 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4391 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4393 write (iout,*) "m",m," k",k," l",l," ffthet",
4394 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4395 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4396 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4397 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4398 & " ethetai",ethetai
4399 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4400 & cosph1ph2(k,l)*sinkt(m),
4401 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4407 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4408 & i,theta(i)*rad2deg,phii*rad2deg,
4409 & phii1*rad2deg,ethetai
4410 etheta=etheta+ethetai
4411 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4412 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4413 c gloc(nphi+i-2,icg)=wang*dethetai
4414 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4418 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4419 do i=1,ntheta_constr
4420 itheta=itheta_constr(i)
4421 thetiii=theta(itheta)
4422 difi=pinorm(thetiii-theta_constr0(i))
4423 if (difi.gt.theta_drange(i)) then
4424 difi=difi-theta_drange(i)
4425 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4426 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4427 & +for_thet_constr(i)*difi**3
4428 else if (difi.lt.-drange(i)) then
4430 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4431 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4432 & +for_thet_constr(i)*difi**3
4436 C if (energy_dec) then
4437 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4438 C & i,itheta,rad2deg*thetiii,
4439 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4440 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4441 C & gloc(itheta+nphi-2,icg)
4448 c-----------------------------------------------------------------------------
4449 subroutine esc(escloc)
4450 C Calculate the local energy of a side chain and its derivatives in the
4451 C corresponding virtual-bond valence angles THETA and the spherical angles
4453 implicit real*8 (a-h,o-z)
4454 include 'DIMENSIONS'
4455 include 'DIMENSIONS.ZSCOPT'
4456 include 'COMMON.GEO'
4457 include 'COMMON.LOCAL'
4458 include 'COMMON.VAR'
4459 include 'COMMON.INTERACT'
4460 include 'COMMON.DERIV'
4461 include 'COMMON.CHAIN'
4462 include 'COMMON.IOUNITS'
4463 include 'COMMON.NAMES'
4464 include 'COMMON.FFIELD'
4465 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4466 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4467 common /sccalc/ time11,time12,time112,theti,it,nlobit
4470 C write (iout,*) 'ESC'
4471 do i=loc_start,loc_end
4473 if (it.eq.ntyp1) cycle
4474 if (it.eq.10) goto 1
4475 nlobit=nlob(iabs(it))
4476 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4477 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4478 theti=theta(i+1)-pipol
4482 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4484 if (x(2).gt.pi-delta) then
4488 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4490 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4491 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4493 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4494 & ddersc0(1),dersc(1))
4495 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4496 & ddersc0(3),dersc(3))
4498 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4500 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4501 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4502 & dersc0(2),esclocbi,dersc02)
4503 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4505 call splinthet(x(2),0.5d0*delta,ss,ssd)
4510 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4512 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4513 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4515 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4517 c write (iout,*) escloci
4518 else if (x(2).lt.delta) then
4522 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4524 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4525 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4527 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4528 & ddersc0(1),dersc(1))
4529 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4530 & ddersc0(3),dersc(3))
4532 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4534 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4535 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4536 & dersc0(2),esclocbi,dersc02)
4537 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4542 call splinthet(x(2),0.5d0*delta,ss,ssd)
4544 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4546 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4547 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4549 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4550 C write (iout,*) 'i=',i, escloci
4552 call enesc(x,escloci,dersc,ddummy,.false.)
4555 escloc=escloc+escloci
4556 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4557 write (iout,'(a6,i5,0pf7.3)')
4558 & 'escloc',i,escloci
4560 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4562 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4563 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4568 C---------------------------------------------------------------------------
4569 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4570 implicit real*8 (a-h,o-z)
4571 include 'DIMENSIONS'
4572 include 'COMMON.GEO'
4573 include 'COMMON.LOCAL'
4574 include 'COMMON.IOUNITS'
4575 common /sccalc/ time11,time12,time112,theti,it,nlobit
4576 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4577 double precision contr(maxlob,-1:1)
4579 c write (iout,*) 'it=',it,' nlobit=',nlobit
4583 if (mixed) ddersc(j)=0.0d0
4587 C Because of periodicity of the dependence of the SC energy in omega we have
4588 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4589 C To avoid underflows, first compute & store the exponents.
4597 z(k)=x(k)-censc(k,j,it)
4602 Axk=Axk+gaussc(l,k,j,it)*z(l)
4608 expfac=expfac+Ax(k,j,iii)*z(k)
4616 C As in the case of ebend, we want to avoid underflows in exponentiation and
4617 C subsequent NaNs and INFs in energy calculation.
4618 C Find the largest exponent
4622 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4626 cd print *,'it=',it,' emin=',emin
4628 C Compute the contribution to SC energy and derivatives
4632 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4633 cd print *,'j=',j,' expfac=',expfac
4634 escloc_i=escloc_i+expfac
4636 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4640 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4641 & +gaussc(k,2,j,it))*expfac
4648 dersc(1)=dersc(1)/cos(theti)**2
4649 ddersc(1)=ddersc(1)/cos(theti)**2
4652 escloci=-(dlog(escloc_i)-emin)
4654 dersc(j)=dersc(j)/escloc_i
4658 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4663 C------------------------------------------------------------------------------
4664 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4665 implicit real*8 (a-h,o-z)
4666 include 'DIMENSIONS'
4667 include 'COMMON.GEO'
4668 include 'COMMON.LOCAL'
4669 include 'COMMON.IOUNITS'
4670 common /sccalc/ time11,time12,time112,theti,it,nlobit
4671 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4672 double precision contr(maxlob)
4683 z(k)=x(k)-censc(k,j,it)
4689 Axk=Axk+gaussc(l,k,j,it)*z(l)
4695 expfac=expfac+Ax(k,j)*z(k)
4700 C As in the case of ebend, we want to avoid underflows in exponentiation and
4701 C subsequent NaNs and INFs in energy calculation.
4702 C Find the largest exponent
4705 if (emin.gt.contr(j)) emin=contr(j)
4709 C Compute the contribution to SC energy and derivatives
4713 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4714 escloc_i=escloc_i+expfac
4716 dersc(k)=dersc(k)+Ax(k,j)*expfac
4718 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4719 & +gaussc(1,2,j,it))*expfac
4723 dersc(1)=dersc(1)/cos(theti)**2
4724 dersc12=dersc12/cos(theti)**2
4725 escloci=-(dlog(escloc_i)-emin)
4727 dersc(j)=dersc(j)/escloc_i
4729 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4733 c----------------------------------------------------------------------------------
4734 subroutine esc(escloc)
4735 C Calculate the local energy of a side chain and its derivatives in the
4736 C corresponding virtual-bond valence angles THETA and the spherical angles
4737 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4738 C added by Urszula Kozlowska. 07/11/2007
4740 implicit real*8 (a-h,o-z)
4741 include 'DIMENSIONS'
4742 include 'DIMENSIONS.ZSCOPT'
4743 include 'COMMON.GEO'
4744 include 'COMMON.LOCAL'
4745 include 'COMMON.VAR'
4746 include 'COMMON.SCROT'
4747 include 'COMMON.INTERACT'
4748 include 'COMMON.DERIV'
4749 include 'COMMON.CHAIN'
4750 include 'COMMON.IOUNITS'
4751 include 'COMMON.NAMES'
4752 include 'COMMON.FFIELD'
4753 include 'COMMON.CONTROL'
4754 include 'COMMON.VECTORS'
4755 double precision x_prime(3),y_prime(3),z_prime(3)
4756 & , sumene,dsc_i,dp2_i,x(65),
4757 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4758 & de_dxx,de_dyy,de_dzz,de_dt
4759 double precision s1_t,s1_6_t,s2_t,s2_6_t
4761 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4762 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4763 & dt_dCi(3),dt_dCi1(3)
4764 common /sccalc/ time11,time12,time112,theti,it,nlobit
4767 do i=loc_start,loc_end
4768 if (itype(i).eq.ntyp1) cycle
4769 costtab(i+1) =dcos(theta(i+1))
4770 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4771 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4772 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4773 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4774 cosfac=dsqrt(cosfac2)
4775 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4776 sinfac=dsqrt(sinfac2)
4778 if (it.eq.10) goto 1
4780 C Compute the axes of tghe local cartesian coordinates system; store in
4781 c x_prime, y_prime and z_prime
4788 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4789 C & dc_norm(3,i+nres)
4791 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4792 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4795 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4798 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4799 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4800 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4801 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4802 c & " xy",scalar(x_prime(1),y_prime(1)),
4803 c & " xz",scalar(x_prime(1),z_prime(1)),
4804 c & " yy",scalar(y_prime(1),y_prime(1)),
4805 c & " yz",scalar(y_prime(1),z_prime(1)),
4806 c & " zz",scalar(z_prime(1),z_prime(1))
4808 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4809 C to local coordinate system. Store in xx, yy, zz.
4815 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4816 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4817 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4824 C Compute the energy of the ith side cbain
4826 c write (2,*) "xx",xx," yy",yy," zz",zz
4829 x(j) = sc_parmin(j,it)
4832 Cc diagnostics - remove later
4834 yy1 = dsin(alph(2))*dcos(omeg(2))
4835 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4836 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4837 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4839 C," --- ", xx_w,yy_w,zz_w
4842 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4843 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4845 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4846 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4848 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4849 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4850 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4851 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4852 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4854 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4855 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4856 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4857 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4858 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4860 dsc_i = 0.743d0+x(61)
4862 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4863 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4864 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4865 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4866 s1=(1+x(63))/(0.1d0 + dscp1)
4867 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4868 s2=(1+x(65))/(0.1d0 + dscp2)
4869 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4870 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4871 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4872 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4874 c & dscp1,dscp2,sumene
4875 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4876 escloc = escloc + sumene
4877 c write (2,*) "escloc",escloc
4878 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4880 if (.not. calc_grad) goto 1
4883 C This section to check the numerical derivatives of the energy of ith side
4884 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4885 C #define DEBUG in the code to turn it on.
4887 write (2,*) "sumene =",sumene
4891 write (2,*) xx,yy,zz
4892 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4893 de_dxx_num=(sumenep-sumene)/aincr
4895 write (2,*) "xx+ sumene from enesc=",sumenep
4898 write (2,*) xx,yy,zz
4899 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4900 de_dyy_num=(sumenep-sumene)/aincr
4902 write (2,*) "yy+ sumene from enesc=",sumenep
4905 write (2,*) xx,yy,zz
4906 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4907 de_dzz_num=(sumenep-sumene)/aincr
4909 write (2,*) "zz+ sumene from enesc=",sumenep
4910 costsave=cost2tab(i+1)
4911 sintsave=sint2tab(i+1)
4912 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4913 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4914 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4915 de_dt_num=(sumenep-sumene)/aincr
4916 write (2,*) " t+ sumene from enesc=",sumenep
4917 cost2tab(i+1)=costsave
4918 sint2tab(i+1)=sintsave
4919 C End of diagnostics section.
4922 C Compute the gradient of esc
4924 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4925 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4926 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4927 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4928 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4929 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4930 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4931 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4932 pom1=(sumene3*sint2tab(i+1)+sumene1)
4933 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4934 pom2=(sumene4*cost2tab(i+1)+sumene2)
4935 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4936 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4937 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4938 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4940 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4941 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4942 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4944 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4945 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4946 & +(pom1+pom2)*pom_dx
4948 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4951 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4952 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4953 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4955 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4956 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4957 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4958 & +x(59)*zz**2 +x(60)*xx*zz
4959 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4960 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4961 & +(pom1-pom2)*pom_dy
4963 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4966 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4967 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4968 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4969 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4970 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4971 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4972 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4973 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4975 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4978 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4979 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4980 & +pom1*pom_dt1+pom2*pom_dt2
4982 write(2,*), "de_dt = ", de_dt,de_dt_num
4986 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4987 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4988 cosfac2xx=cosfac2*xx
4989 sinfac2yy=sinfac2*yy
4991 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4993 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4995 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4996 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4997 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4998 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4999 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5000 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5001 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5002 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5003 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5004 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5008 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5009 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5010 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5011 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5014 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5015 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5016 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5018 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5019 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5023 dXX_Ctab(k,i)=dXX_Ci(k)
5024 dXX_C1tab(k,i)=dXX_Ci1(k)
5025 dYY_Ctab(k,i)=dYY_Ci(k)
5026 dYY_C1tab(k,i)=dYY_Ci1(k)
5027 dZZ_Ctab(k,i)=dZZ_Ci(k)
5028 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5029 dXX_XYZtab(k,i)=dXX_XYZ(k)
5030 dYY_XYZtab(k,i)=dYY_XYZ(k)
5031 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5035 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5036 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5037 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5038 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5039 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5041 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5042 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5043 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5044 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5045 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5046 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5047 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5048 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5050 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5051 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5053 C to check gradient call subroutine check_grad
5060 c------------------------------------------------------------------------------
5061 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5063 C This procedure calculates two-body contact function g(rij) and its derivative:
5066 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5069 C where x=(rij-r0ij)/delta
5071 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5074 double precision rij,r0ij,eps0ij,fcont,fprimcont
5075 double precision x,x2,x4,delta
5079 if (x.lt.-1.0D0) then
5082 else if (x.le.1.0D0) then
5085 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5086 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5093 c------------------------------------------------------------------------------
5094 subroutine splinthet(theti,delta,ss,ssder)
5095 implicit real*8 (a-h,o-z)
5096 include 'DIMENSIONS'
5097 include 'DIMENSIONS.ZSCOPT'
5098 include 'COMMON.VAR'
5099 include 'COMMON.GEO'
5102 if (theti.gt.pipol) then
5103 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5105 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5110 c------------------------------------------------------------------------------
5111 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5113 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5114 double precision ksi,ksi2,ksi3,a1,a2,a3
5115 a1=fprim0*delta/(f1-f0)
5121 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5122 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5125 c------------------------------------------------------------------------------
5126 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5128 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5129 double precision ksi,ksi2,ksi3,a1,a2,a3
5134 a2=3*(f1x-f0x)-2*fprim0x*delta
5135 a3=fprim0x*delta-2*(f1x-f0x)
5136 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5139 C-----------------------------------------------------------------------------
5141 C-----------------------------------------------------------------------------
5142 subroutine etor(etors,edihcnstr,fact)
5143 implicit real*8 (a-h,o-z)
5144 include 'DIMENSIONS'
5145 include 'DIMENSIONS.ZSCOPT'
5146 include 'COMMON.VAR'
5147 include 'COMMON.GEO'
5148 include 'COMMON.LOCAL'
5149 include 'COMMON.TORSION'
5150 include 'COMMON.INTERACT'
5151 include 'COMMON.DERIV'
5152 include 'COMMON.CHAIN'
5153 include 'COMMON.NAMES'
5154 include 'COMMON.IOUNITS'
5155 include 'COMMON.FFIELD'
5156 include 'COMMON.TORCNSTR'
5158 C Set lprn=.true. for debugging
5162 do i=iphi_start,iphi_end
5163 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5164 & .or. itype(i).eq.ntyp1) cycle
5165 itori=itortyp(itype(i-2))
5166 itori1=itortyp(itype(i-1))
5169 C Proline-Proline pair is a special case...
5170 if (itori.eq.3 .and. itori1.eq.3) then
5171 if (phii.gt.-dwapi3) then
5173 fac=1.0D0/(1.0D0-cosphi)
5174 etorsi=v1(1,3,3)*fac
5175 etorsi=etorsi+etorsi
5176 etors=etors+etorsi-v1(1,3,3)
5177 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5180 v1ij=v1(j+1,itori,itori1)
5181 v2ij=v2(j+1,itori,itori1)
5184 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5185 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5189 v1ij=v1(j,itori,itori1)
5190 v2ij=v2(j,itori,itori1)
5193 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5194 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5198 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5199 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5200 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5201 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5202 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5204 ! 6/20/98 - dihedral angle constraints
5207 itori=idih_constr(i)
5210 if (difi.gt.drange(i)) then
5212 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5213 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5214 else if (difi.lt.-drange(i)) then
5216 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5217 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5219 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5220 C & i,itori,rad2deg*phii,
5221 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5223 ! write (iout,*) 'edihcnstr',edihcnstr
5226 c------------------------------------------------------------------------------
5228 subroutine etor(etors,edihcnstr,fact)
5229 implicit real*8 (a-h,o-z)
5230 include 'DIMENSIONS'
5231 include 'DIMENSIONS.ZSCOPT'
5232 include 'COMMON.VAR'
5233 include 'COMMON.GEO'
5234 include 'COMMON.LOCAL'
5235 include 'COMMON.TORSION'
5236 include 'COMMON.INTERACT'
5237 include 'COMMON.DERIV'
5238 include 'COMMON.CHAIN'
5239 include 'COMMON.NAMES'
5240 include 'COMMON.IOUNITS'
5241 include 'COMMON.FFIELD'
5242 include 'COMMON.TORCNSTR'
5244 C Set lprn=.true. for debugging
5248 do i=iphi_start,iphi_end
5250 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5251 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5252 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5253 C & .or. itype(i).eq.ntyp1) cycle
5254 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5255 if (iabs(itype(i)).eq.20) then
5260 itori=itortyp(itype(i-2))
5261 itori1=itortyp(itype(i-1))
5264 C Regular cosine and sine terms
5265 do j=1,nterm(itori,itori1,iblock)
5266 v1ij=v1(j,itori,itori1,iblock)
5267 v2ij=v2(j,itori,itori1,iblock)
5270 etors=etors+v1ij*cosphi+v2ij*sinphi
5271 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5275 C E = SUM ----------------------------------- - v1
5276 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5278 cosphi=dcos(0.5d0*phii)
5279 sinphi=dsin(0.5d0*phii)
5280 do j=1,nlor(itori,itori1,iblock)
5281 vl1ij=vlor1(j,itori,itori1)
5282 vl2ij=vlor2(j,itori,itori1)
5283 vl3ij=vlor3(j,itori,itori1)
5284 pom=vl2ij*cosphi+vl3ij*sinphi
5285 pom1=1.0d0/(pom*pom+1.0d0)
5286 etors=etors+vl1ij*pom1
5287 c if (energy_dec) etors_ii=etors_ii+
5290 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5292 C Subtract the constant term
5293 etors=etors-v0(itori,itori1,iblock)
5295 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5296 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5297 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5298 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5299 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5302 ! 6/20/98 - dihedral angle constraints
5305 itori=idih_constr(i)
5307 difi=pinorm(phii-phi0(i))
5309 if (difi.gt.drange(i)) then
5311 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5312 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5313 edihi=0.25d0*ftors(i)*difi**4
5314 else if (difi.lt.-drange(i)) then
5316 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5317 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5318 edihi=0.25d0*ftors(i)*difi**4
5322 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5323 & i,itori,rad2deg*phii,
5324 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5325 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5327 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5328 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5330 ! write (iout,*) 'edihcnstr',edihcnstr
5333 c----------------------------------------------------------------------------
5334 subroutine etor_d(etors_d,fact2)
5335 C 6/23/01 Compute double torsional energy
5336 implicit real*8 (a-h,o-z)
5337 include 'DIMENSIONS'
5338 include 'DIMENSIONS.ZSCOPT'
5339 include 'COMMON.VAR'
5340 include 'COMMON.GEO'
5341 include 'COMMON.LOCAL'
5342 include 'COMMON.TORSION'
5343 include 'COMMON.INTERACT'
5344 include 'COMMON.DERIV'
5345 include 'COMMON.CHAIN'
5346 include 'COMMON.NAMES'
5347 include 'COMMON.IOUNITS'
5348 include 'COMMON.FFIELD'
5349 include 'COMMON.TORCNSTR'
5351 C Set lprn=.true. for debugging
5355 do i=iphi_start,iphi_end-1
5357 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5358 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5359 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5360 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5361 & (itype(i+1).eq.ntyp1)) cycle
5362 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5364 itori=itortyp(itype(i-2))
5365 itori1=itortyp(itype(i-1))
5366 itori2=itortyp(itype(i))
5372 if (iabs(itype(i+1)).eq.20) iblock=2
5373 C Regular cosine and sine terms
5374 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5375 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5376 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5377 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5378 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5379 cosphi1=dcos(j*phii)
5380 sinphi1=dsin(j*phii)
5381 cosphi2=dcos(j*phii1)
5382 sinphi2=dsin(j*phii1)
5383 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5384 & v2cij*cosphi2+v2sij*sinphi2
5385 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5386 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5388 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5390 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5391 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5392 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5393 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5394 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5395 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5396 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5397 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5398 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5399 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5400 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5401 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5402 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5403 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5406 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5407 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5413 c------------------------------------------------------------------------------
5414 subroutine eback_sc_corr(esccor)
5415 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5416 c conformational states; temporarily implemented as differences
5417 c between UNRES torsional potentials (dependent on three types of
5418 c residues) and the torsional potentials dependent on all 20 types
5419 c of residues computed from AM1 energy surfaces of terminally-blocked
5420 c amino-acid residues.
5421 implicit real*8 (a-h,o-z)
5422 include 'DIMENSIONS'
5423 include 'DIMENSIONS.ZSCOPT'
5424 include 'COMMON.VAR'
5425 include 'COMMON.GEO'
5426 include 'COMMON.LOCAL'
5427 include 'COMMON.TORSION'
5428 include 'COMMON.SCCOR'
5429 include 'COMMON.INTERACT'
5430 include 'COMMON.DERIV'
5431 include 'COMMON.CHAIN'
5432 include 'COMMON.NAMES'
5433 include 'COMMON.IOUNITS'
5434 include 'COMMON.FFIELD'
5435 include 'COMMON.CONTROL'
5437 C Set lprn=.true. for debugging
5440 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5442 do i=itau_start,itau_end
5443 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5445 isccori=isccortyp(itype(i-2))
5446 isccori1=isccortyp(itype(i-1))
5448 do intertyp=1,3 !intertyp
5449 cc Added 09 May 2012 (Adasko)
5450 cc Intertyp means interaction type of backbone mainchain correlation:
5451 c 1 = SC...Ca...Ca...Ca
5452 c 2 = Ca...Ca...Ca...SC
5453 c 3 = SC...Ca...Ca...SCi
5455 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5456 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5457 & (itype(i-1).eq.ntyp1)))
5458 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5459 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5460 & .or.(itype(i).eq.ntyp1)))
5461 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5462 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5463 & (itype(i-3).eq.ntyp1)))) cycle
5464 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5465 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5467 do j=1,nterm_sccor(isccori,isccori1)
5468 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5469 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5470 cosphi=dcos(j*tauangle(intertyp,i))
5471 sinphi=dsin(j*tauangle(intertyp,i))
5472 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5473 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5475 C write (iout,*)"EBACK_SC_COR",esccor,i
5476 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5477 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5478 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5480 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5481 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5482 & (v1sccor(j,1,itori,itori1),j=1,6)
5483 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5484 c gsccor_loc(i-3)=gloci
5489 c------------------------------------------------------------------------------
5490 subroutine multibody(ecorr)
5491 C This subroutine calculates multi-body contributions to energy following
5492 C the idea of Skolnick et al. If side chains I and J make a contact and
5493 C at the same time side chains I+1 and J+1 make a contact, an extra
5494 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5495 implicit real*8 (a-h,o-z)
5496 include 'DIMENSIONS'
5497 include 'COMMON.IOUNITS'
5498 include 'COMMON.DERIV'
5499 include 'COMMON.INTERACT'
5500 include 'COMMON.CONTACTS'
5501 double precision gx(3),gx1(3)
5504 C Set lprn=.true. for debugging
5508 write (iout,'(a)') 'Contact function values:'
5510 write (iout,'(i2,20(1x,i2,f10.5))')
5511 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5526 num_conti=num_cont(i)
5527 num_conti1=num_cont(i1)
5532 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5533 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5534 cd & ' ishift=',ishift
5535 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5536 C The system gains extra energy.
5537 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5538 endif ! j1==j+-ishift
5547 c------------------------------------------------------------------------------
5548 double precision function esccorr(i,j,k,l,jj,kk)
5549 implicit real*8 (a-h,o-z)
5550 include 'DIMENSIONS'
5551 include 'COMMON.IOUNITS'
5552 include 'COMMON.DERIV'
5553 include 'COMMON.INTERACT'
5554 include 'COMMON.CONTACTS'
5555 double precision gx(3),gx1(3)
5560 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5561 C Calculate the multi-body contribution to energy.
5562 C Calculate multi-body contributions to the gradient.
5563 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5564 cd & k,l,(gacont(m,kk,k),m=1,3)
5566 gx(m) =ekl*gacont(m,jj,i)
5567 gx1(m)=eij*gacont(m,kk,k)
5568 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5569 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5570 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5571 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5575 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5580 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5586 c------------------------------------------------------------------------------
5588 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 integer dimen1,dimen2,atom,indx
5592 double precision buffer(dimen1,dimen2)
5593 double precision zapas
5594 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5595 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5596 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5597 num_kont=num_cont_hb(atom)
5601 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5604 buffer(i,indx+22)=facont_hb(i,atom)
5605 buffer(i,indx+23)=ees0p(i,atom)
5606 buffer(i,indx+24)=ees0m(i,atom)
5607 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5609 buffer(1,indx+26)=dfloat(num_kont)
5612 c------------------------------------------------------------------------------
5613 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5614 implicit real*8 (a-h,o-z)
5615 include 'DIMENSIONS'
5616 integer dimen1,dimen2,atom,indx
5617 double precision buffer(dimen1,dimen2)
5618 double precision zapas
5619 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5620 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5621 & ees0m(ntyp,maxres),
5622 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5623 num_kont=buffer(1,indx+26)
5624 num_kont_old=num_cont_hb(atom)
5625 num_cont_hb(atom)=num_kont+num_kont_old
5630 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5633 facont_hb(ii,atom)=buffer(i,indx+22)
5634 ees0p(ii,atom)=buffer(i,indx+23)
5635 ees0m(ii,atom)=buffer(i,indx+24)
5636 jcont_hb(ii,atom)=buffer(i,indx+25)
5640 c------------------------------------------------------------------------------
5642 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5643 C This subroutine calculates multi-body contributions to hydrogen-bonding
5644 implicit real*8 (a-h,o-z)
5645 include 'DIMENSIONS'
5646 include 'DIMENSIONS.ZSCOPT'
5647 include 'COMMON.IOUNITS'
5649 include 'COMMON.INFO'
5651 include 'COMMON.FFIELD'
5652 include 'COMMON.DERIV'
5653 include 'COMMON.INTERACT'
5654 include 'COMMON.CONTACTS'
5656 parameter (max_cont=maxconts)
5657 parameter (max_dim=2*(8*3+2))
5658 parameter (msglen1=max_cont*max_dim*4)
5659 parameter (msglen2=2*msglen1)
5660 integer source,CorrelType,CorrelID,Error
5661 double precision buffer(max_cont,max_dim)
5663 double precision gx(3),gx1(3)
5666 C Set lprn=.true. for debugging
5671 if (fgProcs.le.1) goto 30
5673 write (iout,'(a)') 'Contact function values:'
5675 write (iout,'(2i3,50(1x,i2,f5.2))')
5676 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5677 & j=1,num_cont_hb(i))
5680 C Caution! Following code assumes that electrostatic interactions concerning
5681 C a given atom are split among at most two processors!
5691 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5694 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5695 if (MyRank.gt.0) then
5696 C Send correlation contributions to the preceding processor
5698 nn=num_cont_hb(iatel_s)
5699 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5700 cd write (iout,*) 'The BUFFER array:'
5702 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5704 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5706 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5707 C Clear the contacts of the atom passed to the neighboring processor
5708 nn=num_cont_hb(iatel_s+1)
5710 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5712 num_cont_hb(iatel_s)=0
5714 cd write (iout,*) 'Processor ',MyID,MyRank,
5715 cd & ' is sending correlation contribution to processor',MyID-1,
5716 cd & ' msglen=',msglen
5717 cd write (*,*) 'Processor ',MyID,MyRank,
5718 cd & ' is sending correlation contribution to processor',MyID-1,
5719 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5720 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5721 cd write (iout,*) 'Processor ',MyID,
5722 cd & ' has sent correlation contribution to processor',MyID-1,
5723 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5724 cd write (*,*) 'Processor ',MyID,
5725 cd & ' has sent correlation contribution to processor',MyID-1,
5726 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5728 endif ! (MyRank.gt.0)
5732 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5733 if (MyRank.lt.fgProcs-1) then
5734 C Receive correlation contributions from the next processor
5736 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5737 cd write (iout,*) 'Processor',MyID,
5738 cd & ' is receiving correlation contribution from processor',MyID+1,
5739 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5740 cd write (*,*) 'Processor',MyID,
5741 cd & ' is receiving correlation contribution from processor',MyID+1,
5742 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5744 do while (nbytes.le.0)
5745 call mp_probe(MyID+1,CorrelType,nbytes)
5747 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5748 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5749 cd write (iout,*) 'Processor',MyID,
5750 cd & ' has received correlation contribution from processor',MyID+1,
5751 cd & ' msglen=',msglen,' nbytes=',nbytes
5752 cd write (iout,*) 'The received BUFFER array:'
5754 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5756 if (msglen.eq.msglen1) then
5757 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5758 else if (msglen.eq.msglen2) then
5759 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5760 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5763 & 'ERROR!!!! message length changed while processing correlations.'
5765 & 'ERROR!!!! message length changed while processing correlations.'
5766 call mp_stopall(Error)
5767 endif ! msglen.eq.msglen1
5768 endif ! MyRank.lt.fgProcs-1
5775 write (iout,'(a)') 'Contact function values:'
5777 write (iout,'(2i3,50(1x,i2,f5.2))')
5778 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5779 & j=1,num_cont_hb(i))
5783 C Remove the loop below after debugging !!!
5790 C Calculate the local-electrostatic correlation terms
5791 do i=iatel_s,iatel_e+1
5793 num_conti=num_cont_hb(i)
5794 num_conti1=num_cont_hb(i+1)
5799 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5800 c & ' jj=',jj,' kk=',kk
5801 if (j1.eq.j+1 .or. j1.eq.j-1) then
5802 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5803 C The system gains extra energy.
5804 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5806 else if (j1.eq.j) then
5807 C Contacts I-J and I-(J+1) occur simultaneously.
5808 C The system loses extra energy.
5809 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5814 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5815 c & ' jj=',jj,' kk=',kk
5817 C Contacts I-J and (I+1)-J occur simultaneously.
5818 C The system loses extra energy.
5819 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5826 c------------------------------------------------------------------------------
5827 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5829 C This subroutine calculates multi-body contributions to hydrogen-bonding
5830 implicit real*8 (a-h,o-z)
5831 include 'DIMENSIONS'
5832 include 'DIMENSIONS.ZSCOPT'
5833 include 'COMMON.IOUNITS'
5835 include 'COMMON.INFO'
5837 include 'COMMON.FFIELD'
5838 include 'COMMON.DERIV'
5839 include 'COMMON.INTERACT'
5840 include 'COMMON.CONTACTS'
5842 parameter (max_cont=maxconts)
5843 parameter (max_dim=2*(8*3+2))
5844 parameter (msglen1=max_cont*max_dim*4)
5845 parameter (msglen2=2*msglen1)
5846 integer source,CorrelType,CorrelID,Error
5847 double precision buffer(max_cont,max_dim)
5849 double precision gx(3),gx1(3)
5852 C Set lprn=.true. for debugging
5859 if (fgProcs.le.1) goto 30
5861 write (iout,'(a)') 'Contact function values:'
5863 write (iout,'(2i3,50(1x,i2,f5.2))')
5864 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5865 & j=1,num_cont_hb(i))
5868 C Caution! Following code assumes that electrostatic interactions concerning
5869 C a given atom are split among at most two processors!
5879 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5882 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5883 if (MyRank.gt.0) then
5884 C Send correlation contributions to the preceding processor
5886 nn=num_cont_hb(iatel_s)
5887 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5888 cd write (iout,*) 'The BUFFER array:'
5890 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5892 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5894 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5895 C Clear the contacts of the atom passed to the neighboring processor
5896 nn=num_cont_hb(iatel_s+1)
5898 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5900 num_cont_hb(iatel_s)=0
5902 cd write (iout,*) 'Processor ',MyID,MyRank,
5903 cd & ' is sending correlation contribution to processor',MyID-1,
5904 cd & ' msglen=',msglen
5905 cd write (*,*) 'Processor ',MyID,MyRank,
5906 cd & ' is sending correlation contribution to processor',MyID-1,
5907 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5908 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5909 cd write (iout,*) 'Processor ',MyID,
5910 cd & ' has sent correlation contribution to processor',MyID-1,
5911 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5912 cd write (*,*) 'Processor ',MyID,
5913 cd & ' has sent correlation contribution to processor',MyID-1,
5914 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5916 endif ! (MyRank.gt.0)
5920 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5921 if (MyRank.lt.fgProcs-1) then
5922 C Receive correlation contributions from the next processor
5924 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5925 cd write (iout,*) 'Processor',MyID,
5926 cd & ' is receiving correlation contribution from processor',MyID+1,
5927 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5928 cd write (*,*) 'Processor',MyID,
5929 cd & ' is receiving correlation contribution from processor',MyID+1,
5930 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5932 do while (nbytes.le.0)
5933 call mp_probe(MyID+1,CorrelType,nbytes)
5935 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5936 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5937 cd write (iout,*) 'Processor',MyID,
5938 cd & ' has received correlation contribution from processor',MyID+1,
5939 cd & ' msglen=',msglen,' nbytes=',nbytes
5940 cd write (iout,*) 'The received BUFFER array:'
5942 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5944 if (msglen.eq.msglen1) then
5945 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5946 else if (msglen.eq.msglen2) then
5947 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5948 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5951 & 'ERROR!!!! message length changed while processing correlations.'
5953 & 'ERROR!!!! message length changed while processing correlations.'
5954 call mp_stopall(Error)
5955 endif ! msglen.eq.msglen1
5956 endif ! MyRank.lt.fgProcs-1
5963 write (iout,'(a)') 'Contact function values:'
5965 write (iout,'(2i3,50(1x,i2,f5.2))')
5966 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5967 & j=1,num_cont_hb(i))
5973 C Remove the loop below after debugging !!!
5980 C Calculate the dipole-dipole interaction energies
5981 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5982 do i=iatel_s,iatel_e+1
5983 num_conti=num_cont_hb(i)
5990 C Calculate the local-electrostatic correlation terms
5991 do i=iatel_s,iatel_e+1
5993 num_conti=num_cont_hb(i)
5994 num_conti1=num_cont_hb(i+1)
5999 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6000 c & ' jj=',jj,' kk=',kk
6001 if (j1.eq.j+1 .or. j1.eq.j-1) then
6002 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6003 C The system gains extra energy.
6005 sqd1=dsqrt(d_cont(jj,i))
6006 sqd2=dsqrt(d_cont(kk,i1))
6007 sred_geom = sqd1*sqd2
6008 IF (sred_geom.lt.cutoff_corr) THEN
6009 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6011 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6012 c & ' jj=',jj,' kk=',kk
6013 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6014 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6016 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6017 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6020 cd write (iout,*) 'sred_geom=',sred_geom,
6021 cd & ' ekont=',ekont,' fprim=',fprimcont
6022 call calc_eello(i,j,i+1,j1,jj,kk)
6023 if (wcorr4.gt.0.0d0)
6024 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6025 if (wcorr5.gt.0.0d0)
6026 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6027 c print *,"wcorr5",ecorr5
6028 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6029 cd write(2,*)'ijkl',i,j,i+1,j1
6030 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6031 & .or. wturn6.eq.0.0d0))then
6032 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6033 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6034 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6035 cd & 'ecorr6=',ecorr6
6036 cd write (iout,'(4e15.5)') sred_geom,
6037 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6038 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6039 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6040 else if (wturn6.gt.0.0d0
6041 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6042 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6043 eturn6=eturn6+eello_turn6(i,jj,kk)
6044 cd write (2,*) 'multibody_eello:eturn6',eturn6
6045 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6052 else if (j1.eq.j) then
6053 C Contacts I-J and I-(J+1) occur simultaneously.
6054 C The system loses extra energy.
6055 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6060 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6061 c & ' jj=',jj,' kk=',kk
6063 C Contacts I-J and (I+1)-J occur simultaneously.
6064 C The system loses extra energy.
6065 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6070 write (iout,*) "eturn6",eturn6,ecorr6
6073 c------------------------------------------------------------------------------
6074 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6075 implicit real*8 (a-h,o-z)
6076 include 'DIMENSIONS'
6077 include 'COMMON.IOUNITS'
6078 include 'COMMON.DERIV'
6079 include 'COMMON.INTERACT'
6080 include 'COMMON.CONTACTS'
6081 include 'COMMON.CONTROL'
6082 include 'COMMON.SHIELD'
6083 double precision gx(3),gx1(3)
6093 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6094 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6095 C Following 4 lines for diagnostics.
6100 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6102 c write (iout,*)'Contacts have occurred for peptide groups',
6103 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6104 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6105 C Calculate the multi-body contribution to energy.
6106 C ecorr=ecorr+ekont*ees
6108 C Calculate multi-body contributions to the gradient.
6110 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6111 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6112 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6113 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6114 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6115 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6116 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6117 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6118 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6119 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6120 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6121 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6122 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6123 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6127 gradcorr(ll,m)=gradcorr(ll,m)+
6128 & ees*ekl*gacont_hbr(ll,jj,i)-
6129 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6130 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6135 gradcorr(ll,m)=gradcorr(ll,m)+
6136 & ees*eij*gacont_hbr(ll,kk,k)-
6137 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6138 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6141 if (shield_mode.gt.0) then
6144 C print *,i,j,fac_shield(i),fac_shield(j),
6145 C &fac_shield(k),fac_shield(l)
6146 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6147 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6148 do ilist=1,ishield_list(i)
6149 iresshield=shield_list(ilist,i)
6151 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6153 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6155 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6156 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6160 do ilist=1,ishield_list(j)
6161 iresshield=shield_list(ilist,j)
6163 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6165 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6167 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6168 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6172 do ilist=1,ishield_list(k)
6173 iresshield=shield_list(ilist,k)
6175 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6177 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6179 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6180 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6184 do ilist=1,ishield_list(l)
6185 iresshield=shield_list(ilist,l)
6187 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6189 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6191 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6192 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6196 C print *,gshieldx(m,iresshield)
6198 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6199 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6200 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6201 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6202 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6203 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6204 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6205 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6207 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6208 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6209 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6210 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6211 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6212 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6213 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6214 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6223 C---------------------------------------------------------------------------
6224 subroutine dipole(i,j,jj)
6225 implicit real*8 (a-h,o-z)
6226 include 'DIMENSIONS'
6227 include 'DIMENSIONS.ZSCOPT'
6228 include 'COMMON.IOUNITS'
6229 include 'COMMON.CHAIN'
6230 include 'COMMON.FFIELD'
6231 include 'COMMON.DERIV'
6232 include 'COMMON.INTERACT'
6233 include 'COMMON.CONTACTS'
6234 include 'COMMON.TORSION'
6235 include 'COMMON.VAR'
6236 include 'COMMON.GEO'
6237 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6239 iti1 = itortyp(itype(i+1))
6240 if (j.lt.nres-1) then
6241 if (itype(j).le.ntyp) then
6242 itj1 = itortyp(itype(j+1))
6250 dipi(iii,1)=Ub2(iii,i)
6251 dipderi(iii)=Ub2der(iii,i)
6252 dipi(iii,2)=b1(iii,iti1)
6253 dipj(iii,1)=Ub2(iii,j)
6254 dipderj(iii)=Ub2der(iii,j)
6255 dipj(iii,2)=b1(iii,itj1)
6259 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6262 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6265 if (.not.calc_grad) return
6270 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6274 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6279 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6280 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6282 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6284 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6286 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6290 C---------------------------------------------------------------------------
6291 subroutine calc_eello(i,j,k,l,jj,kk)
6293 C This subroutine computes matrices and vectors needed to calculate
6294 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6296 implicit real*8 (a-h,o-z)
6297 include 'DIMENSIONS'
6298 include 'DIMENSIONS.ZSCOPT'
6299 include 'COMMON.IOUNITS'
6300 include 'COMMON.CHAIN'
6301 include 'COMMON.DERIV'
6302 include 'COMMON.INTERACT'
6303 include 'COMMON.CONTACTS'
6304 include 'COMMON.TORSION'
6305 include 'COMMON.VAR'
6306 include 'COMMON.GEO'
6307 include 'COMMON.FFIELD'
6308 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6309 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6312 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6313 cd & ' jj=',jj,' kk=',kk
6314 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6317 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6318 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6321 call transpose2(aa1(1,1),aa1t(1,1))
6322 call transpose2(aa2(1,1),aa2t(1,1))
6325 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6326 & aa1tder(1,1,lll,kkk))
6327 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6328 & aa2tder(1,1,lll,kkk))
6332 C parallel orientation of the two CA-CA-CA frames.
6333 if (i.gt.1 .and. itype(i).le.ntyp) then
6334 iti=itortyp(itype(i))
6338 itk1=itortyp(itype(k+1))
6339 itj=itortyp(itype(j))
6340 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6341 itl1=itortyp(itype(l+1))
6345 C A1 kernel(j+1) A2T
6347 cd write (iout,'(3f10.5,5x,3f10.5)')
6348 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6350 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6351 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6352 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6353 C Following matrices are needed only for 6-th order cumulants
6354 IF (wcorr6.gt.0.0d0) THEN
6355 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6356 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6357 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6358 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6359 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6360 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6361 & ADtEAderx(1,1,1,1,1,1))
6363 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6364 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6365 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6366 & ADtEA1derx(1,1,1,1,1,1))
6368 C End 6-th order cumulants
6371 cd write (2,*) 'In calc_eello6'
6373 cd write (2,*) 'iii=',iii
6375 cd write (2,*) 'kkk=',kkk
6377 cd write (2,'(3(2f10.5),5x)')
6378 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6383 call transpose2(EUgder(1,1,k),auxmat(1,1))
6384 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6385 call transpose2(EUg(1,1,k),auxmat(1,1))
6386 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6387 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6391 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6392 & EAEAderx(1,1,lll,kkk,iii,1))
6396 C A1T kernel(i+1) A2
6397 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6398 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6399 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6400 C Following matrices are needed only for 6-th order cumulants
6401 IF (wcorr6.gt.0.0d0) THEN
6402 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6403 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6404 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6405 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6406 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6407 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6408 & ADtEAderx(1,1,1,1,1,2))
6409 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6410 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6411 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6412 & ADtEA1derx(1,1,1,1,1,2))
6414 C End 6-th order cumulants
6415 call transpose2(EUgder(1,1,l),auxmat(1,1))
6416 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6417 call transpose2(EUg(1,1,l),auxmat(1,1))
6418 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6419 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6423 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6424 & EAEAderx(1,1,lll,kkk,iii,2))
6429 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6430 C They are needed only when the fifth- or the sixth-order cumulants are
6432 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6433 call transpose2(AEA(1,1,1),auxmat(1,1))
6434 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6435 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6436 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6437 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6438 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6439 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6440 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6441 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6442 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6443 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6444 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6445 call transpose2(AEA(1,1,2),auxmat(1,1))
6446 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6447 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6448 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6449 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6450 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6451 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6452 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6453 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6454 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6455 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6456 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6457 C Calculate the Cartesian derivatives of the vectors.
6461 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6462 call matvec2(auxmat(1,1),b1(1,iti),
6463 & AEAb1derx(1,lll,kkk,iii,1,1))
6464 call matvec2(auxmat(1,1),Ub2(1,i),
6465 & AEAb2derx(1,lll,kkk,iii,1,1))
6466 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6467 & AEAb1derx(1,lll,kkk,iii,2,1))
6468 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6469 & AEAb2derx(1,lll,kkk,iii,2,1))
6470 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6471 call matvec2(auxmat(1,1),b1(1,itj),
6472 & AEAb1derx(1,lll,kkk,iii,1,2))
6473 call matvec2(auxmat(1,1),Ub2(1,j),
6474 & AEAb2derx(1,lll,kkk,iii,1,2))
6475 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6476 & AEAb1derx(1,lll,kkk,iii,2,2))
6477 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6478 & AEAb2derx(1,lll,kkk,iii,2,2))
6485 C Antiparallel orientation of the two CA-CA-CA frames.
6486 if (i.gt.1 .and. itype(i).le.ntyp) then
6487 iti=itortyp(itype(i))
6491 itk1=itortyp(itype(k+1))
6492 itl=itortyp(itype(l))
6493 itj=itortyp(itype(j))
6494 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6495 itj1=itortyp(itype(j+1))
6499 C A2 kernel(j-1)T A1T
6500 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6501 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6502 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6503 C Following matrices are needed only for 6-th order cumulants
6504 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6505 & j.eq.i+4 .and. l.eq.i+3)) THEN
6506 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6507 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6508 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6509 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6510 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6511 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6512 & ADtEAderx(1,1,1,1,1,1))
6513 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6514 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6515 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6516 & ADtEA1derx(1,1,1,1,1,1))
6518 C End 6-th order cumulants
6519 call transpose2(EUgder(1,1,k),auxmat(1,1))
6520 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6521 call transpose2(EUg(1,1,k),auxmat(1,1))
6522 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6523 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6527 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6528 & EAEAderx(1,1,lll,kkk,iii,1))
6532 C A2T kernel(i+1)T A1
6533 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6534 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6535 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6536 C Following matrices are needed only for 6-th order cumulants
6537 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6538 & j.eq.i+4 .and. l.eq.i+3)) THEN
6539 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6540 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6541 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6542 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6543 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6544 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6545 & ADtEAderx(1,1,1,1,1,2))
6546 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6547 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6548 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6549 & ADtEA1derx(1,1,1,1,1,2))
6551 C End 6-th order cumulants
6552 call transpose2(EUgder(1,1,j),auxmat(1,1))
6553 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6554 call transpose2(EUg(1,1,j),auxmat(1,1))
6555 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6556 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6560 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6561 & EAEAderx(1,1,lll,kkk,iii,2))
6566 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6567 C They are needed only when the fifth- or the sixth-order cumulants are
6569 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6570 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6571 call transpose2(AEA(1,1,1),auxmat(1,1))
6572 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6573 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6574 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6575 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6576 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6577 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6578 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6579 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6580 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6581 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6582 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6583 call transpose2(AEA(1,1,2),auxmat(1,1))
6584 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6585 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6586 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6587 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6588 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6589 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6590 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6591 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6592 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6593 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6594 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6595 C Calculate the Cartesian derivatives of the vectors.
6599 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6600 call matvec2(auxmat(1,1),b1(1,iti),
6601 & AEAb1derx(1,lll,kkk,iii,1,1))
6602 call matvec2(auxmat(1,1),Ub2(1,i),
6603 & AEAb2derx(1,lll,kkk,iii,1,1))
6604 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6605 & AEAb1derx(1,lll,kkk,iii,2,1))
6606 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6607 & AEAb2derx(1,lll,kkk,iii,2,1))
6608 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6609 call matvec2(auxmat(1,1),b1(1,itl),
6610 & AEAb1derx(1,lll,kkk,iii,1,2))
6611 call matvec2(auxmat(1,1),Ub2(1,l),
6612 & AEAb2derx(1,lll,kkk,iii,1,2))
6613 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6614 & AEAb1derx(1,lll,kkk,iii,2,2))
6615 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6616 & AEAb2derx(1,lll,kkk,iii,2,2))
6625 C---------------------------------------------------------------------------
6626 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6627 & KK,KKderg,AKA,AKAderg,AKAderx)
6631 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6632 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6633 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6638 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6640 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6643 cd if (lprn) write (2,*) 'In kernel'
6645 cd if (lprn) write (2,*) 'kkk=',kkk
6647 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6648 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6650 cd write (2,*) 'lll=',lll
6651 cd write (2,*) 'iii=1'
6653 cd write (2,'(3(2f10.5),5x)')
6654 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6657 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6658 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6660 cd write (2,*) 'lll=',lll
6661 cd write (2,*) 'iii=2'
6663 cd write (2,'(3(2f10.5),5x)')
6664 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6671 C---------------------------------------------------------------------------
6672 double precision function eello4(i,j,k,l,jj,kk)
6673 implicit real*8 (a-h,o-z)
6674 include 'DIMENSIONS'
6675 include 'DIMENSIONS.ZSCOPT'
6676 include 'COMMON.IOUNITS'
6677 include 'COMMON.CHAIN'
6678 include 'COMMON.DERIV'
6679 include 'COMMON.INTERACT'
6680 include 'COMMON.CONTACTS'
6681 include 'COMMON.TORSION'
6682 include 'COMMON.VAR'
6683 include 'COMMON.GEO'
6684 double precision pizda(2,2),ggg1(3),ggg2(3)
6685 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6689 cd print *,'eello4:',i,j,k,l,jj,kk
6690 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6691 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6692 cold eij=facont_hb(jj,i)
6693 cold ekl=facont_hb(kk,k)
6695 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6697 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6698 gcorr_loc(k-1)=gcorr_loc(k-1)
6699 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6701 gcorr_loc(l-1)=gcorr_loc(l-1)
6702 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6704 gcorr_loc(j-1)=gcorr_loc(j-1)
6705 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6710 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6711 & -EAEAderx(2,2,lll,kkk,iii,1)
6712 cd derx(lll,kkk,iii)=0.0d0
6716 cd gcorr_loc(l-1)=0.0d0
6717 cd gcorr_loc(j-1)=0.0d0
6718 cd gcorr_loc(k-1)=0.0d0
6720 cd write (iout,*)'Contacts have occurred for peptide groups',
6721 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6722 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6723 if (j.lt.nres-1) then
6730 if (l.lt.nres-1) then
6738 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6739 ggg1(ll)=eel4*g_contij(ll,1)
6740 ggg2(ll)=eel4*g_contij(ll,2)
6741 ghalf=0.5d0*ggg1(ll)
6743 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6744 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6745 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6746 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6747 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6748 ghalf=0.5d0*ggg2(ll)
6750 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6751 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6752 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6753 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6758 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6759 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6764 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6765 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6771 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6776 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6780 cd write (2,*) iii,gcorr_loc(iii)
6784 cd write (2,*) 'ekont',ekont
6785 cd write (iout,*) 'eello4',ekont*eel4
6788 C---------------------------------------------------------------------------
6789 double precision function eello5(i,j,k,l,jj,kk)
6790 implicit real*8 (a-h,o-z)
6791 include 'DIMENSIONS'
6792 include 'DIMENSIONS.ZSCOPT'
6793 include 'COMMON.IOUNITS'
6794 include 'COMMON.CHAIN'
6795 include 'COMMON.DERIV'
6796 include 'COMMON.INTERACT'
6797 include 'COMMON.CONTACTS'
6798 include 'COMMON.TORSION'
6799 include 'COMMON.VAR'
6800 include 'COMMON.GEO'
6801 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6802 double precision ggg1(3),ggg2(3)
6803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6808 C /l\ / \ \ / \ / \ / C
6809 C / \ / \ \ / \ / \ / C
6810 C j| o |l1 | o | o| o | | o |o C
6811 C \ |/k\| |/ \| / |/ \| |/ \| C
6812 C \i/ \ / \ / / \ / \ C
6814 C (I) (II) (III) (IV) C
6816 C eello5_1 eello5_2 eello5_3 eello5_4 C
6818 C Antiparallel chains C
6821 C /j\ / \ \ / \ / \ / C
6822 C / \ / \ \ / \ / \ / C
6823 C j1| o |l | o | o| o | | o |o C
6824 C \ |/k\| |/ \| / |/ \| |/ \| C
6825 C \i/ \ / \ / / \ / \ C
6827 C (I) (II) (III) (IV) C
6829 C eello5_1 eello5_2 eello5_3 eello5_4 C
6831 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6833 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6834 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6839 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6841 itk=itortyp(itype(k))
6842 itl=itortyp(itype(l))
6843 itj=itortyp(itype(j))
6848 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6849 cd & eel5_3_num,eel5_4_num)
6853 derx(lll,kkk,iii)=0.0d0
6857 cd eij=facont_hb(jj,i)
6858 cd ekl=facont_hb(kk,k)
6860 cd write (iout,*)'Contacts have occurred for peptide groups',
6861 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6863 C Contribution from the graph I.
6864 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6865 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6866 call transpose2(EUg(1,1,k),auxmat(1,1))
6867 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6868 vv(1)=pizda(1,1)-pizda(2,2)
6869 vv(2)=pizda(1,2)+pizda(2,1)
6870 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6871 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6873 C Explicit gradient in virtual-dihedral angles.
6874 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6875 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6876 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6877 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6878 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6879 vv(1)=pizda(1,1)-pizda(2,2)
6880 vv(2)=pizda(1,2)+pizda(2,1)
6881 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6882 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6883 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6884 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6885 vv(1)=pizda(1,1)-pizda(2,2)
6886 vv(2)=pizda(1,2)+pizda(2,1)
6888 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6889 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6890 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6892 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6893 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6894 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6896 C Cartesian gradient
6900 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6902 vv(1)=pizda(1,1)-pizda(2,2)
6903 vv(2)=pizda(1,2)+pizda(2,1)
6904 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6905 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6906 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6913 C Contribution from graph II
6914 call transpose2(EE(1,1,itk),auxmat(1,1))
6915 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6916 vv(1)=pizda(1,1)+pizda(2,2)
6917 vv(2)=pizda(2,1)-pizda(1,2)
6918 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6919 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6921 C Explicit gradient in virtual-dihedral angles.
6922 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6923 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6924 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6925 vv(1)=pizda(1,1)+pizda(2,2)
6926 vv(2)=pizda(2,1)-pizda(1,2)
6928 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6929 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6930 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6932 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6933 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6934 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6936 C Cartesian gradient
6940 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6942 vv(1)=pizda(1,1)+pizda(2,2)
6943 vv(2)=pizda(2,1)-pizda(1,2)
6944 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6945 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6946 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6955 C Parallel orientation
6956 C Contribution from graph III
6957 call transpose2(EUg(1,1,l),auxmat(1,1))
6958 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6959 vv(1)=pizda(1,1)-pizda(2,2)
6960 vv(2)=pizda(1,2)+pizda(2,1)
6961 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6962 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6964 C Explicit gradient in virtual-dihedral angles.
6965 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6966 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6967 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6968 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6969 vv(1)=pizda(1,1)-pizda(2,2)
6970 vv(2)=pizda(1,2)+pizda(2,1)
6971 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6972 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6973 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6974 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6975 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6976 vv(1)=pizda(1,1)-pizda(2,2)
6977 vv(2)=pizda(1,2)+pizda(2,1)
6978 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6979 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6980 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6981 C Cartesian gradient
6985 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6987 vv(1)=pizda(1,1)-pizda(2,2)
6988 vv(2)=pizda(1,2)+pizda(2,1)
6989 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6990 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6991 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6997 C Contribution from graph IV
6999 call transpose2(EE(1,1,itl),auxmat(1,1))
7000 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7001 vv(1)=pizda(1,1)+pizda(2,2)
7002 vv(2)=pizda(2,1)-pizda(1,2)
7003 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7004 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7006 C Explicit gradient in virtual-dihedral angles.
7007 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7008 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7009 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7010 vv(1)=pizda(1,1)+pizda(2,2)
7011 vv(2)=pizda(2,1)-pizda(1,2)
7012 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7013 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7014 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7015 C Cartesian gradient
7019 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7021 vv(1)=pizda(1,1)+pizda(2,2)
7022 vv(2)=pizda(2,1)-pizda(1,2)
7023 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7024 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7025 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7031 C Antiparallel orientation
7032 C Contribution from graph III
7034 call transpose2(EUg(1,1,j),auxmat(1,1))
7035 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7036 vv(1)=pizda(1,1)-pizda(2,2)
7037 vv(2)=pizda(1,2)+pizda(2,1)
7038 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7039 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7041 C Explicit gradient in virtual-dihedral angles.
7042 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7043 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7044 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7045 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7046 vv(1)=pizda(1,1)-pizda(2,2)
7047 vv(2)=pizda(1,2)+pizda(2,1)
7048 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7049 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7050 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7051 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7052 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7053 vv(1)=pizda(1,1)-pizda(2,2)
7054 vv(2)=pizda(1,2)+pizda(2,1)
7055 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7056 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7057 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7058 C Cartesian gradient
7062 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7064 vv(1)=pizda(1,1)-pizda(2,2)
7065 vv(2)=pizda(1,2)+pizda(2,1)
7066 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7067 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7068 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7074 C Contribution from graph IV
7076 call transpose2(EE(1,1,itj),auxmat(1,1))
7077 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7078 vv(1)=pizda(1,1)+pizda(2,2)
7079 vv(2)=pizda(2,1)-pizda(1,2)
7080 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7081 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7083 C Explicit gradient in virtual-dihedral angles.
7084 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7085 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7086 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7087 vv(1)=pizda(1,1)+pizda(2,2)
7088 vv(2)=pizda(2,1)-pizda(1,2)
7089 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7090 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7091 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7092 C Cartesian gradient
7096 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7098 vv(1)=pizda(1,1)+pizda(2,2)
7099 vv(2)=pizda(2,1)-pizda(1,2)
7100 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7101 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7102 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7109 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7110 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7111 cd write (2,*) 'ijkl',i,j,k,l
7112 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7113 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7115 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7116 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7117 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7118 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7120 if (j.lt.nres-1) then
7127 if (l.lt.nres-1) then
7137 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7139 ggg1(ll)=eel5*g_contij(ll,1)
7140 ggg2(ll)=eel5*g_contij(ll,2)
7141 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7142 ghalf=0.5d0*ggg1(ll)
7144 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7145 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7146 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7147 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7148 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7149 ghalf=0.5d0*ggg2(ll)
7151 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7152 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7153 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7154 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7159 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7160 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7165 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7166 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7172 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7177 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7181 cd write (2,*) iii,g_corr5_loc(iii)
7185 cd write (2,*) 'ekont',ekont
7186 cd write (iout,*) 'eello5',ekont*eel5
7189 c--------------------------------------------------------------------------
7190 double precision function eello6(i,j,k,l,jj,kk)
7191 implicit real*8 (a-h,o-z)
7192 include 'DIMENSIONS'
7193 include 'DIMENSIONS.ZSCOPT'
7194 include 'COMMON.IOUNITS'
7195 include 'COMMON.CHAIN'
7196 include 'COMMON.DERIV'
7197 include 'COMMON.INTERACT'
7198 include 'COMMON.CONTACTS'
7199 include 'COMMON.TORSION'
7200 include 'COMMON.VAR'
7201 include 'COMMON.GEO'
7202 include 'COMMON.FFIELD'
7203 double precision ggg1(3),ggg2(3)
7204 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7209 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7217 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7218 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7222 derx(lll,kkk,iii)=0.0d0
7226 cd eij=facont_hb(jj,i)
7227 cd ekl=facont_hb(kk,k)
7233 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7234 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7235 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7236 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7237 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7238 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7240 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7241 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7242 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7243 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7244 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7245 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7249 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7251 C If turn contributions are considered, they will be handled separately.
7252 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7253 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7254 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7255 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7256 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7257 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7258 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7261 if (j.lt.nres-1) then
7268 if (l.lt.nres-1) then
7276 ggg1(ll)=eel6*g_contij(ll,1)
7277 ggg2(ll)=eel6*g_contij(ll,2)
7278 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7279 ghalf=0.5d0*ggg1(ll)
7281 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7282 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7283 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7284 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7285 ghalf=0.5d0*ggg2(ll)
7286 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7288 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7289 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7290 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7291 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7296 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7297 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7302 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7303 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7309 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7314 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7318 cd write (2,*) iii,g_corr6_loc(iii)
7322 cd write (2,*) 'ekont',ekont
7323 cd write (iout,*) 'eello6',ekont*eel6
7326 c--------------------------------------------------------------------------
7327 double precision function eello6_graph1(i,j,k,l,imat,swap)
7328 implicit real*8 (a-h,o-z)
7329 include 'DIMENSIONS'
7330 include 'DIMENSIONS.ZSCOPT'
7331 include 'COMMON.IOUNITS'
7332 include 'COMMON.CHAIN'
7333 include 'COMMON.DERIV'
7334 include 'COMMON.INTERACT'
7335 include 'COMMON.CONTACTS'
7336 include 'COMMON.TORSION'
7337 include 'COMMON.VAR'
7338 include 'COMMON.GEO'
7339 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7343 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7345 C Parallel Antiparallel C
7351 C \ j|/k\| / \ |/k\|l / C
7356 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7357 itk=itortyp(itype(k))
7358 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7359 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7360 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7361 call transpose2(EUgC(1,1,k),auxmat(1,1))
7362 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7363 vv1(1)=pizda1(1,1)-pizda1(2,2)
7364 vv1(2)=pizda1(1,2)+pizda1(2,1)
7365 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7366 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7367 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7368 s5=scalar2(vv(1),Dtobr2(1,i))
7369 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7370 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7371 if (.not. calc_grad) return
7372 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7373 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7374 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7375 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7376 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7377 & +scalar2(vv(1),Dtobr2der(1,i)))
7378 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7382 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7384 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7385 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7386 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7387 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7388 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7390 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7391 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7392 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7393 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7394 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7396 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7397 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7398 vv1(1)=pizda1(1,1)-pizda1(2,2)
7399 vv1(2)=pizda1(1,2)+pizda1(2,1)
7400 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7401 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7402 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7403 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7412 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7413 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7414 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7415 call transpose2(EUgC(1,1,k),auxmat(1,1))
7416 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7418 vv1(1)=pizda1(1,1)-pizda1(2,2)
7419 vv1(2)=pizda1(1,2)+pizda1(2,1)
7420 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7421 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7422 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7423 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7424 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7425 s5=scalar2(vv(1),Dtobr2(1,i))
7426 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7432 c----------------------------------------------------------------------------
7433 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7434 implicit real*8 (a-h,o-z)
7435 include 'DIMENSIONS'
7436 include 'DIMENSIONS.ZSCOPT'
7437 include 'COMMON.IOUNITS'
7438 include 'COMMON.CHAIN'
7439 include 'COMMON.DERIV'
7440 include 'COMMON.INTERACT'
7441 include 'COMMON.CONTACTS'
7442 include 'COMMON.TORSION'
7443 include 'COMMON.VAR'
7444 include 'COMMON.GEO'
7446 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7447 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7450 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7452 C Parallel Antiparallel C
7458 C \ j|/k\| \ |/k\|l C
7463 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7464 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7465 C AL 7/4/01 s1 would occur in the sixth-order moment,
7466 C but not in a cluster cumulant
7468 s1=dip(1,jj,i)*dip(1,kk,k)
7470 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7471 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7472 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7473 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7474 call transpose2(EUg(1,1,k),auxmat(1,1))
7475 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7476 vv(1)=pizda(1,1)-pizda(2,2)
7477 vv(2)=pizda(1,2)+pizda(2,1)
7478 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7479 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7481 eello6_graph2=-(s1+s2+s3+s4)
7483 eello6_graph2=-(s2+s3+s4)
7486 if (.not. calc_grad) return
7487 C Derivatives in gamma(i-1)
7490 s1=dipderg(1,jj,i)*dip(1,kk,k)
7492 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7493 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7494 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7495 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7497 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7501 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7503 C Derivatives in gamma(k-1)
7505 s1=dip(1,jj,i)*dipderg(1,kk,k)
7507 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7508 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7509 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7510 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7511 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7512 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7513 vv(1)=pizda(1,1)-pizda(2,2)
7514 vv(2)=pizda(1,2)+pizda(2,1)
7515 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7517 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7519 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7521 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7522 C Derivatives in gamma(j-1) or gamma(l-1)
7525 s1=dipderg(3,jj,i)*dip(1,kk,k)
7527 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7528 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7529 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7530 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7531 vv(1)=pizda(1,1)-pizda(2,2)
7532 vv(2)=pizda(1,2)+pizda(2,1)
7533 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7536 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7538 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7541 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7542 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7544 C Derivatives in gamma(l-1) or gamma(j-1)
7547 s1=dip(1,jj,i)*dipderg(3,kk,k)
7549 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7550 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7551 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7552 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7553 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7559 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7561 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7564 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7565 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7567 C Cartesian derivatives.
7569 write (2,*) 'In eello6_graph2'
7571 write (2,*) 'iii=',iii
7573 write (2,*) 'kkk=',kkk
7575 write (2,'(3(2f10.5),5x)')
7576 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7586 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7588 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7591 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7593 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7594 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7596 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7597 call transpose2(EUg(1,1,k),auxmat(1,1))
7598 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7600 vv(1)=pizda(1,1)-pizda(2,2)
7601 vv(2)=pizda(1,2)+pizda(2,1)
7602 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7603 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7605 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7607 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7612 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7619 c----------------------------------------------------------------------------
7620 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7621 implicit real*8 (a-h,o-z)
7622 include 'DIMENSIONS'
7623 include 'DIMENSIONS.ZSCOPT'
7624 include 'COMMON.IOUNITS'
7625 include 'COMMON.CHAIN'
7626 include 'COMMON.DERIV'
7627 include 'COMMON.INTERACT'
7628 include 'COMMON.CONTACTS'
7629 include 'COMMON.TORSION'
7630 include 'COMMON.VAR'
7631 include 'COMMON.GEO'
7632 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7634 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7636 C Parallel Antiparallel C
7642 C j|/k\| / |/k\|l / C
7647 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7649 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7650 C energy moment and not to the cluster cumulant.
7651 iti=itortyp(itype(i))
7652 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7653 itj1=itortyp(itype(j+1))
7657 itk=itortyp(itype(k))
7658 itk1=itortyp(itype(k+1))
7659 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7660 itl1=itortyp(itype(l+1))
7665 s1=dip(4,jj,i)*dip(4,kk,k)
7667 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7668 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7669 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7670 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7671 call transpose2(EE(1,1,itk),auxmat(1,1))
7672 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7673 vv(1)=pizda(1,1)+pizda(2,2)
7674 vv(2)=pizda(2,1)-pizda(1,2)
7675 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7676 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7678 eello6_graph3=-(s1+s2+s3+s4)
7680 eello6_graph3=-(s2+s3+s4)
7683 if (.not. calc_grad) return
7684 C Derivatives in gamma(k-1)
7685 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7686 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7687 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7688 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7689 C Derivatives in gamma(l-1)
7690 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7691 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7692 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7693 vv(1)=pizda(1,1)+pizda(2,2)
7694 vv(2)=pizda(2,1)-pizda(1,2)
7695 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7696 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7697 C Cartesian derivatives.
7703 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7705 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7708 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7710 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7711 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7713 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7714 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7716 vv(1)=pizda(1,1)+pizda(2,2)
7717 vv(2)=pizda(2,1)-pizda(1,2)
7718 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7720 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7722 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7725 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7727 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7729 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7735 c----------------------------------------------------------------------------
7736 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7737 implicit real*8 (a-h,o-z)
7738 include 'DIMENSIONS'
7739 include 'DIMENSIONS.ZSCOPT'
7740 include 'COMMON.IOUNITS'
7741 include 'COMMON.CHAIN'
7742 include 'COMMON.DERIV'
7743 include 'COMMON.INTERACT'
7744 include 'COMMON.CONTACTS'
7745 include 'COMMON.TORSION'
7746 include 'COMMON.VAR'
7747 include 'COMMON.GEO'
7748 include 'COMMON.FFIELD'
7749 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7750 & auxvec1(2),auxmat1(2,2)
7752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7754 C Parallel Antiparallel C
7760 C \ j|/k\| \ |/k\|l C
7765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7767 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7768 C energy moment and not to the cluster cumulant.
7769 cd write (2,*) 'eello_graph4: wturn6',wturn6
7770 iti=itortyp(itype(i))
7771 itj=itortyp(itype(j))
7772 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7773 itj1=itortyp(itype(j+1))
7777 itk=itortyp(itype(k))
7778 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7779 itk1=itortyp(itype(k+1))
7783 itl=itortyp(itype(l))
7784 if (l.lt.nres-1) then
7785 itl1=itortyp(itype(l+1))
7789 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7790 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7791 cd & ' itl',itl,' itl1',itl1
7794 s1=dip(3,jj,i)*dip(3,kk,k)
7796 s1=dip(2,jj,j)*dip(2,kk,l)
7799 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7800 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7802 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7803 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7805 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7806 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7808 call transpose2(EUg(1,1,k),auxmat(1,1))
7809 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7810 vv(1)=pizda(1,1)-pizda(2,2)
7811 vv(2)=pizda(2,1)+pizda(1,2)
7812 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7813 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7815 eello6_graph4=-(s1+s2+s3+s4)
7817 eello6_graph4=-(s2+s3+s4)
7819 if (.not. calc_grad) return
7820 C Derivatives in gamma(i-1)
7824 s1=dipderg(2,jj,i)*dip(3,kk,k)
7826 s1=dipderg(4,jj,j)*dip(2,kk,l)
7829 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7831 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7832 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7834 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7835 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7837 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7838 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7839 cd write (2,*) 'turn6 derivatives'
7841 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7843 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7847 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7849 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7853 C Derivatives in gamma(k-1)
7856 s1=dip(3,jj,i)*dipderg(2,kk,k)
7858 s1=dip(2,jj,j)*dipderg(4,kk,l)
7861 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7862 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7864 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7865 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7867 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7868 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7870 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7871 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7872 vv(1)=pizda(1,1)-pizda(2,2)
7873 vv(2)=pizda(2,1)+pizda(1,2)
7874 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7875 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7877 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7879 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7883 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7885 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7888 C Derivatives in gamma(j-1) or gamma(l-1)
7889 if (l.eq.j+1 .and. l.gt.1) then
7890 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7891 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7892 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7893 vv(1)=pizda(1,1)-pizda(2,2)
7894 vv(2)=pizda(2,1)+pizda(1,2)
7895 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7896 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7897 else if (j.gt.1) then
7898 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7899 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7900 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7901 vv(1)=pizda(1,1)-pizda(2,2)
7902 vv(2)=pizda(2,1)+pizda(1,2)
7903 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7904 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7905 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7907 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7910 C Cartesian derivatives.
7917 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7919 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7923 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7925 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7929 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7931 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7933 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7934 & b1(1,itj1),auxvec(1))
7935 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7937 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7938 & b1(1,itl1),auxvec(1))
7939 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7941 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7943 vv(1)=pizda(1,1)-pizda(2,2)
7944 vv(2)=pizda(2,1)+pizda(1,2)
7945 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7947 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7949 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7952 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7955 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7958 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7960 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7962 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7966 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7968 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7971 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7973 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7981 c----------------------------------------------------------------------------
7982 double precision function eello_turn6(i,jj,kk)
7983 implicit real*8 (a-h,o-z)
7984 include 'DIMENSIONS'
7985 include 'DIMENSIONS.ZSCOPT'
7986 include 'COMMON.IOUNITS'
7987 include 'COMMON.CHAIN'
7988 include 'COMMON.DERIV'
7989 include 'COMMON.INTERACT'
7990 include 'COMMON.CONTACTS'
7991 include 'COMMON.TORSION'
7992 include 'COMMON.VAR'
7993 include 'COMMON.GEO'
7994 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7995 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7997 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7998 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7999 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8000 C the respective energy moment and not to the cluster cumulant.
8005 iti=itortyp(itype(i))
8006 itk=itortyp(itype(k))
8007 itk1=itortyp(itype(k+1))
8008 itl=itortyp(itype(l))
8009 itj=itortyp(itype(j))
8010 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8011 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8012 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8017 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8019 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8023 derx_turn(lll,kkk,iii)=0.0d0
8030 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8032 cd write (2,*) 'eello6_5',eello6_5
8034 call transpose2(AEA(1,1,1),auxmat(1,1))
8035 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8036 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8037 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8041 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8042 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8043 s2 = scalar2(b1(1,itk),vtemp1(1))
8045 call transpose2(AEA(1,1,2),atemp(1,1))
8046 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8047 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8048 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8052 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8053 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8054 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8056 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8057 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8058 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8059 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8060 ss13 = scalar2(b1(1,itk),vtemp4(1))
8061 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8065 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8071 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8073 C Derivatives in gamma(i+2)
8075 call transpose2(AEA(1,1,1),auxmatd(1,1))
8076 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8077 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8078 call transpose2(AEAderg(1,1,2),atempd(1,1))
8079 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8080 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8084 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8085 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8086 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8092 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8093 C Derivatives in gamma(i+3)
8095 call transpose2(AEA(1,1,1),auxmatd(1,1))
8096 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8097 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8098 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8102 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8103 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8104 s2d = scalar2(b1(1,itk),vtemp1d(1))
8106 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8107 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8109 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8111 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8112 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8113 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8123 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8124 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8126 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8127 & -0.5d0*ekont*(s2d+s12d)
8129 C Derivatives in gamma(i+4)
8130 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8131 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8132 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8134 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8135 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8136 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8146 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8148 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8150 C Derivatives in gamma(i+5)
8152 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8153 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8154 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8158 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8159 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8160 s2d = scalar2(b1(1,itk),vtemp1d(1))
8162 call transpose2(AEA(1,1,2),atempd(1,1))
8163 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8164 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8168 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8169 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8171 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8172 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8173 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8183 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8184 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8186 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8187 & -0.5d0*ekont*(s2d+s12d)
8189 C Cartesian derivatives
8194 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8195 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8196 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8200 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8201 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8203 s2d = scalar2(b1(1,itk),vtemp1d(1))
8205 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8206 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8207 s8d = -(atempd(1,1)+atempd(2,2))*
8208 & scalar2(cc(1,1,itl),vtemp2(1))
8212 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8214 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8215 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8222 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8225 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8229 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8230 & - 0.5d0*(s8d+s12d)
8232 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8241 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8243 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8244 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8245 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8246 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8247 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8249 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8250 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8251 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8255 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8256 cd & 16*eel_turn6_num
8258 if (j.lt.nres-1) then
8265 if (l.lt.nres-1) then
8273 ggg1(ll)=eel_turn6*g_contij(ll,1)
8274 ggg2(ll)=eel_turn6*g_contij(ll,2)
8275 ghalf=0.5d0*ggg1(ll)
8277 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8278 & +ekont*derx_turn(ll,2,1)
8279 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8280 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8281 & +ekont*derx_turn(ll,4,1)
8282 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8283 ghalf=0.5d0*ggg2(ll)
8285 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8286 & +ekont*derx_turn(ll,2,2)
8287 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8288 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8289 & +ekont*derx_turn(ll,4,2)
8290 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8295 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8300 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8306 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8311 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8315 cd write (2,*) iii,g_corr6_loc(iii)
8318 eello_turn6=ekont*eel_turn6
8319 cd write (2,*) 'ekont',ekont
8320 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8323 crc-------------------------------------------------
8324 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8325 subroutine Eliptransfer(eliptran)
8326 implicit real*8 (a-h,o-z)
8327 include 'DIMENSIONS'
8328 include 'COMMON.GEO'
8329 include 'COMMON.VAR'
8330 include 'COMMON.LOCAL'
8331 include 'COMMON.CHAIN'
8332 include 'COMMON.DERIV'
8333 include 'COMMON.INTERACT'
8334 include 'COMMON.IOUNITS'
8335 include 'COMMON.CALC'
8336 include 'COMMON.CONTROL'
8337 include 'COMMON.SPLITELE'
8338 include 'COMMON.SBRIDGE'
8339 C this is done by Adasko
8343 C--bordliptop-- buffore starts
8344 C--bufliptop--- here true lipid starts
8346 C--buflipbot--- lipid ends buffore starts
8347 C--bordlipbot--buffore ends
8351 if (itype(i).eq.ntyp1) cycle
8353 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8354 if (positi.le.0) positi=positi+boxzsize
8356 C first for peptide groups
8357 c for each residue check if it is in lipid or lipid water border area
8358 if ((positi.gt.bordlipbot)
8359 &.and.(positi.lt.bordliptop)) then
8360 C the energy transfer exist
8361 if (positi.lt.buflipbot) then
8362 C what fraction I am in
8364 & ((positi-bordlipbot)/lipbufthick)
8365 C lipbufthick is thickenes of lipid buffore
8366 sslip=sscalelip(fracinbuf)
8367 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8368 eliptran=eliptran+sslip*pepliptran
8369 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8370 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8371 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8372 elseif (positi.gt.bufliptop) then
8373 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8374 sslip=sscalelip(fracinbuf)
8375 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8376 eliptran=eliptran+sslip*pepliptran
8377 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8378 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8379 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8380 C print *, "doing sscalefor top part"
8381 C print *,i,sslip,fracinbuf,ssgradlip
8383 eliptran=eliptran+pepliptran
8384 C print *,"I am in true lipid"
8387 C eliptran=elpitran+0.0 ! I am in water
8390 C print *, "nic nie bylo w lipidzie?"
8391 C now multiply all by the peptide group transfer factor
8392 C eliptran=eliptran*pepliptran
8393 C now the same for side chains
8396 if (itype(i).eq.ntyp1) cycle
8397 positi=(mod(c(3,i+nres),boxzsize))
8398 if (positi.le.0) positi=positi+boxzsize
8399 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8400 c for each residue check if it is in lipid or lipid water border area
8401 C respos=mod(c(3,i+nres),boxzsize)
8402 C print *,positi,bordlipbot,buflipbot
8403 if ((positi.gt.bordlipbot)
8404 & .and.(positi.lt.bordliptop)) then
8405 C the energy transfer exist
8406 if (positi.lt.buflipbot) then
8408 & ((positi-bordlipbot)/lipbufthick)
8409 C lipbufthick is thickenes of lipid buffore
8410 sslip=sscalelip(fracinbuf)
8411 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8412 eliptran=eliptran+sslip*liptranene(itype(i))
8413 gliptranx(3,i)=gliptranx(3,i)
8414 &+ssgradlip*liptranene(itype(i))
8415 gliptranc(3,i-1)= gliptranc(3,i-1)
8416 &+ssgradlip*liptranene(itype(i))
8417 C print *,"doing sccale for lower part"
8418 elseif (positi.gt.bufliptop) then
8420 &((bordliptop-positi)/lipbufthick)
8421 sslip=sscalelip(fracinbuf)
8422 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8423 eliptran=eliptran+sslip*liptranene(itype(i))
8424 gliptranx(3,i)=gliptranx(3,i)
8425 &+ssgradlip*liptranene(itype(i))
8426 gliptranc(3,i-1)= gliptranc(3,i-1)
8427 &+ssgradlip*liptranene(itype(i))
8428 C print *, "doing sscalefor top part",sslip,fracinbuf
8430 eliptran=eliptran+liptranene(itype(i))
8431 C print *,"I am in true lipid"
8433 endif ! if in lipid or buffor
8435 C eliptran=elpitran+0.0 ! I am in water
8441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8443 SUBROUTINE MATVEC2(A1,V1,V2)
8444 implicit real*8 (a-h,o-z)
8445 include 'DIMENSIONS'
8446 DIMENSION A1(2,2),V1(2),V2(2)
8450 c 3 VI=VI+A1(I,K)*V1(K)
8454 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8455 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8460 C---------------------------------------
8461 SUBROUTINE MATMAT2(A1,A2,A3)
8462 implicit real*8 (a-h,o-z)
8463 include 'DIMENSIONS'
8464 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8465 c DIMENSION AI3(2,2)
8469 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8475 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8476 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8477 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8478 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8486 c-------------------------------------------------------------------------
8487 double precision function scalar2(u,v)
8489 double precision u(2),v(2)
8492 scalar2=u(1)*v(1)+u(2)*v(2)
8496 C-----------------------------------------------------------------------------
8498 subroutine transpose2(a,at)
8500 double precision a(2,2),at(2,2)
8507 c--------------------------------------------------------------------------
8508 subroutine transpose(n,a,at)
8511 double precision a(n,n),at(n,n)
8519 C---------------------------------------------------------------------------
8520 subroutine prodmat3(a1,a2,kk,transp,prod)
8523 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8525 crc double precision auxmat(2,2),prod_(2,2)
8528 crc call transpose2(kk(1,1),auxmat(1,1))
8529 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8530 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8532 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8533 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8534 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8535 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8536 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8537 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8538 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8539 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8542 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8543 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8545 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8546 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8547 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8548 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8549 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8550 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8551 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8552 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8555 c call transpose2(a2(1,1),a2t(1,1))
8558 crc print *,((prod_(i,j),i=1,2),j=1,2)
8559 crc print *,((prod(i,j),i=1,2),j=1,2)
8563 C-----------------------------------------------------------------------------
8564 double precision function scalar(u,v)
8566 double precision u(3),v(3)
8576 C-----------------------------------------------------------------------
8577 double precision function sscale(r)
8578 double precision r,gamm
8579 include "COMMON.SPLITELE"
8580 if(r.lt.r_cut-rlamb) then
8582 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8583 gamm=(r-(r_cut-rlamb))/rlamb
8584 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8590 C-----------------------------------------------------------------------
8591 C-----------------------------------------------------------------------
8592 double precision function sscagrad(r)
8593 double precision r,gamm
8594 include "COMMON.SPLITELE"
8595 if(r.lt.r_cut-rlamb) then
8597 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8598 gamm=(r-(r_cut-rlamb))/rlamb
8599 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8605 C-----------------------------------------------------------------------
8606 C-----------------------------------------------------------------------
8607 double precision function sscalelip(r)
8608 double precision r,gamm
8609 include "COMMON.SPLITELE"
8610 C if(r.lt.r_cut-rlamb) then
8612 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8613 C gamm=(r-(r_cut-rlamb))/rlamb
8614 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8620 C-----------------------------------------------------------------------
8621 double precision function sscagradlip(r)
8622 double precision r,gamm
8623 include "COMMON.SPLITELE"
8624 C if(r.lt.r_cut-rlamb) then
8626 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8627 C gamm=(r-(r_cut-rlamb))/rlamb
8628 sscagradlip=r*(6*r-6.0d0)
8635 C-----------------------------------------------------------------------
8636 subroutine set_shield_fac
8637 implicit real*8 (a-h,o-z)
8638 include 'DIMENSIONS'
8639 include 'COMMON.CHAIN'
8640 include 'COMMON.DERIV'
8641 include 'COMMON.IOUNITS'
8642 include 'COMMON.SHIELD'
8643 include 'COMMON.INTERACT'
8644 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8645 double precision div77_81/0.974996043d0/,
8646 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8648 C the vector between center of side_chain and peptide group
8649 double precision pep_side(3),long,side_calf(3),
8650 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8651 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8652 C the line belowe needs to be changed for FGPROC>1
8654 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8656 Cif there two consequtive dummy atoms there is no peptide group between them
8657 C the line below has to be changed for FGPROC>1
8660 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8664 C first lets set vector conecting the ithe side-chain with kth side-chain
8665 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8667 C and vector conecting the side-chain with its proper calfa
8668 side_calf(j)=c(j,k+nres)-c(j,k)
8669 C side_calf(j)=2.0d0
8670 pept_group(j)=c(j,i)-c(j,i+1)
8671 C lets have their lenght
8672 dist_pep_side=pep_side(j)**2+dist_pep_side
8673 dist_side_calf=dist_side_calf+side_calf(j)**2
8674 dist_pept_group=dist_pept_group+pept_group(j)**2
8676 dist_pep_side=dsqrt(dist_pep_side)
8677 dist_pept_group=dsqrt(dist_pept_group)
8678 dist_side_calf=dsqrt(dist_side_calf)
8680 pep_side_norm(j)=pep_side(j)/dist_pep_side
8681 side_calf_norm(j)=dist_side_calf
8683 C now sscale fraction
8684 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8685 C print *,buff_shield,"buff"
8687 if (sh_frac_dist.le.0.0) cycle
8688 C If we reach here it means that this side chain reaches the shielding sphere
8689 C Lets add him to the list for gradient
8690 ishield_list(i)=ishield_list(i)+1
8691 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8692 C this list is essential otherwise problem would be O3
8693 shield_list(ishield_list(i),i)=k
8694 C Lets have the sscale value
8695 if (sh_frac_dist.gt.1.0) then
8696 scale_fac_dist=1.0d0
8698 sh_frac_dist_grad(j)=0.0d0
8701 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8702 & *(2.0*sh_frac_dist-3.0d0)
8703 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8704 & /dist_pep_side/buff_shield*0.5
8705 C remember for the final gradient multiply sh_frac_dist_grad(j)
8706 C for side_chain by factor -2 !
8708 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8709 C print *,"jestem",scale_fac_dist,fac_help_scale,
8710 C & sh_frac_dist_grad(j)
8713 C if ((i.eq.3).and.(k.eq.2)) then
8714 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8718 C this is what is now we have the distance scaling now volume...
8719 short=short_r_sidechain(itype(k))
8720 long=long_r_sidechain(itype(k))
8721 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8724 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8727 costhet_grad(j)=costhet_fac*pep_side(j)
8729 C remember for the final gradient multiply costhet_grad(j)
8730 C for side_chain by factor -2 !
8731 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8732 C pep_side0pept_group is vector multiplication
8733 pep_side0pept_group=0.0
8735 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8737 cosalfa=(pep_side0pept_group/
8738 & (dist_pep_side*dist_side_calf))
8739 fac_alfa_sin=1.0-cosalfa**2
8740 fac_alfa_sin=dsqrt(fac_alfa_sin)
8741 rkprim=fac_alfa_sin*(long-short)+short
8743 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8744 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8747 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8748 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8749 &*(long-short)/fac_alfa_sin*cosalfa/
8750 &((dist_pep_side*dist_side_calf))*
8751 &((side_calf(j))-cosalfa*
8752 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8754 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8755 &*(long-short)/fac_alfa_sin*cosalfa
8756 &/((dist_pep_side*dist_side_calf))*
8758 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8761 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8764 C now the gradient...
8765 C grad_shield is gradient of Calfa for peptide groups
8766 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8768 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8769 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8771 grad_shield(j,i)=grad_shield(j,i)
8772 C gradient po skalowaniu
8773 & +(sh_frac_dist_grad(j)
8774 C gradient po costhet
8775 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8776 &-scale_fac_dist*(cosphi_grad_long(j))
8777 &/(1.0-cosphi) )*div77_81
8779 C grad_shield_side is Cbeta sidechain gradient
8780 grad_shield_side(j,ishield_list(i),i)=
8781 & (sh_frac_dist_grad(j)*-2.0d0
8782 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8783 & +scale_fac_dist*(cosphi_grad_long(j))
8784 & *2.0d0/(1.0-cosphi))
8785 & *div77_81*VofOverlap
8787 grad_shield_loc(j,ishield_list(i),i)=
8788 & scale_fac_dist*cosphi_grad_loc(j)
8789 & *2.0d0/(1.0-cosphi)
8790 & *div77_81*VofOverlap
8792 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8794 fac_shield(i)=VolumeTotal*div77_81+div4_81
8795 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8799 C--------------------------------------------------------------------------
8800 C first for shielding is setting of function of side-chains
8801 subroutine set_shield_fac2
8802 implicit real*8 (a-h,o-z)
8803 include 'DIMENSIONS'
8804 include 'COMMON.CHAIN'
8805 include 'COMMON.DERIV'
8806 include 'COMMON.IOUNITS'
8807 include 'COMMON.SHIELD'
8808 include 'COMMON.INTERACT'
8809 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8810 double precision div77_81/0.974996043d0/,
8811 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8813 C the vector between center of side_chain and peptide group
8814 double precision pep_side(3),long,side_calf(3),
8815 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8816 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8817 C the line belowe needs to be changed for FGPROC>1
8819 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8821 Cif there two consequtive dummy atoms there is no peptide group between them
8822 C the line below has to be changed for FGPROC>1
8825 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8829 C first lets set vector conecting the ithe side-chain with kth side-chain
8830 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8832 C and vector conecting the side-chain with its proper calfa
8833 side_calf(j)=c(j,k+nres)-c(j,k)
8834 C side_calf(j)=2.0d0
8835 pept_group(j)=c(j,i)-c(j,i+1)
8836 C lets have their lenght
8837 dist_pep_side=pep_side(j)**2+dist_pep_side
8838 dist_side_calf=dist_side_calf+side_calf(j)**2
8839 dist_pept_group=dist_pept_group+pept_group(j)**2
8841 dist_pep_side=dsqrt(dist_pep_side)
8842 dist_pept_group=dsqrt(dist_pept_group)
8843 dist_side_calf=dsqrt(dist_side_calf)
8845 pep_side_norm(j)=pep_side(j)/dist_pep_side
8846 side_calf_norm(j)=dist_side_calf
8848 C now sscale fraction
8849 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8850 C print *,buff_shield,"buff"
8852 if (sh_frac_dist.le.0.0) cycle
8853 C If we reach here it means that this side chain reaches the shielding sphere
8854 C Lets add him to the list for gradient
8855 ishield_list(i)=ishield_list(i)+1
8856 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8857 C this list is essential otherwise problem would be O3
8858 shield_list(ishield_list(i),i)=k
8859 C Lets have the sscale value
8860 if (sh_frac_dist.gt.1.0) then
8861 scale_fac_dist=1.0d0
8863 sh_frac_dist_grad(j)=0.0d0
8866 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8867 & *(2.0d0*sh_frac_dist-3.0d0)
8868 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8869 & /dist_pep_side/buff_shield*0.5d0
8870 C remember for the final gradient multiply sh_frac_dist_grad(j)
8871 C for side_chain by factor -2 !
8873 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8874 C sh_frac_dist_grad(j)=0.0d0
8875 C scale_fac_dist=1.0d0
8876 C print *,"jestem",scale_fac_dist,fac_help_scale,
8877 C & sh_frac_dist_grad(j)
8880 C this is what is now we have the distance scaling now volume...
8881 short=short_r_sidechain(itype(k))
8882 long=long_r_sidechain(itype(k))
8883 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8884 sinthet=short/dist_pep_side*costhet
8888 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8889 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8890 C & -short/dist_pep_side**2/costhet)
8893 costhet_grad(j)=costhet_fac*pep_side(j)
8895 C remember for the final gradient multiply costhet_grad(j)
8896 C for side_chain by factor -2 !
8897 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8898 C pep_side0pept_group is vector multiplication
8899 pep_side0pept_group=0.0d0
8901 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8903 cosalfa=(pep_side0pept_group/
8904 & (dist_pep_side*dist_side_calf))
8905 fac_alfa_sin=1.0d0-cosalfa**2
8906 fac_alfa_sin=dsqrt(fac_alfa_sin)
8907 rkprim=fac_alfa_sin*(long-short)+short
8911 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8913 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8914 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8918 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8919 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8920 &*(long-short)/fac_alfa_sin*cosalfa/
8921 &((dist_pep_side*dist_side_calf))*
8922 &((side_calf(j))-cosalfa*
8923 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8924 C cosphi_grad_long(j)=0.0d0
8925 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8926 &*(long-short)/fac_alfa_sin*cosalfa
8927 &/((dist_pep_side*dist_side_calf))*
8929 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8930 C cosphi_grad_loc(j)=0.0d0
8932 C print *,sinphi,sinthet
8933 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8936 C now the gradient...
8938 grad_shield(j,i)=grad_shield(j,i)
8939 C gradient po skalowaniu
8940 & +(sh_frac_dist_grad(j)*VofOverlap
8941 C gradient po costhet
8942 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8943 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8944 & sinphi/sinthet*costhet*costhet_grad(j)
8945 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8947 C grad_shield_side is Cbeta sidechain gradient
8948 grad_shield_side(j,ishield_list(i),i)=
8949 & (sh_frac_dist_grad(j)*-2.0d0
8951 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8952 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8953 & sinphi/sinthet*costhet*costhet_grad(j)
8954 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8957 grad_shield_loc(j,ishield_list(i),i)=
8958 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8959 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8960 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8964 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8966 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8967 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8968 C write(2,*) "TU",rpp(1,1),short,long,buff_shield