1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
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)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
53 C write(iout,*) "shield_mode",shield_mode,ethetacnstr
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)
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
69 c write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 call ebend(ebe,ethetacnstr)
80 cd print *,'Bend energy finished.'
82 C Calculate the SC local energy.
85 cd print *,'SCLOC energy finished.'
87 C Calculate the virtual-bond torsional energy.
89 cd print *,'nterm=',nterm
90 call etor(etors,edihcnstr,fact(1))
92 C 6/23/01 Calculate double-torsional energy
94 call etor_d(etors_d,fact(2))
96 C 21/5/07 Calculate local sicdechain correlation energy
98 call eback_sc_corr(esccor)
100 if (wliptran.gt.0) then
101 call Eliptransfer(eliptran)
105 C 12/1/95 Multi-body terms
109 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
110 & .or. wturn6.gt.0.0d0) then
111 c print *,"calling multibody_eello"
112 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
113 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
114 c print *,ecorr,ecorr5,ecorr6,eturn6
116 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
117 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
119 write (iout,*) "ft(6)",fact(6),wliptran,eliptran
121 if (shield_mode.gt.0) then
122 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
124 & +fact(1)*wvdwpp*evdw1
125 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
126 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
127 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
128 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
129 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
130 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
133 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
135 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
136 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
137 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
138 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
139 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
140 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
144 if (shield_mode.gt.0) then
145 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
146 & +welec*fact(1)*(ees+evdw1)
147 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
148 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
149 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
150 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
151 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
152 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
155 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
156 & +welec*fact(1)*(ees+evdw1)
157 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
158 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
159 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
160 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
161 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
162 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
170 energia(2)=evdw2-evdw2_14
187 energia(8)=eello_turn3
188 energia(9)=eello_turn4
197 energia(20)=edihcnstr
199 energia(24)=ethetacnstr
204 if (isnan(etot).ne.0) energia(0)=1.0d+99
206 if (isnan(etot)) energia(0)=1.0d+99
211 idumm=proc_proc(etot,i)
213 call proc_proc(etot,i)
215 if(i.eq.1)energia(0)=1.0d+99
222 C Sum up the components of the Cartesian gradient.
227 if (shield_mode.eq.0) then
228 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
229 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
231 & wstrain*ghpbc(j,i)+
232 & wcorr*fact(3)*gradcorr(j,i)+
233 & wel_loc*fact(2)*gel_loc(j,i)+
234 & wturn3*fact(2)*gcorr3_turn(j,i)+
235 & wturn4*fact(3)*gcorr4_turn(j,i)+
236 & wcorr5*fact(4)*gradcorr5(j,i)+
237 & wcorr6*fact(5)*gradcorr6(j,i)+
238 & wturn6*fact(5)*gcorr6_turn(j,i)+
239 & wsccor*fact(2)*gsccorc(j,i)
240 & +wliptran*gliptranc(j,i)
241 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
243 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
244 & wsccor*fact(2)*gsccorx(j,i)
245 & +wliptran*gliptranx(j,i)
247 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
248 & +fact(1)*wscp*gvdwc_scp(j,i)+
249 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
251 & wstrain*ghpbc(j,i)+
252 & wcorr*fact(3)*gradcorr(j,i)+
253 & wel_loc*fact(2)*gel_loc(j,i)+
254 & wturn3*fact(2)*gcorr3_turn(j,i)+
255 & wturn4*fact(3)*gcorr4_turn(j,i)+
256 & wcorr5*fact(4)*gradcorr5(j,i)+
257 & wcorr6*fact(5)*gradcorr6(j,i)+
258 & wturn6*fact(5)*gcorr6_turn(j,i)+
259 & wsccor*fact(2)*gsccorc(j,i)
260 & +wliptran*gliptranc(j,i)
261 & +welec*gshieldc(j,i)
262 & +welec*gshieldc_loc(j,i)
263 & +wcorr*gshieldc_ec(j,i)
264 & +wcorr*gshieldc_loc_ec(j,i)
265 & +wturn3*gshieldc_t3(j,i)
266 & +wturn3*gshieldc_loc_t3(j,i)
267 & +wturn4*gshieldc_t4(j,i)
268 & +wturn4*gshieldc_loc_t4(j,i)
269 & +wel_loc*gshieldc_ll(j,i)
270 & +wel_loc*gshieldc_loc_ll(j,i)
272 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
273 & +fact(1)*wscp*gradx_scp(j,i)+
275 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
276 & wsccor*fact(2)*gsccorx(j,i)
277 & +wliptran*gliptranx(j,i)
278 & +welec*gshieldx(j,i)
279 & +wcorr*gshieldx_ec(j,i)
280 & +wturn3*gshieldx_t3(j,i)
281 & +wturn4*gshieldx_t4(j,i)
282 & +wel_loc*gshieldx_ll(j,i)
290 if (shield_mode.eq.0) then
291 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
292 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
294 & wcorr*fact(3)*gradcorr(j,i)+
295 & wel_loc*fact(2)*gel_loc(j,i)+
296 & wturn3*fact(2)*gcorr3_turn(j,i)+
297 & wturn4*fact(3)*gcorr4_turn(j,i)+
298 & wcorr5*fact(4)*gradcorr5(j,i)+
299 & wcorr6*fact(5)*gradcorr6(j,i)+
300 & wturn6*fact(5)*gcorr6_turn(j,i)+
301 & wsccor*fact(2)*gsccorc(j,i)
302 & +wliptran*gliptranc(j,i)
303 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
305 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
306 & wsccor*fact(1)*gsccorx(j,i)
307 & +wliptran*gliptranx(j,i)
309 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
310 & fact(1)*wscp*gvdwc_scp(j,i)+
311 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
313 & wcorr*fact(3)*gradcorr(j,i)+
314 & wel_loc*fact(2)*gel_loc(j,i)+
315 & wturn3*fact(2)*gcorr3_turn(j,i)+
316 & wturn4*fact(3)*gcorr4_turn(j,i)+
317 & wcorr5*fact(4)*gradcorr5(j,i)+
318 & wcorr6*fact(5)*gradcorr6(j,i)+
319 & wturn6*fact(5)*gcorr6_turn(j,i)+
320 & wsccor*fact(2)*gsccorc(j,i)
321 & +wliptran*gliptranc(j,i)
322 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
323 & fact(1)*wscp*gradx_scp(j,i)+
325 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
326 & wsccor*fact(1)*gsccorx(j,i)
327 & +wliptran*gliptranx(j,i)
335 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
336 & +wcorr5*fact(4)*g_corr5_loc(i)
337 & +wcorr6*fact(5)*g_corr6_loc(i)
338 & +wturn4*fact(3)*gel_loc_turn4(i)
339 & +wturn3*fact(2)*gel_loc_turn3(i)
340 & +wturn6*fact(5)*gel_loc_turn6(i)
341 & +wel_loc*fact(2)*gel_loc_loc(i)
342 c & +wsccor*fact(1)*gsccor_loc(i)
346 if (dyn_ss) call dyn_set_nss
349 C------------------------------------------------------------------------
350 subroutine enerprint(energia,fact)
351 implicit real*8 (a-h,o-z)
353 include 'sizesclu.dat'
354 include 'COMMON.IOUNITS'
355 include 'COMMON.FFIELD'
356 include 'COMMON.SBRIDGE'
357 double precision energia(0:max_ene),fact(6)
359 evdw=energia(1)+fact(6)*energia(21)
361 evdw2=energia(2)+energia(17)
373 eello_turn3=energia(8)
374 eello_turn4=energia(9)
375 eello_turn6=energia(10)
382 edihcnstr=energia(20)
384 ethetacnstr=energia(24)
386 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
388 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
389 & etors_d,wtor_d*fact(2),ehpb,wstrain,
390 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
391 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
392 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
393 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
394 10 format (/'Virtual-chain energies:'//
395 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
396 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
397 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
398 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
399 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
400 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
401 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
402 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
403 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
404 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
405 & ' (SS bridges & dist. cnstr.)'/
406 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
407 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
408 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
409 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
410 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
411 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
412 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
413 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
414 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
415 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
416 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
417 & 'ETOT= ',1pE16.6,' (total)')
419 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
420 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
421 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
422 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
423 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
424 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
425 & edihcnstr,ethetacnstr,ebr*nss,etot
426 10 format (/'Virtual-chain energies:'//
427 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
428 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
429 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
430 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
431 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
432 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
433 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
434 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
435 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
436 & ' (SS bridges & dist. cnstr.)'/
437 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
438 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
439 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
440 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
441 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
442 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
443 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
444 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
445 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
446 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
447 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
448 & 'ETOT= ',1pE16.6,' (total)')
452 C-----------------------------------------------------------------------
453 subroutine elj(evdw,evdw_t)
455 C This subroutine calculates the interaction energy of nonbonded side chains
456 C assuming the LJ potential of interaction.
458 implicit real*8 (a-h,o-z)
460 include 'sizesclu.dat'
461 include "DIMENSIONS.COMPAR"
462 parameter (accur=1.0d-10)
465 include 'COMMON.LOCAL'
466 include 'COMMON.CHAIN'
467 include 'COMMON.DERIV'
468 include 'COMMON.INTERACT'
469 include 'COMMON.TORSION'
470 include 'COMMON.SBRIDGE'
471 include 'COMMON.NAMES'
472 include 'COMMON.IOUNITS'
473 include 'COMMON.CONTACTS'
477 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
478 c ROZNICA DODANE Z WHAM
481 c eneps_temp(j,i)=0.0d0
490 if (itypi.eq.ntyp1) cycle
491 itypi1=iabs(itype(i+1))
498 C Calculate SC interaction energy.
501 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
502 cd & 'iend=',iend(i,iint)
503 do j=istart(i,iint),iend(i,iint)
505 if (itypj.eq.ntyp1) cycle
509 C Change 12/1/95 to calculate four-body interactions
510 rij=xj*xj+yj*yj+zj*zj
512 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
513 eps0ij=eps(itypi,itypj)
518 ij=icant(itypi,itypj)
520 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
521 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
524 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
525 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
526 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
527 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
528 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
529 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
530 if (bb.gt.0.0d0) then
537 C Calculate the components of the gradient in DC and X
539 fac=-rrij*(e1+evdwij)
544 gvdwx(k,i)=gvdwx(k,i)-gg(k)
545 gvdwx(k,j)=gvdwx(k,j)+gg(k)
549 gvdwc(l,k)=gvdwc(l,k)+gg(l)
554 C 12/1/95, revised on 5/20/97
556 C Calculate the contact function. The ith column of the array JCONT will
557 C contain the numbers of atoms that make contacts with the atom I (of numbers
558 C greater than I). The arrays FACONT and GACONT will contain the values of
559 C the contact function and its derivative.
561 C Uncomment next line, if the correlation interactions include EVDW explicitly.
562 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
563 C Uncomment next line, if the correlation interactions are contact function only
564 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
566 sigij=sigma(itypi,itypj)
567 r0ij=rs0(itypi,itypj)
569 C Check whether the SC's are not too far to make a contact.
572 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
573 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
575 if (fcont.gt.0.0D0) then
576 C If the SC-SC distance if close to sigma, apply spline.
577 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
578 cAdam & fcont1,fprimcont1)
579 cAdam fcont1=1.0d0-fcont1
580 cAdam if (fcont1.gt.0.0d0) then
581 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
582 cAdam fcont=fcont*fcont1
584 C Uncomment following 4 lines to have the geometric average of the epsilon0's
585 cga eps0ij=1.0d0/dsqrt(eps0ij)
587 cga gg(k)=gg(k)*eps0ij
589 cga eps0ij=-evdwij*eps0ij
590 C Uncomment for AL's type of SC correlation interactions.
592 num_conti=num_conti+1
594 facont(num_conti,i)=fcont*eps0ij
595 fprimcont=eps0ij*fprimcont/rij
597 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
598 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
599 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
600 C Uncomment following 3 lines for Skolnick's type of SC correlation.
601 gacont(1,num_conti,i)=-fprimcont*xj
602 gacont(2,num_conti,i)=-fprimcont*yj
603 gacont(3,num_conti,i)=-fprimcont*zj
604 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
605 cd write (iout,'(2i3,3f10.5)')
606 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
612 num_cont(i)=num_conti
617 gvdwc(j,i)=expon*gvdwc(j,i)
618 gvdwx(j,i)=expon*gvdwx(j,i)
622 C******************************************************************************
626 C To save time, the factor of EXPON has been extracted from ALL components
627 C of GVDWC and GRADX. Remember to multiply them by this factor before further
630 C******************************************************************************
633 C-----------------------------------------------------------------------------
634 subroutine eljk(evdw,evdw_t)
636 C This subroutine calculates the interaction energy of nonbonded side chains
637 C assuming the LJK potential of interaction.
639 implicit real*8 (a-h,o-z)
641 include 'sizesclu.dat'
642 include "DIMENSIONS.COMPAR"
645 include 'COMMON.LOCAL'
646 include 'COMMON.CHAIN'
647 include 'COMMON.DERIV'
648 include 'COMMON.INTERACT'
649 include 'COMMON.IOUNITS'
650 include 'COMMON.NAMES'
655 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
660 if (itypi.eq.ntyp1) cycle
661 itypi1=iabs(itype(i+1))
666 C Calculate SC interaction energy.
669 do j=istart(i,iint),iend(i,iint)
671 if (itypj.eq.ntyp1) cycle
675 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
677 e_augm=augm(itypi,itypj)*fac_augm
680 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
681 fac=r_shift_inv**expon
685 ij=icant(itypi,itypj)
686 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
687 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
688 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
689 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
690 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
691 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
692 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
693 if (bb.gt.0.0d0) then
700 C Calculate the components of the gradient in DC and X
702 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
707 gvdwx(k,i)=gvdwx(k,i)-gg(k)
708 gvdwx(k,j)=gvdwx(k,j)+gg(k)
712 gvdwc(l,k)=gvdwc(l,k)+gg(l)
722 gvdwc(j,i)=expon*gvdwc(j,i)
723 gvdwx(j,i)=expon*gvdwx(j,i)
729 C-----------------------------------------------------------------------------
730 subroutine ebp(evdw,evdw_t)
732 C This subroutine calculates the interaction energy of nonbonded side chains
733 C assuming the Berne-Pechukas potential of interaction.
735 implicit real*8 (a-h,o-z)
737 include 'sizesclu.dat'
738 include "DIMENSIONS.COMPAR"
741 include 'COMMON.LOCAL'
742 include 'COMMON.CHAIN'
743 include 'COMMON.DERIV'
744 include 'COMMON.NAMES'
745 include 'COMMON.INTERACT'
746 include 'COMMON.IOUNITS'
747 include 'COMMON.CALC'
749 c double precision rrsave(maxdim)
755 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
756 c if (icall.eq.0) then
764 if (itypi.eq.ntyp1) cycle
765 itypi1=iabs(itype(i+1))
769 dxi=dc_norm(1,nres+i)
770 dyi=dc_norm(2,nres+i)
771 dzi=dc_norm(3,nres+i)
772 dsci_inv=vbld_inv(i+nres)
774 C Calculate SC interaction energy.
777 do j=istart(i,iint),iend(i,iint)
780 if (itypj.eq.ntyp1) cycle
781 dscj_inv=vbld_inv(j+nres)
782 chi1=chi(itypi,itypj)
783 chi2=chi(itypj,itypi)
790 alf12=0.5D0*(alf1+alf2)
791 C For diagnostics only!!!
804 dxj=dc_norm(1,nres+j)
805 dyj=dc_norm(2,nres+j)
806 dzj=dc_norm(3,nres+j)
807 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
808 cd if (icall.eq.0) then
814 C Calculate the angle-dependent terms of energy & contributions to derivatives.
816 C Calculate whole angle-dependent part of epsilon and contributions
818 fac=(rrij*sigsq)**expon2
821 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
822 eps2der=evdwij*eps3rt
823 eps3der=evdwij*eps2rt
824 evdwij=evdwij*eps2rt*eps3rt
825 ij=icant(itypi,itypj)
826 aux=eps1*eps2rt**2*eps3rt**2
827 if (bb.gt.0.0d0) then
834 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
836 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
837 cd & restyp(itypi),i,restyp(itypj),j,
838 cd & epsi,sigm,chi1,chi2,chip1,chip2,
839 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
840 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
843 C Calculate gradient components.
844 e1=e1*eps1*eps2rt**2*eps3rt**2
845 fac=-expon*(e1+evdwij)
848 C Calculate radial part of the gradient
852 C Calculate the angular part of the gradient and sum add the contributions
853 C to the appropriate components of the Cartesian gradient.
862 C-----------------------------------------------------------------------------
863 subroutine egb(evdw,evdw_t)
865 C This subroutine calculates the interaction energy of nonbonded side chains
866 C assuming the Gay-Berne potential of interaction.
868 implicit real*8 (a-h,o-z)
870 include 'sizesclu.dat'
871 include "DIMENSIONS.COMPAR"
874 include 'COMMON.LOCAL'
875 include 'COMMON.CHAIN'
876 include 'COMMON.DERIV'
877 include 'COMMON.NAMES'
878 include 'COMMON.INTERACT'
879 include 'COMMON.IOUNITS'
880 include 'COMMON.CALC'
881 include 'COMMON.SBRIDGE'
886 integer xshift,yshift,zshift
887 logical energy_dec /.false./
888 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
892 c if (icall.gt.0) lprn=.true.
896 if (itypi.eq.ntyp1) cycle
897 itypi1=iabs(itype(i+1))
902 if (xi.lt.0) xi=xi+boxxsize
904 if (yi.lt.0) yi=yi+boxysize
906 if (zi.lt.0) zi=zi+boxzsize
907 if ((zi.gt.bordlipbot)
908 &.and.(zi.lt.bordliptop)) then
909 C the energy transfer exist
910 if (zi.lt.buflipbot) then
911 C what fraction I am in
913 & ((zi-bordlipbot)/lipbufthick)
914 C lipbufthick is thickenes of lipid buffore
915 sslipi=sscalelip(fracinbuf)
916 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
917 elseif (zi.gt.bufliptop) then
918 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
919 sslipi=sscalelip(fracinbuf)
920 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
929 dxi=dc_norm(1,nres+i)
930 dyi=dc_norm(2,nres+i)
931 dzi=dc_norm(3,nres+i)
932 dsci_inv=vbld_inv(i+nres)
934 C Calculate SC interaction energy.
937 do j=istart(i,iint),iend(i,iint)
938 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
940 c write(iout,*) "PRZED ZWYKLE", evdwij
941 call dyn_ssbond_ene(i,j,evdwij)
942 c write(iout,*) "PO ZWYKLE", evdwij
945 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
946 & 'evdw',i,j,evdwij,' ss'
947 C triple bond artifac removal
948 do k=j+1,iend(i,iint)
949 C search over all next residues
950 if (dyn_ss_mask(k)) then
951 C check if they are cysteins
952 C write(iout,*) 'k=',k
954 c write(iout,*) "PRZED TRI", evdwij
955 evdwij_przed_tri=evdwij
956 call triple_ssbond_ene(i,j,k,evdwij)
957 c if(evdwij_przed_tri.ne.evdwij) then
958 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
961 c write(iout,*) "PO TRI", evdwij
962 C call the energy function that removes the artifical triple disulfide
963 C bond the soubroutine is located in ssMD.F
965 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
966 & 'evdw',i,j,evdwij,'tss'
972 if (itypj.eq.ntyp1) cycle
973 dscj_inv=vbld_inv(j+nres)
974 sig0ij=sigma(itypi,itypj)
975 chi1=chi(itypi,itypj)
976 chi2=chi(itypj,itypi)
983 alf12=0.5D0*(alf1+alf2)
984 C For diagnostics only!!!
998 if (xj.lt.0) xj=xj+boxxsize
1000 if (yj.lt.0) yj=yj+boxysize
1002 if (zj.lt.0) zj=zj+boxzsize
1003 if ((zj.gt.bordlipbot)
1004 &.and.(zj.lt.bordliptop)) then
1005 C the energy transfer exist
1006 if (zj.lt.buflipbot) then
1007 C what fraction I am in
1009 & ((zj-bordlipbot)/lipbufthick)
1010 C lipbufthick is thickenes of lipid buffore
1011 sslipj=sscalelip(fracinbuf)
1012 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1013 elseif (zj.gt.bufliptop) then
1014 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1015 sslipj=sscalelip(fracinbuf)
1016 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1025 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1026 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1027 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1028 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1029 C write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
1030 C & bb-bb_aq(itypi,itypj)
1031 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1039 xj=xj_safe+xshift*boxxsize
1040 yj=yj_safe+yshift*boxysize
1041 zj=zj_safe+zshift*boxzsize
1042 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1043 if(dist_temp.lt.dist_init) then
1053 if (subchap.eq.1) then
1062 dxj=dc_norm(1,nres+j)
1063 dyj=dc_norm(2,nres+j)
1064 dzj=dc_norm(3,nres+j)
1065 c write (iout,*) i,j,xj,yj,zj
1066 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1068 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1069 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1070 if (sss.le.0.0d0) cycle
1071 C Calculate angle-dependent terms of energy and contributions to their
1075 sig=sig0ij*dsqrt(sigsq)
1076 rij_shift=1.0D0/rij-sig+sig0ij
1077 C I hate to put IF's in the loops, but here don't have another choice!!!!
1078 if (rij_shift.le.0.0D0) then
1083 c---------------------------------------------------------------
1084 rij_shift=1.0D0/rij_shift
1085 fac=rij_shift**expon
1088 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1089 eps2der=evdwij*eps3rt
1090 eps3der=evdwij*eps2rt
1091 evdwij=evdwij*eps2rt*eps3rt
1093 evdw=evdw+evdwij*sss
1095 evdw_t=evdw_t+evdwij*sss
1097 ij=icant(itypi,itypj)
1098 aux=eps1*eps2rt**2*eps3rt**2
1099 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1100 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1101 c & aux*e2/eps(itypi,itypj)
1103 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1107 C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1108 C & restyp(itypi),i,restyp(itypj),j,
1109 C & epsi,sigm,chi1,chi2,chip1,chip2,
1110 C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1111 C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1113 write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
1118 C Calculate gradient components.
1119 e1=e1*eps1*eps2rt**2*eps3rt**2
1120 fac=-expon*(e1+evdwij)*rij_shift
1123 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1124 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1125 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1126 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1127 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1128 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1129 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1130 C Calculate the radial part of the gradient
1134 C Calculate angular part of the gradient.
1143 C-----------------------------------------------------------------------------
1144 subroutine egbv(evdw,evdw_t)
1146 C This subroutine calculates the interaction energy of nonbonded side chains
1147 C assuming the Gay-Berne-Vorobjev potential of interaction.
1149 implicit real*8 (a-h,o-z)
1150 include 'DIMENSIONS'
1151 include 'sizesclu.dat'
1152 include "DIMENSIONS.COMPAR"
1153 include 'COMMON.GEO'
1154 include 'COMMON.VAR'
1155 include 'COMMON.LOCAL'
1156 include 'COMMON.CHAIN'
1157 include 'COMMON.DERIV'
1158 include 'COMMON.NAMES'
1159 include 'COMMON.INTERACT'
1160 include 'COMMON.IOUNITS'
1161 include 'COMMON.CALC'
1162 common /srutu/ icall
1168 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1171 c if (icall.gt.0) lprn=.true.
1173 do i=iatsc_s,iatsc_e
1174 itypi=iabs(itype(i))
1175 if (itypi.eq.ntyp1) cycle
1176 itypi1=iabs(itype(i+1))
1180 dxi=dc_norm(1,nres+i)
1181 dyi=dc_norm(2,nres+i)
1182 dzi=dc_norm(3,nres+i)
1183 dsci_inv=vbld_inv(i+nres)
1184 C returning the ith atom to box
1186 if (xi.lt.0) xi=xi+boxxsize
1188 if (yi.lt.0) yi=yi+boxysize
1190 if (zi.lt.0) zi=zi+boxzsize
1191 if ((zi.gt.bordlipbot)
1192 &.and.(zi.lt.bordliptop)) then
1193 C the energy transfer exist
1194 if (zi.lt.buflipbot) then
1195 C what fraction I am in
1197 & ((zi-bordlipbot)/lipbufthick)
1198 C lipbufthick is thickenes of lipid buffore
1199 sslipi=sscalelip(fracinbuf)
1200 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1201 elseif (zi.gt.bufliptop) then
1202 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1203 sslipi=sscalelip(fracinbuf)
1204 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1214 C Calculate SC interaction energy.
1216 do iint=1,nint_gr(i)
1217 do j=istart(i,iint),iend(i,iint)
1219 itypj=iabs(itype(j))
1220 if (itypj.eq.ntyp1) cycle
1221 dscj_inv=vbld_inv(j+nres)
1222 sig0ij=sigma(itypi,itypj)
1223 r0ij=r0(itypi,itypj)
1224 chi1=chi(itypi,itypj)
1225 chi2=chi(itypj,itypi)
1232 alf12=0.5D0*(alf1+alf2)
1233 C For diagnostics only!!!
1246 C returning jth atom to box
1248 if (xj.lt.0) xj=xj+boxxsize
1250 if (yj.lt.0) yj=yj+boxysize
1252 if (zj.lt.0) zj=zj+boxzsize
1253 if ((zj.gt.bordlipbot)
1254 &.and.(zj.lt.bordliptop)) then
1255 C the energy transfer exist
1256 if (zj.lt.buflipbot) then
1257 C what fraction I am in
1259 & ((zj-bordlipbot)/lipbufthick)
1260 C lipbufthick is thickenes of lipid buffore
1261 sslipj=sscalelip(fracinbuf)
1262 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1263 elseif (zj.gt.bufliptop) then
1264 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1265 sslipj=sscalelip(fracinbuf)
1266 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1275 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1276 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1277 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1278 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1279 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1280 C checking the distance
1281 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1286 C finding the closest
1290 xj=xj_safe+xshift*boxxsize
1291 yj=yj_safe+yshift*boxysize
1292 zj=zj_safe+zshift*boxzsize
1293 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1294 if(dist_temp.lt.dist_init) then
1304 if (subchap.eq.1) then
1313 dxj=dc_norm(1,nres+j)
1314 dyj=dc_norm(2,nres+j)
1315 dzj=dc_norm(3,nres+j)
1316 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1318 C Calculate angle-dependent terms of energy and contributions to their
1322 sig=sig0ij*dsqrt(sigsq)
1323 rij_shift=1.0D0/rij-sig+r0ij
1324 C I hate to put IF's in the loops, but here don't have another choice!!!!
1325 if (rij_shift.le.0.0D0) then
1330 c---------------------------------------------------------------
1331 rij_shift=1.0D0/rij_shift
1332 fac=rij_shift**expon
1335 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1336 eps2der=evdwij*eps3rt
1337 eps3der=evdwij*eps2rt
1338 fac_augm=rrij**expon
1339 e_augm=augm(itypi,itypj)*fac_augm
1340 evdwij=evdwij*eps2rt*eps3rt
1341 if (bb.gt.0.0d0) then
1342 evdw=evdw+evdwij+e_augm
1344 evdw_t=evdw_t+evdwij+e_augm
1346 ij=icant(itypi,itypj)
1347 aux=eps1*eps2rt**2*eps3rt**2
1349 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1350 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1351 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1352 c & restyp(itypi),i,restyp(itypj),j,
1353 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1354 c & chi1,chi2,chip1,chip2,
1355 c & eps1,eps2rt**2,eps3rt**2,
1356 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1360 C Calculate gradient components.
1361 e1=e1*eps1*eps2rt**2*eps3rt**2
1362 fac=-expon*(e1+evdwij)*rij_shift
1364 fac=rij*fac-2*expon*rrij*e_augm
1365 C Calculate the radial part of the gradient
1369 C Calculate angular part of the gradient.
1377 C-----------------------------------------------------------------------------
1378 subroutine sc_angular
1379 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1380 C om12. Called by ebp, egb, and egbv.
1382 include 'COMMON.CALC'
1386 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1387 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1388 om12=dxi*dxj+dyi*dyj+dzi*dzj
1390 C Calculate eps1(om12) and its derivative in om12
1391 faceps1=1.0D0-om12*chiom12
1392 faceps1_inv=1.0D0/faceps1
1393 eps1=dsqrt(faceps1_inv)
1394 C Following variable is eps1*deps1/dom12
1395 eps1_om12=faceps1_inv*chiom12
1396 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1401 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1402 sigsq=1.0D0-facsig*faceps1_inv
1403 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1404 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1405 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1406 C Calculate eps2 and its derivatives in om1, om2, and om12.
1409 chipom12=chip12*om12
1410 facp=1.0D0-om12*chipom12
1412 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1413 C Following variable is the square root of eps2
1414 eps2rt=1.0D0-facp1*facp_inv
1415 C Following three variables are the derivatives of the square root of eps
1416 C in om1, om2, and om12.
1417 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1418 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1419 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1420 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1421 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1422 C Calculate whole angle-dependent part of epsilon and contributions
1423 C to its derivatives
1426 C----------------------------------------------------------------------------
1428 implicit real*8 (a-h,o-z)
1429 include 'DIMENSIONS'
1430 include 'sizesclu.dat'
1431 include 'COMMON.CHAIN'
1432 include 'COMMON.DERIV'
1433 include 'COMMON.CALC'
1434 double precision dcosom1(3),dcosom2(3)
1435 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1436 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1437 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1438 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1440 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1441 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1444 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1447 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
1448 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1449 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1450 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipi(k)
1451 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1452 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1455 C Calculate the components of the gradient in DC and X
1459 gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
1463 gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
1467 c------------------------------------------------------------------------------
1468 subroutine vec_and_deriv
1469 implicit real*8 (a-h,o-z)
1470 include 'DIMENSIONS'
1471 include 'sizesclu.dat'
1472 include 'COMMON.IOUNITS'
1473 include 'COMMON.GEO'
1474 include 'COMMON.VAR'
1475 include 'COMMON.LOCAL'
1476 include 'COMMON.CHAIN'
1477 include 'COMMON.VECTORS'
1478 include 'COMMON.DERIV'
1479 include 'COMMON.INTERACT'
1480 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1481 C Compute the local reference systems. For reference system (i), the
1482 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1483 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1485 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1486 if (i.eq.nres-1) then
1487 C Case of the last full residue
1488 C Compute the Z-axis
1489 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1490 costh=dcos(pi-theta(nres))
1491 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1496 C Compute the derivatives of uz
1498 uzder(2,1,1)=-dc_norm(3,i-1)
1499 uzder(3,1,1)= dc_norm(2,i-1)
1500 uzder(1,2,1)= dc_norm(3,i-1)
1502 uzder(3,2,1)=-dc_norm(1,i-1)
1503 uzder(1,3,1)=-dc_norm(2,i-1)
1504 uzder(2,3,1)= dc_norm(1,i-1)
1507 uzder(2,1,2)= dc_norm(3,i)
1508 uzder(3,1,2)=-dc_norm(2,i)
1509 uzder(1,2,2)=-dc_norm(3,i)
1511 uzder(3,2,2)= dc_norm(1,i)
1512 uzder(1,3,2)= dc_norm(2,i)
1513 uzder(2,3,2)=-dc_norm(1,i)
1516 C Compute the Y-axis
1519 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1522 C Compute the derivatives of uy
1525 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1526 & -dc_norm(k,i)*dc_norm(j,i-1)
1527 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1529 uyder(j,j,1)=uyder(j,j,1)-costh
1530 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1535 uygrad(l,k,j,i)=uyder(l,k,j)
1536 uzgrad(l,k,j,i)=uzder(l,k,j)
1540 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1541 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1542 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1543 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1547 C Compute the Z-axis
1548 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1549 costh=dcos(pi-theta(i+2))
1550 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1555 C Compute the derivatives of uz
1557 uzder(2,1,1)=-dc_norm(3,i+1)
1558 uzder(3,1,1)= dc_norm(2,i+1)
1559 uzder(1,2,1)= dc_norm(3,i+1)
1561 uzder(3,2,1)=-dc_norm(1,i+1)
1562 uzder(1,3,1)=-dc_norm(2,i+1)
1563 uzder(2,3,1)= dc_norm(1,i+1)
1566 uzder(2,1,2)= dc_norm(3,i)
1567 uzder(3,1,2)=-dc_norm(2,i)
1568 uzder(1,2,2)=-dc_norm(3,i)
1570 uzder(3,2,2)= dc_norm(1,i)
1571 uzder(1,3,2)= dc_norm(2,i)
1572 uzder(2,3,2)=-dc_norm(1,i)
1575 C Compute the Y-axis
1578 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1581 C Compute the derivatives of uy
1584 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1585 & -dc_norm(k,i)*dc_norm(j,i+1)
1586 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1588 uyder(j,j,1)=uyder(j,j,1)-costh
1589 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1594 uygrad(l,k,j,i)=uyder(l,k,j)
1595 uzgrad(l,k,j,i)=uzder(l,k,j)
1599 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1600 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1601 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1602 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1608 vbld_inv_temp(1)=vbld_inv(i+1)
1609 if (i.lt.nres-1) then
1610 vbld_inv_temp(2)=vbld_inv(i+2)
1612 vbld_inv_temp(2)=vbld_inv(i)
1617 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1618 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1626 C-----------------------------------------------------------------------------
1627 subroutine vec_and_deriv_test
1628 implicit real*8 (a-h,o-z)
1629 include 'DIMENSIONS'
1630 include 'sizesclu.dat'
1631 include 'COMMON.IOUNITS'
1632 include 'COMMON.GEO'
1633 include 'COMMON.VAR'
1634 include 'COMMON.LOCAL'
1635 include 'COMMON.CHAIN'
1636 include 'COMMON.VECTORS'
1637 dimension uyder(3,3,2),uzder(3,3,2)
1638 C Compute the local reference systems. For reference system (i), the
1639 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1640 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1642 if (i.eq.nres-1) then
1643 C Case of the last full residue
1644 C Compute the Z-axis
1645 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1646 costh=dcos(pi-theta(nres))
1647 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1648 c write (iout,*) 'fac',fac,
1649 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1650 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1654 C Compute the derivatives of uz
1656 uzder(2,1,1)=-dc_norm(3,i-1)
1657 uzder(3,1,1)= dc_norm(2,i-1)
1658 uzder(1,2,1)= dc_norm(3,i-1)
1660 uzder(3,2,1)=-dc_norm(1,i-1)
1661 uzder(1,3,1)=-dc_norm(2,i-1)
1662 uzder(2,3,1)= dc_norm(1,i-1)
1665 uzder(2,1,2)= dc_norm(3,i)
1666 uzder(3,1,2)=-dc_norm(2,i)
1667 uzder(1,2,2)=-dc_norm(3,i)
1669 uzder(3,2,2)= dc_norm(1,i)
1670 uzder(1,3,2)= dc_norm(2,i)
1671 uzder(2,3,2)=-dc_norm(1,i)
1673 C Compute the Y-axis
1675 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1678 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1679 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1680 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1682 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1685 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1686 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1689 c write (iout,*) 'facy',facy,
1690 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1691 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1693 uy(k,i)=facy*uy(k,i)
1695 C Compute the derivatives of uy
1698 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1699 & -dc_norm(k,i)*dc_norm(j,i-1)
1700 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1702 c uyder(j,j,1)=uyder(j,j,1)-costh
1703 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1704 uyder(j,j,1)=uyder(j,j,1)
1705 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1706 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1712 uygrad(l,k,j,i)=uyder(l,k,j)
1713 uzgrad(l,k,j,i)=uzder(l,k,j)
1717 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1718 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1719 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1720 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1723 C Compute the Z-axis
1724 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1725 costh=dcos(pi-theta(i+2))
1726 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1727 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1731 C Compute the derivatives of uz
1733 uzder(2,1,1)=-dc_norm(3,i+1)
1734 uzder(3,1,1)= dc_norm(2,i+1)
1735 uzder(1,2,1)= dc_norm(3,i+1)
1737 uzder(3,2,1)=-dc_norm(1,i+1)
1738 uzder(1,3,1)=-dc_norm(2,i+1)
1739 uzder(2,3,1)= dc_norm(1,i+1)
1742 uzder(2,1,2)= dc_norm(3,i)
1743 uzder(3,1,2)=-dc_norm(2,i)
1744 uzder(1,2,2)=-dc_norm(3,i)
1746 uzder(3,2,2)= dc_norm(1,i)
1747 uzder(1,3,2)= dc_norm(2,i)
1748 uzder(2,3,2)=-dc_norm(1,i)
1750 C Compute the Y-axis
1752 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1753 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1754 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1756 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1759 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1760 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1763 c write (iout,*) 'facy',facy,
1764 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1765 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1767 uy(k,i)=facy*uy(k,i)
1769 C Compute the derivatives of uy
1772 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1773 & -dc_norm(k,i)*dc_norm(j,i+1)
1774 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1776 c uyder(j,j,1)=uyder(j,j,1)-costh
1777 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1778 uyder(j,j,1)=uyder(j,j,1)
1779 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1780 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1786 uygrad(l,k,j,i)=uyder(l,k,j)
1787 uzgrad(l,k,j,i)=uzder(l,k,j)
1791 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1792 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1793 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1794 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1801 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1802 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1809 C-----------------------------------------------------------------------------
1810 subroutine check_vecgrad
1811 implicit real*8 (a-h,o-z)
1812 include 'DIMENSIONS'
1813 include 'sizesclu.dat'
1814 include 'COMMON.IOUNITS'
1815 include 'COMMON.GEO'
1816 include 'COMMON.VAR'
1817 include 'COMMON.LOCAL'
1818 include 'COMMON.CHAIN'
1819 include 'COMMON.VECTORS'
1820 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1821 dimension uyt(3,maxres),uzt(3,maxres)
1822 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1823 double precision delta /1.0d-7/
1826 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1827 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1828 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1829 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1830 cd & (dc_norm(if90,i),if90=1,3)
1831 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1832 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1833 cd write(iout,'(a)')
1839 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1840 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1853 cd write (iout,*) 'i=',i
1855 erij(k)=dc_norm(k,i)
1859 dc_norm(k,i)=erij(k)
1861 dc_norm(j,i)=dc_norm(j,i)+delta
1862 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1864 c dc_norm(k,i)=dc_norm(k,i)/fac
1866 c write (iout,*) (dc_norm(k,i),k=1,3)
1867 c write (iout,*) (erij(k),k=1,3)
1870 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1871 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1872 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1873 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1875 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1876 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1877 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1880 dc_norm(k,i)=erij(k)
1883 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1884 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1885 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1886 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1887 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1888 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1889 cd write (iout,'(a)')
1894 C--------------------------------------------------------------------------
1895 subroutine set_matrices
1896 implicit real*8 (a-h,o-z)
1897 include 'DIMENSIONS'
1898 include 'sizesclu.dat'
1899 include 'COMMON.IOUNITS'
1900 include 'COMMON.GEO'
1901 include 'COMMON.VAR'
1902 include 'COMMON.LOCAL'
1903 include 'COMMON.CHAIN'
1904 include 'COMMON.DERIV'
1905 include 'COMMON.INTERACT'
1906 include 'COMMON.CONTACTS'
1907 include 'COMMON.TORSION'
1908 include 'COMMON.VECTORS'
1909 include 'COMMON.FFIELD'
1910 double precision auxvec(2),auxmat(2,2)
1912 C Compute the virtual-bond-torsional-angle dependent quantities needed
1913 C to calculate the el-loc multibody terms of various order.
1916 if (i .lt. nres+1) then
1953 if (i .gt. 3 .and. i .lt. nres+1) then
1954 obrot_der(1,i-2)=-sin1
1955 obrot_der(2,i-2)= cos1
1956 Ugder(1,1,i-2)= sin1
1957 Ugder(1,2,i-2)=-cos1
1958 Ugder(2,1,i-2)=-cos1
1959 Ugder(2,2,i-2)=-sin1
1962 obrot2_der(1,i-2)=-dwasin2
1963 obrot2_der(2,i-2)= dwacos2
1964 Ug2der(1,1,i-2)= dwasin2
1965 Ug2der(1,2,i-2)=-dwacos2
1966 Ug2der(2,1,i-2)=-dwacos2
1967 Ug2der(2,2,i-2)=-dwasin2
1969 obrot_der(1,i-2)=0.0d0
1970 obrot_der(2,i-2)=0.0d0
1971 Ugder(1,1,i-2)=0.0d0
1972 Ugder(1,2,i-2)=0.0d0
1973 Ugder(2,1,i-2)=0.0d0
1974 Ugder(2,2,i-2)=0.0d0
1975 obrot2_der(1,i-2)=0.0d0
1976 obrot2_der(2,i-2)=0.0d0
1977 Ug2der(1,1,i-2)=0.0d0
1978 Ug2der(1,2,i-2)=0.0d0
1979 Ug2der(2,1,i-2)=0.0d0
1980 Ug2der(2,2,i-2)=0.0d0
1982 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1983 if (itype(i-2).le.ntyp) then
1984 iti = itortyp(itype(i-2))
1991 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1992 if (itype(i-1).le.ntyp) then
1993 iti1 = itortyp(itype(i-1))
2000 cd write (iout,*) '*******i',i,' iti1',iti
2001 cd write (iout,*) 'b1',b1(:,iti)
2002 cd write (iout,*) 'b2',b2(:,iti)
2003 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2004 c print *,"itilde1 i iti iti1",i,iti,iti1
2005 if (i .gt. iatel_s+2) then
2006 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2007 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2008 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2009 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2010 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2011 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2012 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2022 DtUg2(l,k,i-2)=0.0d0
2026 c print *,"itilde2 i iti iti1",i,iti,iti1
2027 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2028 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2029 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2030 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2031 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2032 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2033 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2034 c print *,"itilde3 i iti iti1",i,iti,iti1
2036 muder(k,i-2)=Ub2der(k,i-2)
2038 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2039 if (itype(i-1).le.ntyp) then
2040 iti1 = itortyp(itype(i-1))
2048 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2050 C Vectors and matrices dependent on a single virtual-bond dihedral.
2051 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2052 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2053 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2054 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2055 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2056 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2057 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2058 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2059 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2060 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2061 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2063 C Matrices dependent on two consecutive virtual-bond dihedrals.
2064 C The order of matrices is from left to right.
2066 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2067 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2068 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2069 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2070 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2071 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2072 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2073 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2076 cd iti = itortyp(itype(i))
2079 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2080 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2085 C--------------------------------------------------------------------------
2086 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2088 C This subroutine calculates the average interaction energy and its gradient
2089 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2090 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2091 C The potential depends both on the distance of peptide-group centers and on
2092 C the orientation of the CA-CA virtual bonds.
2094 implicit real*8 (a-h,o-z)
2095 include 'DIMENSIONS'
2096 include 'sizesclu.dat'
2097 include 'COMMON.CONTROL'
2098 include 'COMMON.IOUNITS'
2099 include 'COMMON.GEO'
2100 include 'COMMON.VAR'
2101 include 'COMMON.LOCAL'
2102 include 'COMMON.CHAIN'
2103 include 'COMMON.DERIV'
2104 include 'COMMON.INTERACT'
2105 include 'COMMON.CONTACTS'
2106 include 'COMMON.TORSION'
2107 include 'COMMON.VECTORS'
2108 include 'COMMON.FFIELD'
2109 include 'COMMON.SHIELD'
2111 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2112 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2113 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2114 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2115 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2116 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2117 double precision scal_el /0.5d0/
2119 C 13-go grudnia roku pamietnego...
2120 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2121 & 0.0d0,1.0d0,0.0d0,
2122 & 0.0d0,0.0d0,1.0d0/
2123 cd write(iout,*) 'In EELEC'
2125 cd write(iout,*) 'Type',i
2126 cd write(iout,*) 'B1',B1(:,i)
2127 cd write(iout,*) 'B2',B2(:,i)
2128 cd write(iout,*) 'CC',CC(:,:,i)
2129 cd write(iout,*) 'DD',DD(:,:,i)
2130 cd write(iout,*) 'EE',EE(:,:,i)
2132 cd call check_vecgrad
2134 if (icheckgrad.eq.1) then
2136 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2138 dc_norm(k,i)=dc(k,i)*fac
2140 c write (iout,*) 'i',i,' fac',fac
2143 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2144 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2145 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2146 cd if (wel_loc.gt.0.0d0) then
2147 if (icheckgrad.eq.1) then
2148 call vec_and_deriv_test
2155 cd write (iout,*) 'i=',i
2157 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2160 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2161 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2174 cd print '(a)','Enter EELEC'
2175 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2177 gel_loc_loc(i)=0.0d0
2180 do i=iatel_s,iatel_e
2182 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2183 C & .or. itype(i+2).eq.ntyp1) cycle
2185 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2186 C & .or. itype(i+2).eq.ntyp1
2187 C & .or. itype(i-1).eq.ntyp1
2190 if (itel(i).eq.0) goto 1215
2194 dx_normi=dc_norm(1,i)
2195 dy_normi=dc_norm(2,i)
2196 dz_normi=dc_norm(3,i)
2197 xmedi=c(1,i)+0.5d0*dxi
2198 ymedi=c(2,i)+0.5d0*dyi
2199 zmedi=c(3,i)+0.5d0*dzi
2200 xmedi=mod(xmedi,boxxsize)
2201 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2202 ymedi=mod(ymedi,boxysize)
2203 if (ymedi.lt.0) ymedi=ymedi+boxysize
2204 zmedi=mod(zmedi,boxzsize)
2205 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2207 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2208 do j=ielstart(i),ielend(i)
2210 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2211 C & .or.itype(j+2).eq.ntyp1
2214 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2215 C & .or.itype(j+2).eq.ntyp1
2216 C & .or.itype(j-1).eq.ntyp1
2219 if (itel(j).eq.0) goto 1216
2223 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2224 aaa=app(iteli,itelj)
2225 bbb=bpp(iteli,itelj)
2226 C Diagnostics only!!!
2232 ael6i=ael6(iteli,itelj)
2233 ael3i=ael3(iteli,itelj)
2237 dx_normj=dc_norm(1,j)
2238 dy_normj=dc_norm(2,j)
2239 dz_normj=dc_norm(3,j)
2244 if (xj.lt.0) xj=xj+boxxsize
2246 if (yj.lt.0) yj=yj+boxysize
2248 if (zj.lt.0) zj=zj+boxzsize
2249 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2257 xj=xj_safe+xshift*boxxsize
2258 yj=yj_safe+yshift*boxysize
2259 zj=zj_safe+zshift*boxzsize
2260 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2261 if(dist_temp.lt.dist_init) then
2271 if (isubchap.eq.1) then
2281 rij=xj*xj+yj*yj+zj*zj
2282 sss=sscale(sqrt(rij))
2283 sssgrad=sscagrad(sqrt(rij))
2289 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2290 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2291 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2292 fac=cosa-3.0D0*cosb*cosg
2294 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2295 if (j.eq.i+2) ev1=scal_el*ev1
2300 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2303 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2304 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2305 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2306 if (shield_mode.gt.0) then
2311 write(iout,*) "ees_compon",i,j,el1,el2,
2312 & fac_shield(i),fac_shield(j)
2315 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2316 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2326 evdw1=evdw1+evdwij*sss
2327 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2328 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2329 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2330 cd & xmedi,ymedi,zmedi,xj,yj,zj
2332 C Calculate contributions to the Cartesian gradient.
2335 facvdw=-6*rrmij*(ev1+evdwij)*sss
2336 facel=-3*rrmij*(el1+eesij)
2343 * Radial derivatives. First process both termini of the fragment (i,j)
2349 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2350 & (shield_mode.gt.0)) then
2352 do ilist=1,ishield_list(i)
2353 iresshield=shield_list(ilist,i)
2355 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2357 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2359 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2360 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2361 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2362 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2363 C if (iresshield.gt.i) then
2364 C do ishi=i+1,iresshield-1
2365 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2366 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2370 C do ishi=iresshield,i
2371 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2372 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2380 do ilist=1,ishield_list(j)
2381 iresshield=shield_list(ilist,j)
2383 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2385 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2387 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2388 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2393 gshieldc(k,i)=gshieldc(k,i)+
2394 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2395 gshieldc(k,j)=gshieldc(k,j)+
2396 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2397 gshieldc(k,i-1)=gshieldc(k,i-1)+
2398 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2399 gshieldc(k,j-1)=gshieldc(k,j-1)+
2400 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2407 gelc(k,i)=gelc(k,i)+ghalf
2408 gelc(k,j)=gelc(k,j)+ghalf
2411 * Loop over residues i+1 thru j-1.
2415 gelc(l,k)=gelc(l,k)+ggg(l)
2421 if (sss.gt.0.0) then
2422 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2423 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2424 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2432 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2433 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2436 * Loop over residues i+1 thru j-1.
2440 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2444 facvdw=(ev1+evdwij)*sss
2447 fac=-3*rrmij*(facvdw+facvdw+facel)
2453 * Radial derivatives. First process both termini of the fragment (i,j)
2460 gelc(k,i)=gelc(k,i)+ghalf
2461 gelc(k,j)=gelc(k,j)+ghalf
2464 * Loop over residues i+1 thru j-1.
2468 gelc(l,k)=gelc(l,k)+ggg(l)
2475 ecosa=2.0D0*fac3*fac1+fac4
2478 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2479 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2481 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2482 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2484 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2485 cd & (dcosg(k),k=1,3)
2487 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2488 & *fac_shield(i)**2*fac_shield(j)**2
2492 gelc(k,i)=gelc(k,i)+ghalf
2493 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2494 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2495 & *fac_shield(i)**2*fac_shield(j)**2
2497 gelc(k,j)=gelc(k,j)+ghalf
2498 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2499 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2500 & *fac_shield(i)**2*fac_shield(j)**2
2504 gelc(l,k)=gelc(l,k)+ggg(l)
2509 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2510 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2511 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2513 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2514 C energy of a peptide unit is assumed in the form of a second-order
2515 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2516 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2517 C are computed for EVERY pair of non-contiguous peptide groups.
2519 if (j.lt.nres-1) then
2530 muij(kkk)=mu(k,i)*mu(l,j)
2533 cd write (iout,*) 'EELEC: i',i,' j',j
2534 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2535 cd write(iout,*) 'muij',muij
2536 ury=scalar(uy(1,i),erij)
2537 urz=scalar(uz(1,i),erij)
2538 vry=scalar(uy(1,j),erij)
2539 vrz=scalar(uz(1,j),erij)
2540 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2541 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2542 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2543 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2544 C For diagnostics only
2549 fac=dsqrt(-ael6i)*r3ij
2550 cd write (2,*) 'fac=',fac
2551 C For diagnostics only
2557 cd write (iout,'(4i5,4f10.5)')
2558 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2559 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2560 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2561 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2562 cd write (iout,'(4f10.5)')
2563 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2564 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2565 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2566 cd write (iout,'(2i3,9f10.5/)') i,j,
2567 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2569 C Derivatives of the elements of A in virtual-bond vectors
2570 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2577 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2578 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2579 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2580 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2581 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2582 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2583 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2584 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2585 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2586 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2587 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2588 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2598 C Compute radial contributions to the gradient
2620 C Add the contributions coming from er
2623 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2624 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2625 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2626 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2629 C Derivatives in DC(i)
2630 ghalf1=0.5d0*agg(k,1)
2631 ghalf2=0.5d0*agg(k,2)
2632 ghalf3=0.5d0*agg(k,3)
2633 ghalf4=0.5d0*agg(k,4)
2634 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2635 & -3.0d0*uryg(k,2)*vry)+ghalf1
2636 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2637 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2638 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2639 & -3.0d0*urzg(k,2)*vry)+ghalf3
2640 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2641 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2642 C Derivatives in DC(i+1)
2643 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2644 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2645 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2646 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2647 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2648 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2649 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2650 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2651 C Derivatives in DC(j)
2652 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2653 & -3.0d0*vryg(k,2)*ury)+ghalf1
2654 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2655 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2656 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2657 & -3.0d0*vryg(k,2)*urz)+ghalf3
2658 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2659 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2660 C Derivatives in DC(j+1) or DC(nres-1)
2661 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2662 & -3.0d0*vryg(k,3)*ury)
2663 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2664 & -3.0d0*vrzg(k,3)*ury)
2665 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2666 & -3.0d0*vryg(k,3)*urz)
2667 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2668 & -3.0d0*vrzg(k,3)*urz)
2673 C Derivatives in DC(i+1)
2674 cd aggi1(k,1)=agg(k,1)
2675 cd aggi1(k,2)=agg(k,2)
2676 cd aggi1(k,3)=agg(k,3)
2677 cd aggi1(k,4)=agg(k,4)
2678 C Derivatives in DC(j)
2683 C Derivatives in DC(j+1)
2688 if (j.eq.nres-1 .and. i.lt.j-2) then
2690 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2691 cd aggj1(k,l)=agg(k,l)
2697 C Check the loc-el terms by numerical integration
2707 aggi(k,l)=-aggi(k,l)
2708 aggi1(k,l)=-aggi1(k,l)
2709 aggj(k,l)=-aggj(k,l)
2710 aggj1(k,l)=-aggj1(k,l)
2713 if (j.lt.nres-1) then
2719 aggi(k,l)=-aggi(k,l)
2720 aggi1(k,l)=-aggi1(k,l)
2721 aggj(k,l)=-aggj(k,l)
2722 aggj1(k,l)=-aggj1(k,l)
2733 aggi(k,l)=-aggi(k,l)
2734 aggi1(k,l)=-aggi1(k,l)
2735 aggj(k,l)=-aggj(k,l)
2736 aggj1(k,l)=-aggj1(k,l)
2742 IF (wel_loc.gt.0.0d0) THEN
2743 C Contribution to the local-electrostatic energy coming from the i-j pair
2744 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2746 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2747 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2748 if (shield_mode.eq.0) then
2755 eel_loc_ij=eel_loc_ij
2756 & *fac_shield(i)*fac_shield(j)
2757 eel_loc=eel_loc+eel_loc_ij
2758 C Partial derivatives in virtual-bond dihedral angles gamma
2760 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2761 & (shield_mode.gt.0)) then
2764 do ilist=1,ishield_list(i)
2765 iresshield=shield_list(ilist,i)
2767 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2770 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2772 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2773 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2777 do ilist=1,ishield_list(j)
2778 iresshield=shield_list(ilist,j)
2780 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2783 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2785 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2786 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2792 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2793 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2794 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2795 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2796 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2797 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2798 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2799 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2803 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2804 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2805 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2806 & *fac_shield(i)*fac_shield(j)
2807 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2808 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2809 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2810 & *fac_shield(i)*fac_shield(j)
2812 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2813 cd write(iout,*) 'agg ',agg
2814 cd write(iout,*) 'aggi ',aggi
2815 cd write(iout,*) 'aggi1',aggi1
2816 cd write(iout,*) 'aggj ',aggj
2817 cd write(iout,*) 'aggj1',aggj1
2819 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2821 ggg(l)=agg(l,1)*muij(1)+
2822 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2823 & *fac_shield(i)*fac_shield(j)
2828 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2831 C Remaining derivatives of eello
2833 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2834 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2835 & *fac_shield(i)*fac_shield(j)
2837 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2838 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2839 & *fac_shield(i)*fac_shield(j)
2841 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2842 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2843 & *fac_shield(i)*fac_shield(j)
2845 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2846 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2847 & *fac_shield(i)*fac_shield(j)
2852 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2853 C Contributions from turns
2858 call eturn34(i,j,eello_turn3,eello_turn4)
2860 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2861 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2863 C Calculate the contact function. The ith column of the array JCONT will
2864 C contain the numbers of atoms that make contacts with the atom I (of numbers
2865 C greater than I). The arrays FACONT and GACONT will contain the values of
2866 C the contact function and its derivative.
2867 c r0ij=1.02D0*rpp(iteli,itelj)
2868 c r0ij=1.11D0*rpp(iteli,itelj)
2869 r0ij=2.20D0*rpp(iteli,itelj)
2870 c r0ij=1.55D0*rpp(iteli,itelj)
2871 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2872 if (fcont.gt.0.0D0) then
2873 num_conti=num_conti+1
2874 if (num_conti.gt.maxconts) then
2875 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2876 & ' will skip next contacts for this conf.'
2878 jcont_hb(num_conti,i)=j
2879 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2880 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2881 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2883 d_cont(num_conti,i)=rij
2884 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2885 C --- Electrostatic-interaction matrix ---
2886 a_chuj(1,1,num_conti,i)=a22
2887 a_chuj(1,2,num_conti,i)=a23
2888 a_chuj(2,1,num_conti,i)=a32
2889 a_chuj(2,2,num_conti,i)=a33
2890 C --- Gradient of rij
2892 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2895 c a_chuj(1,1,num_conti,i)=-0.61d0
2896 c a_chuj(1,2,num_conti,i)= 0.4d0
2897 c a_chuj(2,1,num_conti,i)= 0.65d0
2898 c a_chuj(2,2,num_conti,i)= 0.50d0
2899 c else if (i.eq.2) then
2900 c a_chuj(1,1,num_conti,i)= 0.0d0
2901 c a_chuj(1,2,num_conti,i)= 0.0d0
2902 c a_chuj(2,1,num_conti,i)= 0.0d0
2903 c a_chuj(2,2,num_conti,i)= 0.0d0
2905 C --- and its gradients
2906 cd write (iout,*) 'i',i,' j',j
2908 cd write (iout,*) 'iii 1 kkk',kkk
2909 cd write (iout,*) agg(kkk,:)
2912 cd write (iout,*) 'iii 2 kkk',kkk
2913 cd write (iout,*) aggi(kkk,:)
2916 cd write (iout,*) 'iii 3 kkk',kkk
2917 cd write (iout,*) aggi1(kkk,:)
2920 cd write (iout,*) 'iii 4 kkk',kkk
2921 cd write (iout,*) aggj(kkk,:)
2924 cd write (iout,*) 'iii 5 kkk',kkk
2925 cd write (iout,*) aggj1(kkk,:)
2932 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2933 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2934 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2935 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2936 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2938 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2944 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2945 C Calculate contact energies
2947 wij=cosa-3.0D0*cosb*cosg
2950 c fac3=dsqrt(-ael6i)/r0ij**3
2951 fac3=dsqrt(-ael6i)*r3ij
2952 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2953 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2954 if (shield_mode.eq.0) then
2958 ees0plist(num_conti,i)=j
2959 C fac_shield(i)=0.4d0
2960 C fac_shield(j)=0.6d0
2963 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2964 & *fac_shield(i)*fac_shield(j)
2966 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2967 & *fac_shield(i)*fac_shield(j)
2969 C Diagnostics. Comment out or remove after debugging!
2970 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2971 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2972 c ees0m(num_conti,i)=0.0D0
2974 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2975 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2976 facont_hb(num_conti,i)=fcont
2978 C Angular derivatives of the contact function
2979 ees0pij1=fac3/ees0pij
2980 ees0mij1=fac3/ees0mij
2981 fac3p=-3.0D0*fac3*rrmij
2982 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2983 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2985 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2986 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2987 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2988 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2989 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2990 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2991 ecosap=ecosa1+ecosa2
2992 ecosbp=ecosb1+ecosb2
2993 ecosgp=ecosg1+ecosg2
2994 ecosam=ecosa1-ecosa2
2995 ecosbm=ecosb1-ecosb2
2996 ecosgm=ecosg1-ecosg2
3005 fprimcont=fprimcont/rij
3006 cd facont_hb(num_conti,i)=1.0D0
3007 C Following line is for diagnostics.
3010 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3011 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3014 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3015 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3017 gggp(1)=gggp(1)+ees0pijp*xj
3018 gggp(2)=gggp(2)+ees0pijp*yj
3019 gggp(3)=gggp(3)+ees0pijp*zj
3020 gggm(1)=gggm(1)+ees0mijp*xj
3021 gggm(2)=gggm(2)+ees0mijp*yj
3022 gggm(3)=gggm(3)+ees0mijp*zj
3023 C Derivatives due to the contact function
3024 gacont_hbr(1,num_conti,i)=fprimcont*xj
3025 gacont_hbr(2,num_conti,i)=fprimcont*yj
3026 gacont_hbr(3,num_conti,i)=fprimcont*zj
3028 ghalfp=0.5D0*gggp(k)
3029 ghalfm=0.5D0*gggm(k)
3030 gacontp_hb1(k,num_conti,i)=ghalfp
3031 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3032 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3033 & *fac_shield(i)*fac_shield(j)
3035 gacontp_hb2(k,num_conti,i)=ghalfp
3036 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3037 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3038 & *fac_shield(i)*fac_shield(j)
3040 gacontp_hb3(k,num_conti,i)=gggp(k)
3041 & *fac_shield(i)*fac_shield(j)
3043 gacontm_hb1(k,num_conti,i)=ghalfm
3044 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3045 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3046 & *fac_shield(i)*fac_shield(j)
3048 gacontm_hb2(k,num_conti,i)=ghalfm
3049 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3050 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3051 & *fac_shield(i)*fac_shield(j)
3053 gacontm_hb3(k,num_conti,i)=gggm(k)
3054 & *fac_shield(i)*fac_shield(j)
3058 C Diagnostics. Comment out or remove after debugging!
3060 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3061 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3062 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3063 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3064 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3065 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3068 endif ! num_conti.le.maxconts
3073 num_cont_hb(i)=num_conti
3077 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3078 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3080 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3081 ccc eel_loc=eel_loc+eello_turn3
3084 C-----------------------------------------------------------------------------
3085 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3086 C Third- and fourth-order contributions from turns
3087 implicit real*8 (a-h,o-z)
3088 include 'DIMENSIONS'
3089 include 'sizesclu.dat'
3090 include 'COMMON.IOUNITS'
3091 include 'COMMON.GEO'
3092 include 'COMMON.VAR'
3093 include 'COMMON.LOCAL'
3094 include 'COMMON.CHAIN'
3095 include 'COMMON.DERIV'
3096 include 'COMMON.INTERACT'
3097 include 'COMMON.CONTACTS'
3098 include 'COMMON.TORSION'
3099 include 'COMMON.VECTORS'
3100 include 'COMMON.FFIELD'
3101 include 'COMMON.SHIELD'
3102 include 'COMMON.CONTROL'
3105 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3106 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3107 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3108 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3109 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3110 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3112 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3113 C changes suggested by Ana to avoid out of bounds
3114 C & .or.((i+5).gt.nres)
3115 C & .or.((i-1).le.0)
3116 C end of changes suggested by Ana
3117 & .or. itype(i+2).eq.ntyp1
3118 & .or. itype(i+3).eq.ntyp1
3119 C & .or. itype(i+5).eq.ntyp1
3120 C & .or. itype(i).eq.ntyp1
3121 C & .or. itype(i-1).eq.ntyp1
3124 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3126 C Third-order contributions
3133 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3134 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3135 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3136 call transpose2(auxmat(1,1),auxmat1(1,1))
3137 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3138 if (shield_mode.eq.0) then
3145 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3146 & *fac_shield(i)*fac_shield(j)
3147 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3148 & *fac_shield(i)*fac_shield(j)
3150 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3151 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3152 cd & ' eello_turn3_num',4*eello_turn3_num
3154 C Derivatives in shield mode
3155 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3156 & (shield_mode.gt.0)) then
3159 do ilist=1,ishield_list(i)
3160 iresshield=shield_list(ilist,i)
3162 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3164 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3166 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3167 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3171 do ilist=1,ishield_list(j)
3172 iresshield=shield_list(ilist,j)
3174 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3176 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3178 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3179 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3186 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3187 & grad_shield(k,i)*eello_t3/fac_shield(i)
3188 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3189 & grad_shield(k,j)*eello_t3/fac_shield(j)
3190 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3191 & grad_shield(k,i)*eello_t3/fac_shield(i)
3192 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3193 & grad_shield(k,j)*eello_t3/fac_shield(j)
3197 C Derivatives in gamma(i)
3198 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3199 call transpose2(auxmat2(1,1),pizda(1,1))
3200 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3201 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3202 & *fac_shield(i)*fac_shield(j)
3204 C Derivatives in gamma(i+1)
3205 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3206 call transpose2(auxmat2(1,1),pizda(1,1))
3207 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3208 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3209 & +0.5d0*(pizda(1,1)+pizda(2,2))
3210 & *fac_shield(i)*fac_shield(j)
3212 C Cartesian derivatives
3214 a_temp(1,1)=aggi(l,1)
3215 a_temp(1,2)=aggi(l,2)
3216 a_temp(2,1)=aggi(l,3)
3217 a_temp(2,2)=aggi(l,4)
3218 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3219 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3220 & +0.5d0*(pizda(1,1)+pizda(2,2))
3221 & *fac_shield(i)*fac_shield(j)
3223 a_temp(1,1)=aggi1(l,1)
3224 a_temp(1,2)=aggi1(l,2)
3225 a_temp(2,1)=aggi1(l,3)
3226 a_temp(2,2)=aggi1(l,4)
3227 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3228 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3229 & +0.5d0*(pizda(1,1)+pizda(2,2))
3230 & *fac_shield(i)*fac_shield(j)
3232 a_temp(1,1)=aggj(l,1)
3233 a_temp(1,2)=aggj(l,2)
3234 a_temp(2,1)=aggj(l,3)
3235 a_temp(2,2)=aggj(l,4)
3236 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3237 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3238 & +0.5d0*(pizda(1,1)+pizda(2,2))
3239 & *fac_shield(i)*fac_shield(j)
3241 a_temp(1,1)=aggj1(l,1)
3242 a_temp(1,2)=aggj1(l,2)
3243 a_temp(2,1)=aggj1(l,3)
3244 a_temp(2,2)=aggj1(l,4)
3245 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3246 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3247 & +0.5d0*(pizda(1,1)+pizda(2,2))
3248 & *fac_shield(i)*fac_shield(j)
3253 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3254 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3255 C changes suggested by Ana to avoid out of bounds
3256 C & .or.((i+5).gt.nres)
3257 C & .or.((i-1).le.0)
3258 C end of changes suggested by Ana
3259 & .or. itype(i+3).eq.ntyp1
3260 & .or. itype(i+4).eq.ntyp1
3261 C & .or. itype(i+5).eq.ntyp1
3262 & .or. itype(i).eq.ntyp1
3263 C & .or. itype(i-1).eq.ntyp1
3266 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3268 C Fourth-order contributions
3276 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3277 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3278 iti1=itortyp(itype(i+1))
3279 iti2=itortyp(itype(i+2))
3280 iti3=itortyp(itype(i+3))
3281 call transpose2(EUg(1,1,i+1),e1t(1,1))
3282 call transpose2(Eug(1,1,i+2),e2t(1,1))
3283 call transpose2(Eug(1,1,i+3),e3t(1,1))
3284 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3285 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3286 s1=scalar2(b1(1,iti2),auxvec(1))
3287 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3288 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3289 s2=scalar2(b1(1,iti1),auxvec(1))
3290 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3291 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3292 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3293 if (shield_mode.eq.0) then
3300 eello_turn4=eello_turn4-(s1+s2+s3)
3301 & *fac_shield(i)*fac_shield(j)
3302 eello_t4=-(s1+s2+s3)
3303 & *fac_shield(i)*fac_shield(j)
3305 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3306 cd & ' eello_turn4_num',8*eello_turn4_num
3307 C Derivatives in gamma(i)
3309 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3310 & (shield_mode.gt.0)) then
3313 do ilist=1,ishield_list(i)
3314 iresshield=shield_list(ilist,i)
3316 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3318 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3320 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3321 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3325 do ilist=1,ishield_list(j)
3326 iresshield=shield_list(ilist,j)
3328 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3330 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3332 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3333 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3340 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3341 & grad_shield(k,i)*eello_t4/fac_shield(i)
3342 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3343 & grad_shield(k,j)*eello_t4/fac_shield(j)
3344 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3345 & grad_shield(k,i)*eello_t4/fac_shield(i)
3346 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3347 & grad_shield(k,j)*eello_t4/fac_shield(j)
3351 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3352 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3353 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3354 s1=scalar2(b1(1,iti2),auxvec(1))
3355 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3356 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3357 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3358 & *fac_shield(i)*fac_shield(j)
3360 C Derivatives in gamma(i+1)
3361 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3362 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3363 s2=scalar2(b1(1,iti1),auxvec(1))
3364 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3365 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3366 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3367 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3368 & *fac_shield(i)*fac_shield(j)
3370 C Derivatives in gamma(i+2)
3371 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3372 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3373 s1=scalar2(b1(1,iti2),auxvec(1))
3374 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3375 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3376 s2=scalar2(b1(1,iti1),auxvec(1))
3377 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3378 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3379 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3380 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3381 & *fac_shield(i)*fac_shield(j)
3383 C Cartesian derivatives
3384 C Derivatives of this turn contributions in DC(i+2)
3385 if (j.lt.nres-1) then
3387 a_temp(1,1)=agg(l,1)
3388 a_temp(1,2)=agg(l,2)
3389 a_temp(2,1)=agg(l,3)
3390 a_temp(2,2)=agg(l,4)
3391 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3392 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3393 s1=scalar2(b1(1,iti2),auxvec(1))
3394 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3395 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3396 s2=scalar2(b1(1,iti1),auxvec(1))
3397 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3398 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3399 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3401 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3402 & *fac_shield(i)*fac_shield(j)
3406 C Remaining derivatives of this turn contribution
3408 a_temp(1,1)=aggi(l,1)
3409 a_temp(1,2)=aggi(l,2)
3410 a_temp(2,1)=aggi(l,3)
3411 a_temp(2,2)=aggi(l,4)
3412 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3413 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3414 s1=scalar2(b1(1,iti2),auxvec(1))
3415 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3416 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3417 s2=scalar2(b1(1,iti1),auxvec(1))
3418 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3419 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3420 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3421 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3422 & *fac_shield(i)*fac_shield(j)
3424 a_temp(1,1)=aggi1(l,1)
3425 a_temp(1,2)=aggi1(l,2)
3426 a_temp(2,1)=aggi1(l,3)
3427 a_temp(2,2)=aggi1(l,4)
3428 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3429 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3430 s1=scalar2(b1(1,iti2),auxvec(1))
3431 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3432 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3433 s2=scalar2(b1(1,iti1),auxvec(1))
3434 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3435 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3436 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3437 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3438 & *fac_shield(i)*fac_shield(j)
3440 a_temp(1,1)=aggj(l,1)
3441 a_temp(1,2)=aggj(l,2)
3442 a_temp(2,1)=aggj(l,3)
3443 a_temp(2,2)=aggj(l,4)
3444 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3445 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3446 s1=scalar2(b1(1,iti2),auxvec(1))
3447 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3448 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3449 s2=scalar2(b1(1,iti1),auxvec(1))
3450 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3451 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3452 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3453 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3454 & *fac_shield(i)*fac_shield(j)
3456 a_temp(1,1)=aggj1(l,1)
3457 a_temp(1,2)=aggj1(l,2)
3458 a_temp(2,1)=aggj1(l,3)
3459 a_temp(2,2)=aggj1(l,4)
3460 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3461 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3462 s1=scalar2(b1(1,iti2),auxvec(1))
3463 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3464 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3465 s2=scalar2(b1(1,iti1),auxvec(1))
3466 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3467 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3468 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3469 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3470 & *fac_shield(i)*fac_shield(j)
3478 C-----------------------------------------------------------------------------
3479 subroutine vecpr(u,v,w)
3480 implicit real*8(a-h,o-z)
3481 dimension u(3),v(3),w(3)
3482 w(1)=u(2)*v(3)-u(3)*v(2)
3483 w(2)=-u(1)*v(3)+u(3)*v(1)
3484 w(3)=u(1)*v(2)-u(2)*v(1)
3487 C-----------------------------------------------------------------------------
3488 subroutine unormderiv(u,ugrad,unorm,ungrad)
3489 C This subroutine computes the derivatives of a normalized vector u, given
3490 C the derivatives computed without normalization conditions, ugrad. Returns
3493 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3494 double precision vec(3)
3495 double precision scalar
3497 c write (2,*) 'ugrad',ugrad
3500 vec(i)=scalar(ugrad(1,i),u(1))
3502 c write (2,*) 'vec',vec
3505 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3508 c write (2,*) 'ungrad',ungrad
3511 C-----------------------------------------------------------------------------
3512 subroutine escp(evdw2,evdw2_14)
3514 C This subroutine calculates the excluded-volume interaction energy between
3515 C peptide-group centers and side chains and its gradient in virtual-bond and
3516 C side-chain vectors.
3518 implicit real*8 (a-h,o-z)
3519 include 'DIMENSIONS'
3520 include 'sizesclu.dat'
3521 include 'COMMON.GEO'
3522 include 'COMMON.VAR'
3523 include 'COMMON.LOCAL'
3524 include 'COMMON.CHAIN'
3525 include 'COMMON.DERIV'
3526 include 'COMMON.INTERACT'
3527 include 'COMMON.FFIELD'
3528 include 'COMMON.IOUNITS'
3532 cd print '(a)','Enter ESCP'
3533 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3534 c & ' scal14',scal14
3535 do i=iatscp_s,iatscp_e
3536 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3538 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3539 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3540 if (iteli.eq.0) goto 1225
3541 xi=0.5D0*(c(1,i)+c(1,i+1))
3542 yi=0.5D0*(c(2,i)+c(2,i+1))
3543 zi=0.5D0*(c(3,i)+c(3,i+1))
3544 C Returning the ith atom to box
3546 if (xi.lt.0) xi=xi+boxxsize
3548 if (yi.lt.0) yi=yi+boxysize
3550 if (zi.lt.0) zi=zi+boxzsize
3552 do iint=1,nscp_gr(i)
3554 do j=iscpstart(i,iint),iscpend(i,iint)
3555 itypj=iabs(itype(j))
3556 if (itypj.eq.ntyp1) cycle
3557 C Uncomment following three lines for SC-p interactions
3561 C Uncomment following three lines for Ca-p interactions
3565 C returning the jth atom to box
3567 if (xj.lt.0) xj=xj+boxxsize
3569 if (yj.lt.0) yj=yj+boxysize
3571 if (zj.lt.0) zj=zj+boxzsize
3572 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3577 C Finding the closest jth atom
3581 xj=xj_safe+xshift*boxxsize
3582 yj=yj_safe+yshift*boxysize
3583 zj=zj_safe+zshift*boxzsize
3584 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3585 if(dist_temp.lt.dist_init) then
3595 if (subchap.eq.1) then
3605 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3606 C sss is scaling function for smoothing the cutoff gradient otherwise
3607 C the gradient would not be continuouse
3608 sss=sscale(1.0d0/(dsqrt(rrij)))
3609 if (sss.le.0.0d0) cycle
3610 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3612 e1=fac*fac*aad(itypj,iteli)
3613 e2=fac*bad(itypj,iteli)
3614 if (iabs(j-i) .le. 2) then
3617 evdw2_14=evdw2_14+(e1+e2)*sss
3620 c write (iout,*) i,j,evdwij
3621 evdw2=evdw2+evdwij*sss
3624 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3626 fac=-(evdwij+e1)*rrij*sss
3627 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3632 cd write (iout,*) 'j<i'
3633 C Uncomment following three lines for SC-p interactions
3635 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3638 cd write (iout,*) 'j>i'
3641 C Uncomment following line for SC-p interactions
3642 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3646 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3650 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3651 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3654 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3664 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3665 gradx_scp(j,i)=expon*gradx_scp(j,i)
3668 C******************************************************************************
3672 C To save time the factor EXPON has been extracted from ALL components
3673 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3676 C******************************************************************************
3679 C--------------------------------------------------------------------------
3680 subroutine edis(ehpb)
3682 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3684 implicit real*8 (a-h,o-z)
3685 include 'DIMENSIONS'
3686 include 'sizesclu.dat'
3687 include 'COMMON.SBRIDGE'
3688 include 'COMMON.CHAIN'
3689 include 'COMMON.DERIV'
3690 include 'COMMON.VAR'
3691 include 'COMMON.INTERACT'
3692 include 'COMMON.CONTROL'
3695 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3696 cd print *,'link_start=',link_start,' link_end=',link_end
3697 if (link_end.eq.0) return
3698 do i=link_start,link_end
3699 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3700 C CA-CA distance used in regularization of structure.
3703 C iii and jjj point to the residues for which the distance is assigned.
3704 if (ii.gt.nres) then
3711 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3712 C distance and angle dependent SS bond potential.
3713 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3714 C & iabs(itype(jjj)).eq.1) then
3715 C call ssbond_ene(iii,jjj,eij)
3718 if (.not.dyn_ss .and. i.le.nss) then
3719 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3720 & iabs(itype(jjj)).eq.1) then
3721 call ssbond_ene(iii,jjj,eij)
3724 else if (ii.gt.nres .and. jj.gt.nres) then
3725 c Restraints from contact prediction
3727 if (constr_dist.eq.11) then
3728 C ehpb=ehpb+fordepth(i)**4.0d0
3729 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3730 ehpb=ehpb+fordepth(i)**4.0d0
3731 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3732 fac=fordepth(i)**4.0d0
3733 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3734 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3735 C & ehpb,fordepth(i),dd
3737 C write(iout,*) ehpb,"atu?"
3739 C fac=fordepth(i)**4.0d0
3740 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3741 else !constr_dist.eq.11
3742 if (dhpb1(i).gt.0.0d0) then
3743 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3744 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3745 c write (iout,*) "beta nmr",
3746 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3747 else !dhpb(i).gt.0.00
3749 C Calculate the distance between the two points and its difference from the
3753 C Get the force constant corresponding to this distance.
3755 C Calculate the contribution to energy.
3756 ehpb=ehpb+waga*rdis*rdis
3758 C Evaluate gradient.
3763 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3764 cd & ' waga=',waga,' fac=',fac
3766 ggg(j)=fac*(c(j,jj)-c(j,ii))
3768 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3769 C If this is a SC-SC distance, we need to calculate the contributions to the
3770 C Cartesian gradient in the SC vectors (ghpbx).
3773 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3774 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3778 C write(iout,*) "before"
3780 C write(iout,*) "after",dd
3781 if (constr_dist.eq.11) then
3782 ehpb=ehpb+fordepth(i)**4.0d0
3783 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3784 fac=fordepth(i)**4.0d0
3785 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3786 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3787 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3788 C print *,ehpb,"tu?"
3789 C write(iout,*) ehpb,"btu?",
3790 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3791 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3792 C & ehpb,fordepth(i),dd
3794 if (dhpb1(i).gt.0.0d0) then
3795 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3796 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3797 c write (iout,*) "alph nmr",
3798 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3801 C Get the force constant corresponding to this distance.
3803 C Calculate the contribution to energy.
3804 ehpb=ehpb+waga*rdis*rdis
3805 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3807 C Evaluate gradient.
3813 ggg(j)=fac*(c(j,jj)-c(j,ii))
3815 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3816 C If this is a SC-SC distance, we need to calculate the contributions to the
3817 C Cartesian gradient in the SC vectors (ghpbx).
3820 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3821 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3826 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3831 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3834 C--------------------------------------------------------------------------
3835 subroutine ssbond_ene(i,j,eij)
3837 C Calculate the distance and angle dependent SS-bond potential energy
3838 C using a free-energy function derived based on RHF/6-31G** ab initio
3839 C calculations of diethyl disulfide.
3841 C A. Liwo and U. Kozlowska, 11/24/03
3843 implicit real*8 (a-h,o-z)
3844 include 'DIMENSIONS'
3845 include 'sizesclu.dat'
3846 include 'COMMON.SBRIDGE'
3847 include 'COMMON.CHAIN'
3848 include 'COMMON.DERIV'
3849 include 'COMMON.LOCAL'
3850 include 'COMMON.INTERACT'
3851 include 'COMMON.VAR'
3852 include 'COMMON.IOUNITS'
3853 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3854 itypi=iabs(itype(i))
3858 dxi=dc_norm(1,nres+i)
3859 dyi=dc_norm(2,nres+i)
3860 dzi=dc_norm(3,nres+i)
3861 dsci_inv=dsc_inv(itypi)
3862 itypj=iabs(itype(j))
3863 dscj_inv=dsc_inv(itypj)
3867 dxj=dc_norm(1,nres+j)
3868 dyj=dc_norm(2,nres+j)
3869 dzj=dc_norm(3,nres+j)
3870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3875 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3876 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3877 om12=dxi*dxj+dyi*dyj+dzi*dzj
3879 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3880 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3886 deltat12=om2-om1+2.0d0
3888 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3889 & +akct*deltad*deltat12
3890 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3891 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3892 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3893 c & " deltat12",deltat12," eij",eij
3894 ed=2*akcm*deltad+akct*deltat12
3896 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3897 eom1=-2*akth*deltat1-pom1-om2*pom2
3898 eom2= 2*akth*deltat2+pom1-om1*pom2
3901 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3904 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3905 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3906 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3907 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3910 C Calculate the components of the gradient in DC and X
3914 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3919 C--------------------------------------------------------------------------
3920 subroutine ebond(estr)
3922 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3924 implicit real*8 (a-h,o-z)
3925 include 'DIMENSIONS'
3926 include 'sizesclu.dat'
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.CONTROL'
3937 logical energy_dec /.false./
3938 double precision u(3),ud(3)
3942 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3943 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3945 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3946 C & *dc(j,i-1)/vbld(i)
3948 C if (energy_dec) write(iout,*)
3949 C & "estr1",i,vbld(i),distchainmax,
3950 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3952 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3953 diff = vbld(i)-vbldpDUM
3955 diff = vbld(i)-vbldp0
3956 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3960 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3963 C write (iout,'(a7,i5,4f7.3)')
3964 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3966 estr=0.5d0*AKP*estr+estr1
3968 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3972 if (iti.ne.10 .and. iti.ne.ntyp1) then
3975 diff=vbld(i+nres)-vbldsc0(1,iti)
3976 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3977 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3978 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3980 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3984 diff=vbld(i+nres)-vbldsc0(j,iti)
3985 ud(j)=aksc(j,iti)*diff
3986 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4000 uprod2=uprod2*u(k)*u(k)
4004 usumsqder=usumsqder+ud(j)*uprod2
4006 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4007 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4008 estr=estr+uprod/usum
4010 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4018 C--------------------------------------------------------------------------
4019 subroutine ebend(etheta,ethetacnstr)
4021 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4022 C angles gamma and its derivatives in consecutive thetas and gammas.
4024 implicit real*8 (a-h,o-z)
4025 include 'DIMENSIONS'
4026 include 'sizesclu.dat'
4027 include 'COMMON.LOCAL'
4028 include 'COMMON.GEO'
4029 include 'COMMON.INTERACT'
4030 include 'COMMON.DERIV'
4031 include 'COMMON.VAR'
4032 include 'COMMON.CHAIN'
4033 include 'COMMON.IOUNITS'
4034 include 'COMMON.NAMES'
4035 include 'COMMON.FFIELD'
4036 include 'COMMON.TORCNSTR'
4037 common /calcthet/ term1,term2,termm,diffak,ratak,
4038 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4039 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4040 double precision y(2),z(2)
4042 c time11=dexp(-2*time)
4045 c write (iout,*) "nres",nres
4046 c write (*,'(a,i2)') 'EBEND ICG=',icg
4047 c write (iout,*) ithet_start,ithet_end
4048 do i=ithet_start,ithet_end
4050 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4051 & .or.itype(i).eq.ntyp1) cycle
4052 C Zero the energy function and its derivative at 0 or pi.
4053 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4055 ichir1=isign(1,itype(i-2))
4056 ichir2=isign(1,itype(i))
4057 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4058 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4059 if (itype(i-1).eq.10) then
4060 itype1=isign(10,itype(i-2))
4061 ichir11=isign(1,itype(i-2))
4062 ichir12=isign(1,itype(i-2))
4063 itype2=isign(10,itype(i))
4064 ichir21=isign(1,itype(i))
4065 ichir22=isign(1,itype(i))
4071 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4075 c call proc_proc(phii,icrc)
4076 if (icrc.eq.1) phii=150.0
4087 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4091 c call proc_proc(phii1,icrc)
4092 if (icrc.eq.1) phii1=150.0
4104 C Calculate the "mean" value of theta from the part of the distribution
4105 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4106 C In following comments this theta will be referred to as t_c.
4107 thet_pred_mean=0.0d0
4109 athetk=athet(k,it,ichir1,ichir2)
4110 bthetk=bthet(k,it,ichir1,ichir2)
4112 athetk=athet(k,itype1,ichir11,ichir12)
4113 bthetk=bthet(k,itype2,ichir21,ichir22)
4115 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4117 c write (iout,*) "thet_pred_mean",thet_pred_mean
4118 dthett=thet_pred_mean*ssd
4119 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4120 c write (iout,*) "thet_pred_mean",thet_pred_mean
4121 C Derivatives of the "mean" values in gamma1 and gamma2.
4122 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4123 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4124 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4125 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4127 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4128 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4129 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4130 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4132 if (theta(i).gt.pi-delta) then
4133 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4135 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4136 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4137 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4139 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4141 else if (theta(i).lt.delta) then
4142 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4143 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4144 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4146 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4147 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4150 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4153 etheta=etheta+ethetai
4154 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4155 c & rad2deg*phii,rad2deg*phii1,ethetai
4156 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4157 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4158 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4161 C Ufff.... We've done all this!!!
4164 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4165 do i=1,ntheta_constr
4166 itheta=itheta_constr(i)
4167 thetiii=theta(itheta)
4168 difi=pinorm(thetiii-theta_constr0(i))
4169 if (difi.gt.theta_drange(i)) then
4170 difi=difi-theta_drange(i)
4171 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4172 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4173 & +for_thet_constr(i)*difi**3
4174 else if (difi.lt.-drange(i)) then
4176 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4177 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4178 & +for_thet_constr(i)*difi**3
4182 C if (energy_dec) then
4183 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4184 C & i,itheta,rad2deg*thetiii,
4185 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4186 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4187 C & gloc(itheta+nphi-2,icg)
4192 C---------------------------------------------------------------------------
4193 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4195 implicit real*8 (a-h,o-z)
4196 include 'DIMENSIONS'
4197 include 'COMMON.LOCAL'
4198 include 'COMMON.IOUNITS'
4199 common /calcthet/ term1,term2,termm,diffak,ratak,
4200 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4201 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4202 C Calculate the contributions to both Gaussian lobes.
4203 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4204 C The "polynomial part" of the "standard deviation" of this part of
4208 sig=sig*thet_pred_mean+polthet(j,it)
4210 C Derivative of the "interior part" of the "standard deviation of the"
4211 C gamma-dependent Gaussian lobe in t_c.
4212 sigtc=3*polthet(3,it)
4214 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4217 C Set the parameters of both Gaussian lobes of the distribution.
4218 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4219 fac=sig*sig+sigc0(it)
4222 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4223 sigsqtc=-4.0D0*sigcsq*sigtc
4224 c print *,i,sig,sigtc,sigsqtc
4225 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4226 sigtc=-sigtc/(fac*fac)
4227 C Following variable is sigma(t_c)**(-2)
4228 sigcsq=sigcsq*sigcsq
4230 sig0inv=1.0D0/sig0i**2
4231 delthec=thetai-thet_pred_mean
4232 delthe0=thetai-theta0i
4233 term1=-0.5D0*sigcsq*delthec*delthec
4234 term2=-0.5D0*sig0inv*delthe0*delthe0
4235 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4236 C NaNs in taking the logarithm. We extract the largest exponent which is added
4237 C to the energy (this being the log of the distribution) at the end of energy
4238 C term evaluation for this virtual-bond angle.
4239 if (term1.gt.term2) then
4241 term2=dexp(term2-termm)
4245 term1=dexp(term1-termm)
4248 C The ratio between the gamma-independent and gamma-dependent lobes of
4249 C the distribution is a Gaussian function of thet_pred_mean too.
4250 diffak=gthet(2,it)-thet_pred_mean
4251 ratak=diffak/gthet(3,it)**2
4252 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4253 C Let's differentiate it in thet_pred_mean NOW.
4255 C Now put together the distribution terms to make complete distribution.
4256 termexp=term1+ak*term2
4257 termpre=sigc+ak*sig0i
4258 C Contribution of the bending energy from this theta is just the -log of
4259 C the sum of the contributions from the two lobes and the pre-exponential
4260 C factor. Simple enough, isn't it?
4261 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4262 C NOW the derivatives!!!
4263 C 6/6/97 Take into account the deformation.
4264 E_theta=(delthec*sigcsq*term1
4265 & +ak*delthe0*sig0inv*term2)/termexp
4266 E_tc=((sigtc+aktc*sig0i)/termpre
4267 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4268 & aktc*term2)/termexp)
4271 c-----------------------------------------------------------------------------
4272 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4273 implicit real*8 (a-h,o-z)
4274 include 'DIMENSIONS'
4275 include 'COMMON.LOCAL'
4276 include 'COMMON.IOUNITS'
4277 common /calcthet/ term1,term2,termm,diffak,ratak,
4278 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4279 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4280 delthec=thetai-thet_pred_mean
4281 delthe0=thetai-theta0i
4282 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4283 t3 = thetai-thet_pred_mean
4287 t14 = t12+t6*sigsqtc
4289 t21 = thetai-theta0i
4295 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4296 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4297 & *(-t12*t9-ak*sig0inv*t27)
4301 C--------------------------------------------------------------------------
4302 subroutine ebend(etheta,ethetacnstr)
4304 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4305 C angles gamma and its derivatives in consecutive thetas and gammas.
4306 C ab initio-derived potentials from
4307 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4309 implicit real*8 (a-h,o-z)
4310 include 'DIMENSIONS'
4311 include 'sizesclu.dat'
4312 include 'COMMON.LOCAL'
4313 include 'COMMON.GEO'
4314 include 'COMMON.INTERACT'
4315 include 'COMMON.DERIV'
4316 include 'COMMON.VAR'
4317 include 'COMMON.CHAIN'
4318 include 'COMMON.IOUNITS'
4319 include 'COMMON.NAMES'
4320 include 'COMMON.FFIELD'
4321 include 'COMMON.CONTROL'
4322 include 'COMMON.TORCNSTR'
4323 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4324 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4325 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4326 & sinph1ph2(maxdouble,maxdouble)
4327 logical lprn /.false./, lprn1 /.false./
4329 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4330 do i=ithet_start,ithet_end
4332 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4333 & .or.itype(i).eq.ntyp1) cycle
4334 c if (itype(i-1).eq.ntyp1) cycle
4335 if (iabs(itype(i+1)).eq.20) iblock=2
4336 if (iabs(itype(i+1)).ne.20) iblock=1
4340 theti2=0.5d0*theta(i)
4341 ityp2=ithetyp((itype(i-1)))
4343 coskt(k)=dcos(k*theti2)
4344 sinkt(k)=dsin(k*theti2)
4354 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4357 if (phii.ne.phii) phii=150.0
4361 ityp1=ithetyp((itype(i-2)))
4363 cosph1(k)=dcos(k*phii)
4364 sinph1(k)=dsin(k*phii)
4370 ityp1=ithetyp((itype(i-2)))
4376 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4379 if (phii1.ne.phii1) phii1=150.0
4384 ityp3=ithetyp((itype(i)))
4386 cosph2(k)=dcos(k*phii1)
4387 sinph2(k)=dsin(k*phii1)
4392 ityp3=ithetyp((itype(i)))
4398 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4399 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4401 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4404 ccl=cosph1(l)*cosph2(k-l)
4405 ssl=sinph1(l)*sinph2(k-l)
4406 scl=sinph1(l)*cosph2(k-l)
4407 csl=cosph1(l)*sinph2(k-l)
4408 cosph1ph2(l,k)=ccl-ssl
4409 cosph1ph2(k,l)=ccl+ssl
4410 sinph1ph2(l,k)=scl+csl
4411 sinph1ph2(k,l)=scl-csl
4415 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4416 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4417 write (iout,*) "coskt and sinkt"
4419 write (iout,*) k,coskt(k),sinkt(k)
4423 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4424 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4427 & write (iout,*) "k",k," aathet",
4428 & aathet(k,ityp1,ityp2,ityp3,iblock),
4429 & " ethetai",ethetai
4432 write (iout,*) "cosph and sinph"
4434 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4436 write (iout,*) "cosph1ph2 and sinph2ph2"
4439 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4440 & sinph1ph2(l,k),sinph1ph2(k,l)
4443 write(iout,*) "ethetai",ethetai
4447 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4448 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4449 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4450 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4451 ethetai=ethetai+sinkt(m)*aux
4452 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4453 dephii=dephii+k*sinkt(m)*(
4454 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4455 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4456 dephii1=dephii1+k*sinkt(m)*(
4457 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4458 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4460 & write (iout,*) "m",m," k",k," bbthet",
4461 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4462 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4463 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4464 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4468 & write(iout,*) "ethetai",ethetai
4472 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4473 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4474 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4475 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4476 ethetai=ethetai+sinkt(m)*aux
4477 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4478 dephii=dephii+l*sinkt(m)*(
4479 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4480 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4481 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4482 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4483 dephii1=dephii1+(k-l)*sinkt(m)*(
4484 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4485 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4486 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4487 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4489 write (iout,*) "m",m," k",k," l",l," ffthet",
4490 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4491 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4492 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4493 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4494 & " ethetai",ethetai
4495 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4496 & cosph1ph2(k,l)*sinkt(m),
4497 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4503 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4504 & i,theta(i)*rad2deg,phii*rad2deg,
4505 & phii1*rad2deg,ethetai
4506 etheta=etheta+ethetai
4507 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4508 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4509 c gloc(nphi+i-2,icg)=wang*dethetai
4510 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4514 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4515 do i=1,ntheta_constr
4516 itheta=itheta_constr(i)
4517 thetiii=theta(itheta)
4518 difi=pinorm(thetiii-theta_constr0(i))
4519 if (difi.gt.theta_drange(i)) then
4520 difi=difi-theta_drange(i)
4521 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4522 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4523 & +for_thet_constr(i)*difi**3
4524 else if (difi.lt.-drange(i)) then
4526 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4527 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4528 & +for_thet_constr(i)*difi**3
4532 C if (energy_dec) then
4533 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4534 C & i,itheta,rad2deg*thetiii,
4535 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4536 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4537 C & gloc(itheta+nphi-2,icg)
4544 c-----------------------------------------------------------------------------
4545 subroutine esc(escloc)
4546 C Calculate the local energy of a side chain and its derivatives in the
4547 C corresponding virtual-bond valence angles THETA and the spherical angles
4549 implicit real*8 (a-h,o-z)
4550 include 'DIMENSIONS'
4551 include 'sizesclu.dat'
4552 include 'COMMON.GEO'
4553 include 'COMMON.LOCAL'
4554 include 'COMMON.VAR'
4555 include 'COMMON.INTERACT'
4556 include 'COMMON.DERIV'
4557 include 'COMMON.CHAIN'
4558 include 'COMMON.IOUNITS'
4559 include 'COMMON.NAMES'
4560 include 'COMMON.FFIELD'
4561 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4562 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4563 common /sccalc/ time11,time12,time112,theti,it,nlobit
4566 c write (iout,'(a)') 'ESC'
4567 do i=loc_start,loc_end
4569 if (it.eq.ntyp1) cycle
4570 if (it.eq.10) goto 1
4571 nlobit=nlob(iabs(it))
4572 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4573 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4574 theti=theta(i+1)-pipol
4578 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4580 if (x(2).gt.pi-delta) then
4584 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4586 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4587 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4589 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4590 & ddersc0(1),dersc(1))
4591 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4592 & ddersc0(3),dersc(3))
4594 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4596 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4597 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4598 & dersc0(2),esclocbi,dersc02)
4599 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4601 call splinthet(x(2),0.5d0*delta,ss,ssd)
4606 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4608 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4609 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4611 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4613 c write (iout,*) escloci
4614 else if (x(2).lt.delta) then
4618 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4620 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4621 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4623 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4624 & ddersc0(1),dersc(1))
4625 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4626 & ddersc0(3),dersc(3))
4628 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4630 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4631 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4632 & dersc0(2),esclocbi,dersc02)
4633 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4638 call splinthet(x(2),0.5d0*delta,ss,ssd)
4640 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4642 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4643 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4645 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4646 c write (iout,*) escloci
4648 call enesc(x,escloci,dersc,ddummy,.false.)
4651 escloc=escloc+escloci
4652 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4654 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4656 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4657 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4662 C---------------------------------------------------------------------------
4663 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4664 implicit real*8 (a-h,o-z)
4665 include 'DIMENSIONS'
4666 include 'COMMON.GEO'
4667 include 'COMMON.LOCAL'
4668 include 'COMMON.IOUNITS'
4669 common /sccalc/ time11,time12,time112,theti,it,nlobit
4670 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4671 double precision contr(maxlob,-1:1)
4673 c write (iout,*) 'it=',it,' nlobit=',nlobit
4677 if (mixed) ddersc(j)=0.0d0
4681 C Because of periodicity of the dependence of the SC energy in omega we have
4682 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4683 C To avoid underflows, first compute & store the exponents.
4691 z(k)=x(k)-censc(k,j,it)
4696 Axk=Axk+gaussc(l,k,j,it)*z(l)
4702 expfac=expfac+Ax(k,j,iii)*z(k)
4710 C As in the case of ebend, we want to avoid underflows in exponentiation and
4711 C subsequent NaNs and INFs in energy calculation.
4712 C Find the largest exponent
4716 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4720 cd print *,'it=',it,' emin=',emin
4722 C Compute the contribution to SC energy and derivatives
4726 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4727 cd print *,'j=',j,' expfac=',expfac
4728 escloc_i=escloc_i+expfac
4730 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4734 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4735 & +gaussc(k,2,j,it))*expfac
4742 dersc(1)=dersc(1)/cos(theti)**2
4743 ddersc(1)=ddersc(1)/cos(theti)**2
4746 escloci=-(dlog(escloc_i)-emin)
4748 dersc(j)=dersc(j)/escloc_i
4752 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4757 C------------------------------------------------------------------------------
4758 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4759 implicit real*8 (a-h,o-z)
4760 include 'DIMENSIONS'
4761 include 'COMMON.GEO'
4762 include 'COMMON.LOCAL'
4763 include 'COMMON.IOUNITS'
4764 common /sccalc/ time11,time12,time112,theti,it,nlobit
4765 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4766 double precision contr(maxlob)
4777 z(k)=x(k)-censc(k,j,it)
4783 Axk=Axk+gaussc(l,k,j,it)*z(l)
4789 expfac=expfac+Ax(k,j)*z(k)
4794 C As in the case of ebend, we want to avoid underflows in exponentiation and
4795 C subsequent NaNs and INFs in energy calculation.
4796 C Find the largest exponent
4799 if (emin.gt.contr(j)) emin=contr(j)
4803 C Compute the contribution to SC energy and derivatives
4807 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4808 escloc_i=escloc_i+expfac
4810 dersc(k)=dersc(k)+Ax(k,j)*expfac
4812 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4813 & +gaussc(1,2,j,it))*expfac
4817 dersc(1)=dersc(1)/cos(theti)**2
4818 dersc12=dersc12/cos(theti)**2
4819 escloci=-(dlog(escloc_i)-emin)
4821 dersc(j)=dersc(j)/escloc_i
4823 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4827 c----------------------------------------------------------------------------------
4828 subroutine esc(escloc)
4829 C Calculate the local energy of a side chain and its derivatives in the
4830 C corresponding virtual-bond valence angles THETA and the spherical angles
4831 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4832 C added by Urszula Kozlowska. 07/11/2007
4834 implicit real*8 (a-h,o-z)
4835 include 'DIMENSIONS'
4836 include 'sizesclu.dat'
4837 include 'COMMON.GEO'
4838 include 'COMMON.LOCAL'
4839 include 'COMMON.VAR'
4840 include 'COMMON.SCROT'
4841 include 'COMMON.INTERACT'
4842 include 'COMMON.DERIV'
4843 include 'COMMON.CHAIN'
4844 include 'COMMON.IOUNITS'
4845 include 'COMMON.NAMES'
4846 include 'COMMON.FFIELD'
4847 include 'COMMON.CONTROL'
4848 include 'COMMON.VECTORS'
4849 double precision x_prime(3),y_prime(3),z_prime(3)
4850 & , sumene,dsc_i,dp2_i,x(65),
4851 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4852 & de_dxx,de_dyy,de_dzz,de_dt
4853 double precision s1_t,s1_6_t,s2_t,s2_6_t
4855 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4856 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4857 & dt_dCi(3),dt_dCi1(3)
4858 common /sccalc/ time11,time12,time112,theti,it,nlobit
4861 do i=loc_start,loc_end
4862 if (itype(i).eq.ntyp1) cycle
4863 costtab(i+1) =dcos(theta(i+1))
4864 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4865 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4866 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4867 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4868 cosfac=dsqrt(cosfac2)
4869 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4870 sinfac=dsqrt(sinfac2)
4872 if (it.eq.10) goto 1
4874 C Compute the axes of tghe local cartesian coordinates system; store in
4875 c x_prime, y_prime and z_prime
4882 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4883 C & dc_norm(3,i+nres)
4885 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4886 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4889 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4892 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4893 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4894 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4895 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4896 c & " xy",scalar(x_prime(1),y_prime(1)),
4897 c & " xz",scalar(x_prime(1),z_prime(1)),
4898 c & " yy",scalar(y_prime(1),y_prime(1)),
4899 c & " yz",scalar(y_prime(1),z_prime(1)),
4900 c & " zz",scalar(z_prime(1),z_prime(1))
4902 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4903 C to local coordinate system. Store in xx, yy, zz.
4909 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4910 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4911 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4918 C Compute the energy of the ith side cbain
4920 c write (2,*) "xx",xx," yy",yy," zz",zz
4923 x(j) = sc_parmin(j,it)
4926 Cc diagnostics - remove later
4928 yy1 = dsin(alph(2))*dcos(omeg(2))
4929 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4930 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4931 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4932 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4934 C," --- ", xx_w,yy_w,zz_w
4937 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4938 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4940 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4941 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4943 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4944 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4945 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4946 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4947 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4949 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4950 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4951 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4952 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4953 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4955 dsc_i = 0.743d0+x(61)
4957 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4958 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4959 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4960 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4961 s1=(1+x(63))/(0.1d0 + dscp1)
4962 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4963 s2=(1+x(65))/(0.1d0 + dscp2)
4964 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4965 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4966 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4967 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4969 c & dscp1,dscp2,sumene
4970 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4971 escloc = escloc + sumene
4972 c write (2,*) "escloc",escloc
4973 if (.not. calc_grad) goto 1
4976 C This section to check the numerical derivatives of the energy of ith side
4977 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4978 C #define DEBUG in the code to turn it on.
4980 write (2,*) "sumene =",sumene
4984 write (2,*) xx,yy,zz
4985 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4986 de_dxx_num=(sumenep-sumene)/aincr
4988 write (2,*) "xx+ sumene from enesc=",sumenep
4991 write (2,*) xx,yy,zz
4992 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4993 de_dyy_num=(sumenep-sumene)/aincr
4995 write (2,*) "yy+ sumene from enesc=",sumenep
4998 write (2,*) xx,yy,zz
4999 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5000 de_dzz_num=(sumenep-sumene)/aincr
5002 write (2,*) "zz+ sumene from enesc=",sumenep
5003 costsave=cost2tab(i+1)
5004 sintsave=sint2tab(i+1)
5005 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5006 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5007 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5008 de_dt_num=(sumenep-sumene)/aincr
5009 write (2,*) " t+ sumene from enesc=",sumenep
5010 cost2tab(i+1)=costsave
5011 sint2tab(i+1)=sintsave
5012 C End of diagnostics section.
5015 C Compute the gradient of esc
5017 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5018 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5019 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5020 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5021 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5022 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5023 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5024 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5025 pom1=(sumene3*sint2tab(i+1)+sumene1)
5026 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5027 pom2=(sumene4*cost2tab(i+1)+sumene2)
5028 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5029 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5030 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5031 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5033 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5034 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5035 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5037 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5038 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5039 & +(pom1+pom2)*pom_dx
5041 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5044 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5045 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5046 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5048 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5049 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5050 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5051 & +x(59)*zz**2 +x(60)*xx*zz
5052 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5053 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5054 & +(pom1-pom2)*pom_dy
5056 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5059 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5060 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5061 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5062 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5063 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5064 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5065 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5066 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5068 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5071 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5072 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5073 & +pom1*pom_dt1+pom2*pom_dt2
5075 write(2,*), "de_dt = ", de_dt,de_dt_num
5079 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5080 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5081 cosfac2xx=cosfac2*xx
5082 sinfac2yy=sinfac2*yy
5084 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5086 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5088 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5089 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5090 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5091 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5092 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5093 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5094 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5095 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5096 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5097 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5101 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5102 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5103 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5104 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5107 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5108 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5109 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5111 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5112 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5116 dXX_Ctab(k,i)=dXX_Ci(k)
5117 dXX_C1tab(k,i)=dXX_Ci1(k)
5118 dYY_Ctab(k,i)=dYY_Ci(k)
5119 dYY_C1tab(k,i)=dYY_Ci1(k)
5120 dZZ_Ctab(k,i)=dZZ_Ci(k)
5121 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5122 dXX_XYZtab(k,i)=dXX_XYZ(k)
5123 dYY_XYZtab(k,i)=dYY_XYZ(k)
5124 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5128 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5129 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5130 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5131 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5132 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5134 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5135 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5136 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5137 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5138 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5139 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5140 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5141 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5143 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5144 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5146 C to check gradient call subroutine check_grad
5153 c------------------------------------------------------------------------------
5154 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5156 C This procedure calculates two-body contact function g(rij) and its derivative:
5159 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5162 C where x=(rij-r0ij)/delta
5164 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5167 double precision rij,r0ij,eps0ij,fcont,fprimcont
5168 double precision x,x2,x4,delta
5172 if (x.lt.-1.0D0) then
5175 else if (x.le.1.0D0) then
5178 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5179 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5186 c------------------------------------------------------------------------------
5187 subroutine splinthet(theti,delta,ss,ssder)
5188 implicit real*8 (a-h,o-z)
5189 include 'DIMENSIONS'
5190 include 'sizesclu.dat'
5191 include 'COMMON.VAR'
5192 include 'COMMON.GEO'
5195 if (theti.gt.pipol) then
5196 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5198 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5203 c------------------------------------------------------------------------------
5204 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5206 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5207 double precision ksi,ksi2,ksi3,a1,a2,a3
5208 a1=fprim0*delta/(f1-f0)
5214 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5215 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5218 c------------------------------------------------------------------------------
5219 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5221 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5222 double precision ksi,ksi2,ksi3,a1,a2,a3
5227 a2=3*(f1x-f0x)-2*fprim0x*delta
5228 a3=fprim0x*delta-2*(f1x-f0x)
5229 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5232 C-----------------------------------------------------------------------------
5234 C-----------------------------------------------------------------------------
5235 subroutine etor(etors,edihcnstr,fact)
5236 implicit real*8 (a-h,o-z)
5237 include 'DIMENSIONS'
5238 include 'sizesclu.dat'
5239 include 'COMMON.VAR'
5240 include 'COMMON.GEO'
5241 include 'COMMON.LOCAL'
5242 include 'COMMON.TORSION'
5243 include 'COMMON.INTERACT'
5244 include 'COMMON.DERIV'
5245 include 'COMMON.CHAIN'
5246 include 'COMMON.NAMES'
5247 include 'COMMON.IOUNITS'
5248 include 'COMMON.FFIELD'
5249 include 'COMMON.TORCNSTR'
5251 C Set lprn=.true. for debugging
5255 do i=iphi_start,iphi_end
5256 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5257 & .or. itype(i).eq.ntyp1) cycle
5258 itori=itortyp(itype(i-2))
5259 itori1=itortyp(itype(i-1))
5262 C Proline-Proline pair is a special case...
5263 if (itori.eq.3 .and. itori1.eq.3) then
5264 if (phii.gt.-dwapi3) then
5266 fac=1.0D0/(1.0D0-cosphi)
5267 etorsi=v1(1,3,3)*fac
5268 etorsi=etorsi+etorsi
5269 etors=etors+etorsi-v1(1,3,3)
5270 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5273 v1ij=v1(j+1,itori,itori1)
5274 v2ij=v2(j+1,itori,itori1)
5277 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5278 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5282 v1ij=v1(j,itori,itori1)
5283 v2ij=v2(j,itori,itori1)
5286 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5287 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5291 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5292 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5293 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5294 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5295 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5297 ! 6/20/98 - dihedral angle constraints
5300 itori=idih_constr(i)
5303 if (difi.gt.drange(i)) then
5305 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5306 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5307 else if (difi.lt.-drange(i)) then
5309 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5310 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5312 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5313 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5315 ! write (iout,*) 'edihcnstr',edihcnstr
5318 c------------------------------------------------------------------------------
5320 subroutine etor(etors,edihcnstr,fact)
5321 implicit real*8 (a-h,o-z)
5322 include 'DIMENSIONS'
5323 include 'sizesclu.dat'
5324 include 'COMMON.VAR'
5325 include 'COMMON.GEO'
5326 include 'COMMON.LOCAL'
5327 include 'COMMON.TORSION'
5328 include 'COMMON.INTERACT'
5329 include 'COMMON.DERIV'
5330 include 'COMMON.CHAIN'
5331 include 'COMMON.NAMES'
5332 include 'COMMON.IOUNITS'
5333 include 'COMMON.FFIELD'
5334 include 'COMMON.TORCNSTR'
5336 C Set lprn=.true. for debugging
5340 do i=iphi_start,iphi_end
5342 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5343 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5344 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5345 if (iabs(itype(i)).eq.20) then
5350 itori=itortyp(itype(i-2))
5351 itori1=itortyp(itype(i-1))
5354 C Regular cosine and sine terms
5355 do j=1,nterm(itori,itori1,iblock)
5356 v1ij=v1(j,itori,itori1,iblock)
5357 v2ij=v2(j,itori,itori1,iblock)
5360 etors=etors+v1ij*cosphi+v2ij*sinphi
5361 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5365 C E = SUM ----------------------------------- - v1
5366 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5368 cosphi=dcos(0.5d0*phii)
5369 sinphi=dsin(0.5d0*phii)
5370 do j=1,nlor(itori,itori1,iblock)
5371 vl1ij=vlor1(j,itori,itori1)
5372 vl2ij=vlor2(j,itori,itori1)
5373 vl3ij=vlor3(j,itori,itori1)
5374 pom=vl2ij*cosphi+vl3ij*sinphi
5375 pom1=1.0d0/(pom*pom+1.0d0)
5376 etors=etors+vl1ij*pom1
5378 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5380 C Subtract the constant term
5381 etors=etors-v0(itori,itori1,iblock)
5383 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5384 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5385 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5386 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5387 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5390 ! 6/20/98 - dihedral angle constraints
5393 itori=idih_constr(i)
5395 difi=pinorm(phii-phi0(i))
5397 if (difi.gt.drange(i)) then
5399 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5400 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5401 edihi=0.25d0*ftors(i)*difi**4
5402 else if (difi.lt.-drange(i)) then
5404 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5405 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5406 edihi=0.25d0*ftors(i)*difi**4
5410 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5412 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5413 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5415 ! write (iout,*) 'edihcnstr',edihcnstr
5418 c----------------------------------------------------------------------------
5419 subroutine etor_d(etors_d,fact2)
5420 C 6/23/01 Compute double torsional energy
5421 implicit real*8 (a-h,o-z)
5422 include 'DIMENSIONS'
5423 include 'sizesclu.dat'
5424 include 'COMMON.VAR'
5425 include 'COMMON.GEO'
5426 include 'COMMON.LOCAL'
5427 include 'COMMON.TORSION'
5428 include 'COMMON.INTERACT'
5429 include 'COMMON.DERIV'
5430 include 'COMMON.CHAIN'
5431 include 'COMMON.NAMES'
5432 include 'COMMON.IOUNITS'
5433 include 'COMMON.FFIELD'
5434 include 'COMMON.TORCNSTR'
5436 C Set lprn=.true. for debugging
5440 do i=iphi_start,iphi_end-1
5442 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5443 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5444 & (itype(i+1).eq.ntyp1)) cycle
5445 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5447 itori=itortyp(itype(i-2))
5448 itori1=itortyp(itype(i-1))
5449 itori2=itortyp(itype(i))
5455 if (iabs(itype(i+1)).eq.20) iblock=2
5456 C Regular cosine and sine terms
5457 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5458 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5459 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5460 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5461 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5462 cosphi1=dcos(j*phii)
5463 sinphi1=dsin(j*phii)
5464 cosphi2=dcos(j*phii1)
5465 sinphi2=dsin(j*phii1)
5466 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5467 & v2cij*cosphi2+v2sij*sinphi2
5468 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5469 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5471 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5473 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5474 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5475 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5476 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5477 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5478 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5479 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5480 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5481 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5482 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5483 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5484 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5485 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5486 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5489 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5490 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5496 c------------------------------------------------------------------------------
5497 subroutine eback_sc_corr(esccor)
5498 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5499 c conformational states; temporarily implemented as differences
5500 c between UNRES torsional potentials (dependent on three types of
5501 c residues) and the torsional potentials dependent on all 20 types
5502 c of residues computed from AM1 energy surfaces of terminally-blocked
5503 c amino-acid residues.
5504 implicit real*8 (a-h,o-z)
5505 include 'DIMENSIONS'
5506 include 'sizesclu.dat'
5507 include 'COMMON.VAR'
5508 include 'COMMON.GEO'
5509 include 'COMMON.LOCAL'
5510 include 'COMMON.TORSION'
5511 include 'COMMON.SCCOR'
5512 include 'COMMON.INTERACT'
5513 include 'COMMON.DERIV'
5514 include 'COMMON.CHAIN'
5515 include 'COMMON.NAMES'
5516 include 'COMMON.IOUNITS'
5517 include 'COMMON.FFIELD'
5518 include 'COMMON.CONTROL'
5520 C Set lprn=.true. for debugging
5523 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5525 do i=itau_start,itau_end
5526 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5528 isccori=isccortyp(itype(i-2))
5529 isccori1=isccortyp(itype(i-1))
5531 do intertyp=1,3 !intertyp
5532 cc Added 09 May 2012 (Adasko)
5533 cc Intertyp means interaction type of backbone mainchain correlation:
5534 c 1 = SC...Ca...Ca...Ca
5535 c 2 = Ca...Ca...Ca...SC
5536 c 3 = SC...Ca...Ca...SCi
5538 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5539 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5540 & (itype(i-1).eq.ntyp1)))
5541 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5542 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5543 & .or.(itype(i).eq.ntyp1)))
5544 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5545 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5546 & (itype(i-3).eq.ntyp1)))) cycle
5547 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5548 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5550 do j=1,nterm_sccor(isccori,isccori1)
5551 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5552 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5553 cosphi=dcos(j*tauangle(intertyp,i))
5554 sinphi=dsin(j*tauangle(intertyp,i))
5555 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5556 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5558 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5559 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
5561 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5562 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5563 & (v1sccor(j,1,itori,itori1),j=1,6),
5564 & (v2sccor(j,1,itori,itori1),j=1,6)
5565 gsccor_loc(i-3)=gloci
5570 c------------------------------------------------------------------------------
5571 subroutine multibody(ecorr)
5572 C This subroutine calculates multi-body contributions to energy following
5573 C the idea of Skolnick et al. If side chains I and J make a contact and
5574 C at the same time side chains I+1 and J+1 make a contact, an extra
5575 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5576 implicit real*8 (a-h,o-z)
5577 include 'DIMENSIONS'
5578 include 'COMMON.IOUNITS'
5579 include 'COMMON.DERIV'
5580 include 'COMMON.INTERACT'
5581 include 'COMMON.CONTACTS'
5582 double precision gx(3),gx1(3)
5585 C Set lprn=.true. for debugging
5589 write (iout,'(a)') 'Contact function values:'
5591 write (iout,'(i2,20(1x,i2,f10.5))')
5592 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5607 num_conti=num_cont(i)
5608 num_conti1=num_cont(i1)
5613 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5614 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5615 cd & ' ishift=',ishift
5616 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5617 C The system gains extra energy.
5618 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5619 endif ! j1==j+-ishift
5628 c------------------------------------------------------------------------------
5629 double precision function esccorr(i,j,k,l,jj,kk)
5630 implicit real*8 (a-h,o-z)
5631 include 'DIMENSIONS'
5632 include 'COMMON.IOUNITS'
5633 include 'COMMON.DERIV'
5634 include 'COMMON.INTERACT'
5635 include 'COMMON.CONTACTS'
5636 double precision gx(3),gx1(3)
5641 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5642 C Calculate the multi-body contribution to energy.
5643 C Calculate multi-body contributions to the gradient.
5644 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5645 cd & k,l,(gacont(m,kk,k),m=1,3)
5647 gx(m) =ekl*gacont(m,jj,i)
5648 gx1(m)=eij*gacont(m,kk,k)
5649 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5650 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5651 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5652 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5656 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5661 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5667 c------------------------------------------------------------------------------
5669 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5670 implicit real*8 (a-h,o-z)
5671 include 'DIMENSIONS'
5672 integer dimen1,dimen2,atom,indx
5673 double precision buffer(dimen1,dimen2)
5674 double precision zapas
5675 common /contacts_hb/ zapas(3,20,maxres,7),
5676 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5677 & num_cont_hb(maxres),jcont_hb(20,maxres)
5678 num_kont=num_cont_hb(atom)
5682 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5685 buffer(i,indx+22)=facont_hb(i,atom)
5686 buffer(i,indx+23)=ees0p(i,atom)
5687 buffer(i,indx+24)=ees0m(i,atom)
5688 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5690 buffer(1,indx+26)=dfloat(num_kont)
5693 c------------------------------------------------------------------------------
5694 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5695 implicit real*8 (a-h,o-z)
5696 include 'DIMENSIONS'
5697 integer dimen1,dimen2,atom,indx
5698 double precision buffer(dimen1,dimen2)
5699 double precision zapas
5700 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5701 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5702 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5703 num_kont=buffer(1,indx+26)
5704 num_kont_old=num_cont_hb(atom)
5705 num_cont_hb(atom)=num_kont+num_kont_old
5710 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5713 facont_hb(ii,atom)=buffer(i,indx+22)
5714 ees0p(ii,atom)=buffer(i,indx+23)
5715 ees0m(ii,atom)=buffer(i,indx+24)
5716 jcont_hb(ii,atom)=buffer(i,indx+25)
5720 c------------------------------------------------------------------------------
5722 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5723 C This subroutine calculates multi-body contributions to hydrogen-bonding
5724 implicit real*8 (a-h,o-z)
5725 include 'DIMENSIONS'
5726 include 'sizesclu.dat'
5727 include 'COMMON.IOUNITS'
5729 include 'COMMON.INFO'
5731 include 'COMMON.FFIELD'
5732 include 'COMMON.DERIV'
5733 include 'COMMON.INTERACT'
5734 include 'COMMON.CONTACTS'
5736 parameter (max_cont=maxconts)
5737 parameter (max_dim=2*(8*3+2))
5738 parameter (msglen1=max_cont*max_dim*4)
5739 parameter (msglen2=2*msglen1)
5740 integer source,CorrelType,CorrelID,Error
5741 double precision buffer(max_cont,max_dim)
5743 double precision gx(3),gx1(3)
5746 C Set lprn=.true. for debugging
5751 if (fgProcs.le.1) goto 30
5753 write (iout,'(a)') 'Contact function values:'
5755 write (iout,'(2i3,50(1x,i2,f5.2))')
5756 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5757 & j=1,num_cont_hb(i))
5760 C Caution! Following code assumes that electrostatic interactions concerning
5761 C a given atom are split among at most two processors!
5771 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5774 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5775 if (MyRank.gt.0) then
5776 C Send correlation contributions to the preceding processor
5778 nn=num_cont_hb(iatel_s)
5779 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5780 cd write (iout,*) 'The BUFFER array:'
5782 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5784 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5786 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5787 C Clear the contacts of the atom passed to the neighboring processor
5788 nn=num_cont_hb(iatel_s+1)
5790 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5792 num_cont_hb(iatel_s)=0
5794 cd write (iout,*) 'Processor ',MyID,MyRank,
5795 cd & ' is sending correlation contribution to processor',MyID-1,
5796 cd & ' msglen=',msglen
5797 cd write (*,*) 'Processor ',MyID,MyRank,
5798 cd & ' is sending correlation contribution to processor',MyID-1,
5799 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5800 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5801 cd write (iout,*) 'Processor ',MyID,
5802 cd & ' has sent correlation contribution to processor',MyID-1,
5803 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5804 cd write (*,*) 'Processor ',MyID,
5805 cd & ' has sent correlation contribution to processor',MyID-1,
5806 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5808 endif ! (MyRank.gt.0)
5812 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5813 if (MyRank.lt.fgProcs-1) then
5814 C Receive correlation contributions from the next processor
5816 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5817 cd write (iout,*) 'Processor',MyID,
5818 cd & ' is receiving correlation contribution from processor',MyID+1,
5819 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5820 cd write (*,*) 'Processor',MyID,
5821 cd & ' is receiving correlation contribution from processor',MyID+1,
5822 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5824 do while (nbytes.le.0)
5825 call mp_probe(MyID+1,CorrelType,nbytes)
5827 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5828 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5829 cd write (iout,*) 'Processor',MyID,
5830 cd & ' has received correlation contribution from processor',MyID+1,
5831 cd & ' msglen=',msglen,' nbytes=',nbytes
5832 cd write (iout,*) 'The received BUFFER array:'
5834 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5836 if (msglen.eq.msglen1) then
5837 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5838 else if (msglen.eq.msglen2) then
5839 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5840 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5843 & 'ERROR!!!! message length changed while processing correlations.'
5845 & 'ERROR!!!! message length changed while processing correlations.'
5846 call mp_stopall(Error)
5847 endif ! msglen.eq.msglen1
5848 endif ! MyRank.lt.fgProcs-1
5855 write (iout,'(a)') 'Contact function values:'
5857 write (iout,'(2i3,50(1x,i2,f5.2))')
5858 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5859 & j=1,num_cont_hb(i))
5863 C Remove the loop below after debugging !!!
5870 C Calculate the local-electrostatic correlation terms
5871 do i=iatel_s,iatel_e+1
5873 num_conti=num_cont_hb(i)
5874 num_conti1=num_cont_hb(i+1)
5879 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5880 c & ' jj=',jj,' kk=',kk
5881 if (j1.eq.j+1 .or. j1.eq.j-1) then
5882 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5883 C The system gains extra energy.
5884 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5886 else if (j1.eq.j) then
5887 C Contacts I-J and I-(J+1) occur simultaneously.
5888 C The system loses extra energy.
5889 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5894 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5895 c & ' jj=',jj,' kk=',kk
5897 C Contacts I-J and (I+1)-J occur simultaneously.
5898 C The system loses extra energy.
5899 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5906 c------------------------------------------------------------------------------
5907 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5909 C This subroutine calculates multi-body contributions to hydrogen-bonding
5910 implicit real*8 (a-h,o-z)
5911 include 'DIMENSIONS'
5912 include 'sizesclu.dat'
5913 include 'COMMON.IOUNITS'
5915 include 'COMMON.INFO'
5917 include 'COMMON.FFIELD'
5918 include 'COMMON.DERIV'
5919 include 'COMMON.INTERACT'
5920 include 'COMMON.CONTACTS'
5922 parameter (max_cont=maxconts)
5923 parameter (max_dim=2*(8*3+2))
5924 parameter (msglen1=max_cont*max_dim*4)
5925 parameter (msglen2=2*msglen1)
5926 integer source,CorrelType,CorrelID,Error
5927 double precision buffer(max_cont,max_dim)
5929 double precision gx(3),gx1(3)
5932 C Set lprn=.true. for debugging
5938 if (fgProcs.le.1) goto 30
5940 write (iout,'(a)') 'Contact function values:'
5942 write (iout,'(2i3,50(1x,i2,f5.2))')
5943 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5944 & j=1,num_cont_hb(i))
5947 C Caution! Following code assumes that electrostatic interactions concerning
5948 C a given atom are split among at most two processors!
5958 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5961 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5962 if (MyRank.gt.0) then
5963 C Send correlation contributions to the preceding processor
5965 nn=num_cont_hb(iatel_s)
5966 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5967 cd write (iout,*) 'The BUFFER array:'
5969 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5971 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5973 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5974 C Clear the contacts of the atom passed to the neighboring processor
5975 nn=num_cont_hb(iatel_s+1)
5977 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5979 num_cont_hb(iatel_s)=0
5981 cd write (iout,*) 'Processor ',MyID,MyRank,
5982 cd & ' is sending correlation contribution to processor',MyID-1,
5983 cd & ' msglen=',msglen
5984 cd write (*,*) 'Processor ',MyID,MyRank,
5985 cd & ' is sending correlation contribution to processor',MyID-1,
5986 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5987 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5988 cd write (iout,*) 'Processor ',MyID,
5989 cd & ' has sent correlation contribution to processor',MyID-1,
5990 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5991 cd write (*,*) 'Processor ',MyID,
5992 cd & ' has sent correlation contribution to processor',MyID-1,
5993 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5995 endif ! (MyRank.gt.0)
5999 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6000 if (MyRank.lt.fgProcs-1) then
6001 C Receive correlation contributions from the next processor
6003 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6004 cd write (iout,*) 'Processor',MyID,
6005 cd & ' is receiving correlation contribution from processor',MyID+1,
6006 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6007 cd write (*,*) 'Processor',MyID,
6008 cd & ' is receiving correlation contribution from processor',MyID+1,
6009 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6011 do while (nbytes.le.0)
6012 call mp_probe(MyID+1,CorrelType,nbytes)
6014 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6015 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6016 cd write (iout,*) 'Processor',MyID,
6017 cd & ' has received correlation contribution from processor',MyID+1,
6018 cd & ' msglen=',msglen,' nbytes=',nbytes
6019 cd write (iout,*) 'The received BUFFER array:'
6021 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6023 if (msglen.eq.msglen1) then
6024 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6025 else if (msglen.eq.msglen2) then
6026 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6027 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6030 & 'ERROR!!!! message length changed while processing correlations.'
6032 & 'ERROR!!!! message length changed while processing correlations.'
6033 call mp_stopall(Error)
6034 endif ! msglen.eq.msglen1
6035 endif ! MyRank.lt.fgProcs-1
6042 write (iout,'(a)') 'Contact function values:'
6044 write (iout,'(2i3,50(1x,i2,f5.2))')
6045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6046 & j=1,num_cont_hb(i))
6052 C Remove the loop below after debugging !!!
6059 C Calculate the dipole-dipole interaction energies
6060 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6061 do i=iatel_s,iatel_e+1
6062 num_conti=num_cont_hb(i)
6069 C Calculate the local-electrostatic correlation terms
6070 do i=iatel_s,iatel_e+1
6072 num_conti=num_cont_hb(i)
6073 num_conti1=num_cont_hb(i+1)
6078 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6079 c & ' jj=',jj,' kk=',kk
6080 if (j1.eq.j+1 .or. j1.eq.j-1) then
6081 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6082 C The system gains extra energy.
6084 sqd1=dsqrt(d_cont(jj,i))
6085 sqd2=dsqrt(d_cont(kk,i1))
6086 sred_geom = sqd1*sqd2
6087 IF (sred_geom.lt.cutoff_corr) THEN
6088 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6090 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6091 c & ' jj=',jj,' kk=',kk
6092 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6093 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6095 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6096 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6099 cd write (iout,*) 'sred_geom=',sred_geom,
6100 cd & ' ekont=',ekont,' fprim=',fprimcont
6101 call calc_eello(i,j,i+1,j1,jj,kk)
6102 if (wcorr4.gt.0.0d0)
6103 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6104 if (wcorr5.gt.0.0d0)
6105 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6106 c print *,"wcorr5",ecorr5
6107 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6108 cd write(2,*)'ijkl',i,j,i+1,j1
6109 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6110 & .or. wturn6.eq.0.0d0))then
6111 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6112 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6113 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6114 cd & 'ecorr6=',ecorr6
6115 cd write (iout,'(4e15.5)') sred_geom,
6116 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6117 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6118 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6119 else if (wturn6.gt.0.0d0
6120 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6121 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6122 eturn6=eturn6+eello_turn6(i,jj,kk)
6123 cd write (2,*) 'multibody_eello:eturn6',eturn6
6127 else if (j1.eq.j) then
6128 C Contacts I-J and I-(J+1) occur simultaneously.
6129 C The system loses extra energy.
6130 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6135 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6136 c & ' jj=',jj,' kk=',kk
6138 C Contacts I-J and (I+1)-J occur simultaneously.
6139 C The system loses extra energy.
6140 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6147 c------------------------------------------------------------------------------
6148 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6149 implicit real*8 (a-h,o-z)
6150 include 'DIMENSIONS'
6151 include 'COMMON.IOUNITS'
6152 include 'COMMON.DERIV'
6153 include 'COMMON.INTERACT'
6154 include 'COMMON.CONTACTS'
6155 include 'COMMON.SHIELD'
6157 double precision gx(3),gx1(3)
6167 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6168 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6169 C Following 4 lines for diagnostics.
6174 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6176 c write (iout,*)'Contacts have occurred for peptide groups',
6177 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6178 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6179 C Calculate the multi-body contribution to energy.
6180 ecorr=ecorr+ekont*ees
6182 C Calculate multi-body contributions to the gradient.
6184 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6185 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6186 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6187 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6188 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6189 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6190 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6191 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6192 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6193 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6194 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6195 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6196 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6197 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6201 gradcorr(ll,m)=gradcorr(ll,m)+
6202 & ees*ekl*gacont_hbr(ll,jj,i)-
6203 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6204 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6209 gradcorr(ll,m)=gradcorr(ll,m)+
6210 & ees*eij*gacont_hbr(ll,kk,k)-
6211 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6212 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6215 if (shield_mode.gt.0) then
6218 C print *,i,j,fac_shield(i),fac_shield(j),
6219 C &fac_shield(k),fac_shield(l)
6220 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6221 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6222 do ilist=1,ishield_list(i)
6223 iresshield=shield_list(ilist,i)
6225 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6227 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6229 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6230 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6234 do ilist=1,ishield_list(j)
6235 iresshield=shield_list(ilist,j)
6237 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6239 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6241 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6242 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6246 do ilist=1,ishield_list(k)
6247 iresshield=shield_list(ilist,k)
6249 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6251 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6253 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6254 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6258 do ilist=1,ishield_list(l)
6259 iresshield=shield_list(ilist,l)
6261 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6263 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6265 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6266 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6270 C print *,gshieldx(m,iresshield)
6272 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6273 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6274 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6275 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6276 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6277 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6278 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6279 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6281 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6282 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6283 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6284 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6285 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6286 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6287 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6288 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6297 C---------------------------------------------------------------------------
6298 subroutine dipole(i,j,jj)
6299 implicit real*8 (a-h,o-z)
6300 include 'DIMENSIONS'
6301 include 'sizesclu.dat'
6302 include 'COMMON.IOUNITS'
6303 include 'COMMON.CHAIN'
6304 include 'COMMON.FFIELD'
6305 include 'COMMON.DERIV'
6306 include 'COMMON.INTERACT'
6307 include 'COMMON.CONTACTS'
6308 include 'COMMON.TORSION'
6309 include 'COMMON.VAR'
6310 include 'COMMON.GEO'
6311 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6313 iti1 = itortyp(itype(i+1))
6314 if (j.lt.nres-1) then
6315 if (itype(j).le.ntyp) then
6316 itj1 = itortyp(itype(j+1))
6324 dipi(iii,1)=Ub2(iii,i)
6325 dipderi(iii)=Ub2der(iii,i)
6326 dipi(iii,2)=b1(iii,iti1)
6327 dipj(iii,1)=Ub2(iii,j)
6328 dipderj(iii)=Ub2der(iii,j)
6329 dipj(iii,2)=b1(iii,itj1)
6333 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6336 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6339 if (.not.calc_grad) return
6344 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6348 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6353 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6354 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6356 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6358 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6360 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6364 C---------------------------------------------------------------------------
6365 subroutine calc_eello(i,j,k,l,jj,kk)
6367 C This subroutine computes matrices and vectors needed to calculate
6368 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6370 implicit real*8 (a-h,o-z)
6371 include 'DIMENSIONS'
6372 include 'sizesclu.dat'
6373 include 'COMMON.IOUNITS'
6374 include 'COMMON.CHAIN'
6375 include 'COMMON.DERIV'
6376 include 'COMMON.INTERACT'
6377 include 'COMMON.CONTACTS'
6378 include 'COMMON.TORSION'
6379 include 'COMMON.VAR'
6380 include 'COMMON.GEO'
6381 include 'COMMON.FFIELD'
6382 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6383 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6386 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6387 cd & ' jj=',jj,' kk=',kk
6388 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6391 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6392 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6395 call transpose2(aa1(1,1),aa1t(1,1))
6396 call transpose2(aa2(1,1),aa2t(1,1))
6399 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6400 & aa1tder(1,1,lll,kkk))
6401 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6402 & aa2tder(1,1,lll,kkk))
6406 C parallel orientation of the two CA-CA-CA frames.
6408 if (i.gt.1 .and. itype(i).le.ntyp) then
6409 iti=itortyp(itype(i))
6413 itk1=itortyp(itype(k+1))
6414 itj=itortyp(itype(j))
6415 c if (l.lt.nres-1) then
6416 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6417 itl1=itortyp(itype(l+1))
6421 C A1 kernel(j+1) A2T
6423 cd write (iout,'(3f10.5,5x,3f10.5)')
6424 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6426 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6427 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6428 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6429 C Following matrices are needed only for 6-th order cumulants
6430 IF (wcorr6.gt.0.0d0) THEN
6431 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6432 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6433 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6434 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6435 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6436 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6437 & ADtEAderx(1,1,1,1,1,1))
6439 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6440 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6441 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6442 & ADtEA1derx(1,1,1,1,1,1))
6444 C End 6-th order cumulants
6447 cd write (2,*) 'In calc_eello6'
6449 cd write (2,*) 'iii=',iii
6451 cd write (2,*) 'kkk=',kkk
6453 cd write (2,'(3(2f10.5),5x)')
6454 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6459 call transpose2(EUgder(1,1,k),auxmat(1,1))
6460 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6461 call transpose2(EUg(1,1,k),auxmat(1,1))
6462 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6463 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6467 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6468 & EAEAderx(1,1,lll,kkk,iii,1))
6472 C A1T kernel(i+1) A2
6473 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6474 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6475 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6476 C Following matrices are needed only for 6-th order cumulants
6477 IF (wcorr6.gt.0.0d0) THEN
6478 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6479 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6480 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6481 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6482 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6483 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6484 & ADtEAderx(1,1,1,1,1,2))
6485 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6486 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6487 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6488 & ADtEA1derx(1,1,1,1,1,2))
6490 C End 6-th order cumulants
6491 call transpose2(EUgder(1,1,l),auxmat(1,1))
6492 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6493 call transpose2(EUg(1,1,l),auxmat(1,1))
6494 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6495 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6499 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6500 & EAEAderx(1,1,lll,kkk,iii,2))
6505 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6506 C They are needed only when the fifth- or the sixth-order cumulants are
6508 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6509 call transpose2(AEA(1,1,1),auxmat(1,1))
6510 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6511 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6512 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6513 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6514 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6515 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6516 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6517 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6518 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6519 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6520 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6521 call transpose2(AEA(1,1,2),auxmat(1,1))
6522 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6523 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6524 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6525 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6526 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6527 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6528 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6529 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6530 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6531 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6532 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6533 C Calculate the Cartesian derivatives of the vectors.
6537 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6538 call matvec2(auxmat(1,1),b1(1,iti),
6539 & AEAb1derx(1,lll,kkk,iii,1,1))
6540 call matvec2(auxmat(1,1),Ub2(1,i),
6541 & AEAb2derx(1,lll,kkk,iii,1,1))
6542 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6543 & AEAb1derx(1,lll,kkk,iii,2,1))
6544 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6545 & AEAb2derx(1,lll,kkk,iii,2,1))
6546 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6547 call matvec2(auxmat(1,1),b1(1,itj),
6548 & AEAb1derx(1,lll,kkk,iii,1,2))
6549 call matvec2(auxmat(1,1),Ub2(1,j),
6550 & AEAb2derx(1,lll,kkk,iii,1,2))
6551 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6552 & AEAb1derx(1,lll,kkk,iii,2,2))
6553 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6554 & AEAb2derx(1,lll,kkk,iii,2,2))
6561 C Antiparallel orientation of the two CA-CA-CA frames.
6563 if (i.gt.1 .and. itype(i).le.ntyp) then
6564 iti=itortyp(itype(i))
6568 itk1=itortyp(itype(k+1))
6569 itl=itortyp(itype(l))
6570 itj=itortyp(itype(j))
6571 c if (j.lt.nres-1) then
6572 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6573 itj1=itortyp(itype(j+1))
6577 C A2 kernel(j-1)T A1T
6578 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6579 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6580 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6581 C Following matrices are needed only for 6-th order cumulants
6582 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6583 & j.eq.i+4 .and. l.eq.i+3)) THEN
6584 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6585 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6586 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6587 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6588 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6589 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6590 & ADtEAderx(1,1,1,1,1,1))
6591 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6592 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6593 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6594 & ADtEA1derx(1,1,1,1,1,1))
6596 C End 6-th order cumulants
6597 call transpose2(EUgder(1,1,k),auxmat(1,1))
6598 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6599 call transpose2(EUg(1,1,k),auxmat(1,1))
6600 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6601 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6605 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6606 & EAEAderx(1,1,lll,kkk,iii,1))
6610 C A2T kernel(i+1)T A1
6611 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6612 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6613 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6614 C Following matrices are needed only for 6-th order cumulants
6615 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6616 & j.eq.i+4 .and. l.eq.i+3)) THEN
6617 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6618 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6619 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6620 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6621 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6622 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6623 & ADtEAderx(1,1,1,1,1,2))
6624 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6625 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6626 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6627 & ADtEA1derx(1,1,1,1,1,2))
6629 C End 6-th order cumulants
6630 call transpose2(EUgder(1,1,j),auxmat(1,1))
6631 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6632 call transpose2(EUg(1,1,j),auxmat(1,1))
6633 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6634 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6638 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6639 & EAEAderx(1,1,lll,kkk,iii,2))
6644 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6645 C They are needed only when the fifth- or the sixth-order cumulants are
6647 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6648 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6649 call transpose2(AEA(1,1,1),auxmat(1,1))
6650 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6651 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6652 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6653 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6654 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6655 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6656 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6657 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6658 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6659 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6660 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6661 call transpose2(AEA(1,1,2),auxmat(1,1))
6662 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6663 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6664 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6665 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6666 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6667 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6668 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6669 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6670 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6671 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6672 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6673 C Calculate the Cartesian derivatives of the vectors.
6677 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6678 call matvec2(auxmat(1,1),b1(1,iti),
6679 & AEAb1derx(1,lll,kkk,iii,1,1))
6680 call matvec2(auxmat(1,1),Ub2(1,i),
6681 & AEAb2derx(1,lll,kkk,iii,1,1))
6682 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6683 & AEAb1derx(1,lll,kkk,iii,2,1))
6684 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6685 & AEAb2derx(1,lll,kkk,iii,2,1))
6686 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6687 call matvec2(auxmat(1,1),b1(1,itl),
6688 & AEAb1derx(1,lll,kkk,iii,1,2))
6689 call matvec2(auxmat(1,1),Ub2(1,l),
6690 & AEAb2derx(1,lll,kkk,iii,1,2))
6691 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6692 & AEAb1derx(1,lll,kkk,iii,2,2))
6693 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6694 & AEAb2derx(1,lll,kkk,iii,2,2))
6703 C---------------------------------------------------------------------------
6704 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6705 & KK,KKderg,AKA,AKAderg,AKAderx)
6709 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6710 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6711 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6716 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6718 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6721 cd if (lprn) write (2,*) 'In kernel'
6723 cd if (lprn) write (2,*) 'kkk=',kkk
6725 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6726 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6728 cd write (2,*) 'lll=',lll
6729 cd write (2,*) 'iii=1'
6731 cd write (2,'(3(2f10.5),5x)')
6732 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6735 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6736 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6738 cd write (2,*) 'lll=',lll
6739 cd write (2,*) 'iii=2'
6741 cd write (2,'(3(2f10.5),5x)')
6742 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6749 C---------------------------------------------------------------------------
6750 double precision function eello4(i,j,k,l,jj,kk)
6751 implicit real*8 (a-h,o-z)
6752 include 'DIMENSIONS'
6753 include 'sizesclu.dat'
6754 include 'COMMON.IOUNITS'
6755 include 'COMMON.CHAIN'
6756 include 'COMMON.DERIV'
6757 include 'COMMON.INTERACT'
6758 include 'COMMON.CONTACTS'
6759 include 'COMMON.TORSION'
6760 include 'COMMON.VAR'
6761 include 'COMMON.GEO'
6762 double precision pizda(2,2),ggg1(3),ggg2(3)
6763 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6767 cd print *,'eello4:',i,j,k,l,jj,kk
6768 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6769 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6770 cold eij=facont_hb(jj,i)
6771 cold ekl=facont_hb(kk,k)
6773 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6775 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6776 gcorr_loc(k-1)=gcorr_loc(k-1)
6777 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6779 gcorr_loc(l-1)=gcorr_loc(l-1)
6780 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6782 gcorr_loc(j-1)=gcorr_loc(j-1)
6783 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6788 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6789 & -EAEAderx(2,2,lll,kkk,iii,1)
6790 cd derx(lll,kkk,iii)=0.0d0
6794 cd gcorr_loc(l-1)=0.0d0
6795 cd gcorr_loc(j-1)=0.0d0
6796 cd gcorr_loc(k-1)=0.0d0
6798 cd write (iout,*)'Contacts have occurred for peptide groups',
6799 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6800 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6801 if (j.lt.nres-1) then
6808 if (l.lt.nres-1) then
6816 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6817 ggg1(ll)=eel4*g_contij(ll,1)
6818 ggg2(ll)=eel4*g_contij(ll,2)
6819 ghalf=0.5d0*ggg1(ll)
6821 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6822 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6823 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6824 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6825 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6826 ghalf=0.5d0*ggg2(ll)
6828 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6829 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6830 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6831 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6836 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6837 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6842 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6843 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6849 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6854 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6858 cd write (2,*) iii,gcorr_loc(iii)
6862 cd write (2,*) 'ekont',ekont
6863 cd write (iout,*) 'eello4',ekont*eel4
6866 C---------------------------------------------------------------------------
6867 double precision function eello5(i,j,k,l,jj,kk)
6868 implicit real*8 (a-h,o-z)
6869 include 'DIMENSIONS'
6870 include 'sizesclu.dat'
6871 include 'COMMON.IOUNITS'
6872 include 'COMMON.CHAIN'
6873 include 'COMMON.DERIV'
6874 include 'COMMON.INTERACT'
6875 include 'COMMON.CONTACTS'
6876 include 'COMMON.TORSION'
6877 include 'COMMON.VAR'
6878 include 'COMMON.GEO'
6879 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6880 double precision ggg1(3),ggg2(3)
6881 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6886 C /l\ / \ \ / \ / \ / C
6887 C / \ / \ \ / \ / \ / C
6888 C j| o |l1 | o | o| o | | o |o C
6889 C \ |/k\| |/ \| / |/ \| |/ \| C
6890 C \i/ \ / \ / / \ / \ C
6892 C (I) (II) (III) (IV) C
6894 C eello5_1 eello5_2 eello5_3 eello5_4 C
6896 C Antiparallel chains C
6899 C /j\ / \ \ / \ / \ / C
6900 C / \ / \ \ / \ / \ / C
6901 C j1| o |l | o | o| o | | o |o C
6902 C \ |/k\| |/ \| / |/ \| |/ \| C
6903 C \i/ \ / \ / / \ / \ C
6905 C (I) (II) (III) (IV) C
6907 C eello5_1 eello5_2 eello5_3 eello5_4 C
6909 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6911 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6912 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6917 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6919 itk=itortyp(itype(k))
6920 itl=itortyp(itype(l))
6921 itj=itortyp(itype(j))
6926 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6927 cd & eel5_3_num,eel5_4_num)
6931 derx(lll,kkk,iii)=0.0d0
6935 cd eij=facont_hb(jj,i)
6936 cd ekl=facont_hb(kk,k)
6938 cd write (iout,*)'Contacts have occurred for peptide groups',
6939 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6941 C Contribution from the graph I.
6942 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6943 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6944 call transpose2(EUg(1,1,k),auxmat(1,1))
6945 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6946 vv(1)=pizda(1,1)-pizda(2,2)
6947 vv(2)=pizda(1,2)+pizda(2,1)
6948 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6949 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6951 C Explicit gradient in virtual-dihedral angles.
6952 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6953 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6954 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6955 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6956 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6957 vv(1)=pizda(1,1)-pizda(2,2)
6958 vv(2)=pizda(1,2)+pizda(2,1)
6959 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6960 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6961 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6962 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6963 vv(1)=pizda(1,1)-pizda(2,2)
6964 vv(2)=pizda(1,2)+pizda(2,1)
6966 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6967 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6968 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6970 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6971 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6972 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6974 C Cartesian gradient
6978 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6980 vv(1)=pizda(1,1)-pizda(2,2)
6981 vv(2)=pizda(1,2)+pizda(2,1)
6982 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6983 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6984 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6991 C Contribution from graph II
6992 call transpose2(EE(1,1,itk),auxmat(1,1))
6993 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6994 vv(1)=pizda(1,1)+pizda(2,2)
6995 vv(2)=pizda(2,1)-pizda(1,2)
6996 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6997 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6999 C Explicit gradient in virtual-dihedral angles.
7000 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7001 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7002 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7003 vv(1)=pizda(1,1)+pizda(2,2)
7004 vv(2)=pizda(2,1)-pizda(1,2)
7006 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7007 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7008 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7010 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7011 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7012 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7014 C Cartesian gradient
7018 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7020 vv(1)=pizda(1,1)+pizda(2,2)
7021 vv(2)=pizda(2,1)-pizda(1,2)
7022 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7023 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7024 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7033 C Parallel orientation
7034 C Contribution from graph III
7035 call transpose2(EUg(1,1,l),auxmat(1,1))
7036 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7037 vv(1)=pizda(1,1)-pizda(2,2)
7038 vv(2)=pizda(1,2)+pizda(2,1)
7039 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7040 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7042 C Explicit gradient in virtual-dihedral angles.
7043 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7044 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7045 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7046 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7047 vv(1)=pizda(1,1)-pizda(2,2)
7048 vv(2)=pizda(1,2)+pizda(2,1)
7049 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7050 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7051 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7052 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7053 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7054 vv(1)=pizda(1,1)-pizda(2,2)
7055 vv(2)=pizda(1,2)+pizda(2,1)
7056 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7057 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7058 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7059 C Cartesian gradient
7063 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7065 vv(1)=pizda(1,1)-pizda(2,2)
7066 vv(2)=pizda(1,2)+pizda(2,1)
7067 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7068 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7069 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7075 C Contribution from graph IV
7077 call transpose2(EE(1,1,itl),auxmat(1,1))
7078 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7079 vv(1)=pizda(1,1)+pizda(2,2)
7080 vv(2)=pizda(2,1)-pizda(1,2)
7081 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7082 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7084 C Explicit gradient in virtual-dihedral angles.
7085 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7086 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7087 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7088 vv(1)=pizda(1,1)+pizda(2,2)
7089 vv(2)=pizda(2,1)-pizda(1,2)
7090 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7091 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7092 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7093 C Cartesian gradient
7097 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7099 vv(1)=pizda(1,1)+pizda(2,2)
7100 vv(2)=pizda(2,1)-pizda(1,2)
7101 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7102 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7103 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7109 C Antiparallel orientation
7110 C Contribution from graph III
7112 call transpose2(EUg(1,1,j),auxmat(1,1))
7113 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7114 vv(1)=pizda(1,1)-pizda(2,2)
7115 vv(2)=pizda(1,2)+pizda(2,1)
7116 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7117 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7119 C Explicit gradient in virtual-dihedral angles.
7120 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7121 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7122 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7123 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7124 vv(1)=pizda(1,1)-pizda(2,2)
7125 vv(2)=pizda(1,2)+pizda(2,1)
7126 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7127 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7128 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7129 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7130 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7131 vv(1)=pizda(1,1)-pizda(2,2)
7132 vv(2)=pizda(1,2)+pizda(2,1)
7133 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7134 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7135 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7136 C Cartesian gradient
7140 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7142 vv(1)=pizda(1,1)-pizda(2,2)
7143 vv(2)=pizda(1,2)+pizda(2,1)
7144 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7145 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7146 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7152 C Contribution from graph IV
7154 call transpose2(EE(1,1,itj),auxmat(1,1))
7155 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7156 vv(1)=pizda(1,1)+pizda(2,2)
7157 vv(2)=pizda(2,1)-pizda(1,2)
7158 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7159 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7161 C Explicit gradient in virtual-dihedral angles.
7162 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7163 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7164 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7165 vv(1)=pizda(1,1)+pizda(2,2)
7166 vv(2)=pizda(2,1)-pizda(1,2)
7167 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7168 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7169 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7170 C Cartesian gradient
7174 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7176 vv(1)=pizda(1,1)+pizda(2,2)
7177 vv(2)=pizda(2,1)-pizda(1,2)
7178 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7179 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7180 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7187 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7188 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7189 cd write (2,*) 'ijkl',i,j,k,l
7190 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7191 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7193 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7194 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7195 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7196 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7198 if (j.lt.nres-1) then
7205 if (l.lt.nres-1) then
7215 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7217 ggg1(ll)=eel5*g_contij(ll,1)
7218 ggg2(ll)=eel5*g_contij(ll,2)
7219 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7220 ghalf=0.5d0*ggg1(ll)
7222 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7223 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7224 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7225 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7226 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7227 ghalf=0.5d0*ggg2(ll)
7229 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7230 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7231 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7232 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7237 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7238 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7243 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7244 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7250 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7255 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7259 cd write (2,*) iii,g_corr5_loc(iii)
7263 cd write (2,*) 'ekont',ekont
7264 cd write (iout,*) 'eello5',ekont*eel5
7267 c--------------------------------------------------------------------------
7268 double precision function eello6(i,j,k,l,jj,kk)
7269 implicit real*8 (a-h,o-z)
7270 include 'DIMENSIONS'
7271 include 'sizesclu.dat'
7272 include 'COMMON.IOUNITS'
7273 include 'COMMON.CHAIN'
7274 include 'COMMON.DERIV'
7275 include 'COMMON.INTERACT'
7276 include 'COMMON.CONTACTS'
7277 include 'COMMON.TORSION'
7278 include 'COMMON.VAR'
7279 include 'COMMON.GEO'
7280 include 'COMMON.FFIELD'
7281 double precision ggg1(3),ggg2(3)
7282 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7287 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7295 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7296 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7300 derx(lll,kkk,iii)=0.0d0
7304 cd eij=facont_hb(jj,i)
7305 cd ekl=facont_hb(kk,k)
7311 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7312 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7313 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7314 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7315 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7316 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7318 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7319 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7320 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7321 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7322 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7323 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7327 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7329 C If turn contributions are considered, they will be handled separately.
7330 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7331 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7332 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7333 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7334 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7335 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7336 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7339 if (j.lt.nres-1) then
7346 if (l.lt.nres-1) then
7354 ggg1(ll)=eel6*g_contij(ll,1)
7355 ggg2(ll)=eel6*g_contij(ll,2)
7356 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7357 ghalf=0.5d0*ggg1(ll)
7359 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7360 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7361 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7362 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7363 ghalf=0.5d0*ggg2(ll)
7364 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7366 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7367 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7368 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7369 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7374 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7375 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7380 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7381 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7387 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7392 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7396 cd write (2,*) iii,g_corr6_loc(iii)
7400 cd write (2,*) 'ekont',ekont
7401 cd write (iout,*) 'eello6',ekont*eel6
7404 c--------------------------------------------------------------------------
7405 double precision function eello6_graph1(i,j,k,l,imat,swap)
7406 implicit real*8 (a-h,o-z)
7407 include 'DIMENSIONS'
7408 include 'sizesclu.dat'
7409 include 'COMMON.IOUNITS'
7410 include 'COMMON.CHAIN'
7411 include 'COMMON.DERIV'
7412 include 'COMMON.INTERACT'
7413 include 'COMMON.CONTACTS'
7414 include 'COMMON.TORSION'
7415 include 'COMMON.VAR'
7416 include 'COMMON.GEO'
7417 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7421 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7423 C Parallel Antiparallel C
7429 C \ j|/k\| / \ |/k\|l / C
7434 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7435 itk=itortyp(itype(k))
7436 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7437 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7438 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7439 call transpose2(EUgC(1,1,k),auxmat(1,1))
7440 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7441 vv1(1)=pizda1(1,1)-pizda1(2,2)
7442 vv1(2)=pizda1(1,2)+pizda1(2,1)
7443 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7444 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7445 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7446 s5=scalar2(vv(1),Dtobr2(1,i))
7447 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7448 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7449 if (.not. calc_grad) return
7450 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7451 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7452 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7453 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7454 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7455 & +scalar2(vv(1),Dtobr2der(1,i)))
7456 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7457 vv1(1)=pizda1(1,1)-pizda1(2,2)
7458 vv1(2)=pizda1(1,2)+pizda1(2,1)
7459 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7460 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7462 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7463 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7464 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7465 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7466 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7468 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7469 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7470 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7471 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7472 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7474 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7475 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7476 vv1(1)=pizda1(1,1)-pizda1(2,2)
7477 vv1(2)=pizda1(1,2)+pizda1(2,1)
7478 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7479 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7480 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7481 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7490 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7491 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7492 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7493 call transpose2(EUgC(1,1,k),auxmat(1,1))
7494 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7496 vv1(1)=pizda1(1,1)-pizda1(2,2)
7497 vv1(2)=pizda1(1,2)+pizda1(2,1)
7498 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7499 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7500 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7501 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7502 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7503 s5=scalar2(vv(1),Dtobr2(1,i))
7504 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7510 c----------------------------------------------------------------------------
7511 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7512 implicit real*8 (a-h,o-z)
7513 include 'DIMENSIONS'
7514 include 'sizesclu.dat'
7515 include 'COMMON.IOUNITS'
7516 include 'COMMON.CHAIN'
7517 include 'COMMON.DERIV'
7518 include 'COMMON.INTERACT'
7519 include 'COMMON.CONTACTS'
7520 include 'COMMON.TORSION'
7521 include 'COMMON.VAR'
7522 include 'COMMON.GEO'
7524 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7525 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7528 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7530 C Parallel Antiparallel C
7536 C \ j|/k\| \ |/k\|l C
7541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7542 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7543 C AL 7/4/01 s1 would occur in the sixth-order moment,
7544 C but not in a cluster cumulant
7546 s1=dip(1,jj,i)*dip(1,kk,k)
7548 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7549 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7550 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7551 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7552 call transpose2(EUg(1,1,k),auxmat(1,1))
7553 call matmat2(ADtEA1(1,1,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))
7557 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7559 eello6_graph2=-(s1+s2+s3+s4)
7561 eello6_graph2=-(s2+s3+s4)
7564 if (.not. calc_grad) return
7565 C Derivatives in gamma(i-1)
7568 s1=dipderg(1,jj,i)*dip(1,kk,k)
7570 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7571 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7572 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7573 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7575 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7577 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7579 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7581 C Derivatives in gamma(k-1)
7583 s1=dip(1,jj,i)*dipderg(1,kk,k)
7585 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7586 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7587 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7588 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7589 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7590 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7591 vv(1)=pizda(1,1)-pizda(2,2)
7592 vv(2)=pizda(1,2)+pizda(2,1)
7593 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7595 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7597 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7599 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7600 C Derivatives in gamma(j-1) or gamma(l-1)
7603 s1=dipderg(3,jj,i)*dip(1,kk,k)
7605 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7606 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7607 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7608 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7609 vv(1)=pizda(1,1)-pizda(2,2)
7610 vv(2)=pizda(1,2)+pizda(2,1)
7611 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7614 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7616 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7619 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7620 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7622 C Derivatives in gamma(l-1) or gamma(j-1)
7625 s1=dip(1,jj,i)*dipderg(3,kk,k)
7627 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7628 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7629 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7630 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7631 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7637 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7639 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7642 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7643 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7645 C Cartesian derivatives.
7647 write (2,*) 'In eello6_graph2'
7649 write (2,*) 'iii=',iii
7651 write (2,*) 'kkk=',kkk
7653 write (2,'(3(2f10.5),5x)')
7654 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7664 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7666 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7669 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7671 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7672 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7674 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7675 call transpose2(EUg(1,1,k),auxmat(1,1))
7676 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7678 vv(1)=pizda(1,1)-pizda(2,2)
7679 vv(2)=pizda(1,2)+pizda(2,1)
7680 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7681 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7683 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7685 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7688 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7697 c----------------------------------------------------------------------------
7698 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7699 implicit real*8 (a-h,o-z)
7700 include 'DIMENSIONS'
7701 include 'sizesclu.dat'
7702 include 'COMMON.IOUNITS'
7703 include 'COMMON.CHAIN'
7704 include 'COMMON.DERIV'
7705 include 'COMMON.INTERACT'
7706 include 'COMMON.CONTACTS'
7707 include 'COMMON.TORSION'
7708 include 'COMMON.VAR'
7709 include 'COMMON.GEO'
7710 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7712 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7714 C Parallel Antiparallel C
7720 C j|/k\| / |/k\|l / C
7725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7727 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7728 C energy moment and not to the cluster cumulant.
7729 iti=itortyp(itype(i))
7730 c if (j.lt.nres-1) then
7731 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7732 itj1=itortyp(itype(j+1))
7736 itk=itortyp(itype(k))
7737 itk1=itortyp(itype(k+1))
7738 c if (l.lt.nres-1) then
7739 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7740 itl1=itortyp(itype(l+1))
7745 s1=dip(4,jj,i)*dip(4,kk,k)
7747 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7748 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7749 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7750 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7751 call transpose2(EE(1,1,itk),auxmat(1,1))
7752 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7753 vv(1)=pizda(1,1)+pizda(2,2)
7754 vv(2)=pizda(2,1)-pizda(1,2)
7755 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7756 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7758 eello6_graph3=-(s1+s2+s3+s4)
7760 eello6_graph3=-(s2+s3+s4)
7763 if (.not. calc_grad) return
7764 C Derivatives in gamma(k-1)
7765 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7766 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7767 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7768 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7769 C Derivatives in gamma(l-1)
7770 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7771 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7772 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7775 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7776 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7777 C Cartesian derivatives.
7783 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7785 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7788 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7790 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7791 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7793 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7794 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7796 vv(1)=pizda(1,1)+pizda(2,2)
7797 vv(2)=pizda(2,1)-pizda(1,2)
7798 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7800 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7802 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7805 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7807 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7809 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7815 c----------------------------------------------------------------------------
7816 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7817 implicit real*8 (a-h,o-z)
7818 include 'DIMENSIONS'
7819 include 'sizesclu.dat'
7820 include 'COMMON.IOUNITS'
7821 include 'COMMON.CHAIN'
7822 include 'COMMON.DERIV'
7823 include 'COMMON.INTERACT'
7824 include 'COMMON.CONTACTS'
7825 include 'COMMON.TORSION'
7826 include 'COMMON.VAR'
7827 include 'COMMON.GEO'
7828 include 'COMMON.FFIELD'
7829 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7830 & auxvec1(2),auxmat1(2,2)
7832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7834 C Parallel Antiparallel C
7840 C \ j|/k\| \ |/k\|l C
7845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7847 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7848 C energy moment and not to the cluster cumulant.
7849 cd write (2,*) 'eello_graph4: wturn6',wturn6
7850 iti=itortyp(itype(i))
7851 itj=itortyp(itype(j))
7852 c if (j.lt.nres-1) then
7853 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7854 itj1=itortyp(itype(j+1))
7858 itk=itortyp(itype(k))
7859 c if (k.lt.nres-1) then
7860 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7861 itk1=itortyp(itype(k+1))
7865 itl=itortyp(itype(l))
7866 if (l.lt.nres-1) then
7867 itl1=itortyp(itype(l+1))
7871 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7872 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7873 cd & ' itl',itl,' itl1',itl1
7876 s1=dip(3,jj,i)*dip(3,kk,k)
7878 s1=dip(2,jj,j)*dip(2,kk,l)
7881 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7882 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7884 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7885 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7887 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7888 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7890 call transpose2(EUg(1,1,k),auxmat(1,1))
7891 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7892 vv(1)=pizda(1,1)-pizda(2,2)
7893 vv(2)=pizda(2,1)+pizda(1,2)
7894 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7895 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7897 eello6_graph4=-(s1+s2+s3+s4)
7899 eello6_graph4=-(s2+s3+s4)
7901 if (.not. calc_grad) return
7902 C Derivatives in gamma(i-1)
7906 s1=dipderg(2,jj,i)*dip(3,kk,k)
7908 s1=dipderg(4,jj,j)*dip(2,kk,l)
7911 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7913 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7914 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7916 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7917 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7919 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7920 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7921 cd write (2,*) 'turn6 derivatives'
7923 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7925 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7929 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7931 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7935 C Derivatives in gamma(k-1)
7938 s1=dip(3,jj,i)*dipderg(2,kk,k)
7940 s1=dip(2,jj,j)*dipderg(4,kk,l)
7943 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7944 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7946 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7947 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7949 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7950 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7952 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7953 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7954 vv(1)=pizda(1,1)-pizda(2,2)
7955 vv(2)=pizda(2,1)+pizda(1,2)
7956 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7957 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7959 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7961 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7965 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7967 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7970 C Derivatives in gamma(j-1) or gamma(l-1)
7971 if (l.eq.j+1 .and. l.gt.1) then
7972 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7973 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7974 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7975 vv(1)=pizda(1,1)-pizda(2,2)
7976 vv(2)=pizda(2,1)+pizda(1,2)
7977 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7978 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7979 else if (j.gt.1) then
7980 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7981 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7982 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7983 vv(1)=pizda(1,1)-pizda(2,2)
7984 vv(2)=pizda(2,1)+pizda(1,2)
7985 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7986 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7987 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7989 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7992 C Cartesian derivatives.
7999 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8001 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8005 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8007 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8011 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8013 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8015 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8016 & b1(1,itj1),auxvec(1))
8017 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8019 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8020 & b1(1,itl1),auxvec(1))
8021 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8023 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8025 vv(1)=pizda(1,1)-pizda(2,2)
8026 vv(2)=pizda(2,1)+pizda(1,2)
8027 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8029 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8031 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8034 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8037 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8040 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8042 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8044 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8048 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8050 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8053 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8055 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8063 c----------------------------------------------------------------------------
8064 double precision function eello_turn6(i,jj,kk)
8065 implicit real*8 (a-h,o-z)
8066 include 'DIMENSIONS'
8067 include 'sizesclu.dat'
8068 include 'COMMON.IOUNITS'
8069 include 'COMMON.CHAIN'
8070 include 'COMMON.DERIV'
8071 include 'COMMON.INTERACT'
8072 include 'COMMON.CONTACTS'
8073 include 'COMMON.TORSION'
8074 include 'COMMON.VAR'
8075 include 'COMMON.GEO'
8076 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8077 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8079 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8080 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8081 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8082 C the respective energy moment and not to the cluster cumulant.
8087 iti=itortyp(itype(i))
8088 itk=itortyp(itype(k))
8089 itk1=itortyp(itype(k+1))
8090 itl=itortyp(itype(l))
8091 itj=itortyp(itype(j))
8092 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8093 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8094 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8099 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8101 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8105 derx_turn(lll,kkk,iii)=0.0d0
8112 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8114 cd write (2,*) 'eello6_5',eello6_5
8116 call transpose2(AEA(1,1,1),auxmat(1,1))
8117 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8118 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8119 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8123 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8124 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8125 s2 = scalar2(b1(1,itk),vtemp1(1))
8127 call transpose2(AEA(1,1,2),atemp(1,1))
8128 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8129 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8130 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8134 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8135 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8136 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8138 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8139 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8140 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8141 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8142 ss13 = scalar2(b1(1,itk),vtemp4(1))
8143 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8147 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8153 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8155 C Derivatives in gamma(i+2)
8157 call transpose2(AEA(1,1,1),auxmatd(1,1))
8158 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8159 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8160 call transpose2(AEAderg(1,1,2),atempd(1,1))
8161 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8162 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8166 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8167 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8168 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8174 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8175 C Derivatives in gamma(i+3)
8177 call transpose2(AEA(1,1,1),auxmatd(1,1))
8178 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8179 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8180 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8184 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8185 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8186 s2d = scalar2(b1(1,itk),vtemp1d(1))
8188 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8189 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8191 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8193 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8194 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8195 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8205 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8206 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8208 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8209 & -0.5d0*ekont*(s2d+s12d)
8211 C Derivatives in gamma(i+4)
8212 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8213 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8214 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8216 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8217 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8218 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8228 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8230 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8232 C Derivatives in gamma(i+5)
8234 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8235 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8236 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8240 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8241 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8242 s2d = scalar2(b1(1,itk),vtemp1d(1))
8244 call transpose2(AEA(1,1,2),atempd(1,1))
8245 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8246 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8250 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8251 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8253 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8254 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8255 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8265 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8266 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8268 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8269 & -0.5d0*ekont*(s2d+s12d)
8271 C Cartesian derivatives
8276 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8277 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8278 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8282 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8283 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8285 s2d = scalar2(b1(1,itk),vtemp1d(1))
8287 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8288 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8289 s8d = -(atempd(1,1)+atempd(2,2))*
8290 & scalar2(cc(1,1,itl),vtemp2(1))
8294 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8296 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8297 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8304 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8307 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8311 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8312 & - 0.5d0*(s8d+s12d)
8314 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8323 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8325 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8326 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8327 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8328 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8329 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8331 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8332 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8333 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8337 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8338 cd & 16*eel_turn6_num
8340 if (j.lt.nres-1) then
8347 if (l.lt.nres-1) then
8355 ggg1(ll)=eel_turn6*g_contij(ll,1)
8356 ggg2(ll)=eel_turn6*g_contij(ll,2)
8357 ghalf=0.5d0*ggg1(ll)
8359 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8360 & +ekont*derx_turn(ll,2,1)
8361 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8362 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8363 & +ekont*derx_turn(ll,4,1)
8364 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8365 ghalf=0.5d0*ggg2(ll)
8367 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8368 & +ekont*derx_turn(ll,2,2)
8369 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8370 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8371 & +ekont*derx_turn(ll,4,2)
8372 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8377 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8382 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8388 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8393 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8397 cd write (2,*) iii,g_corr6_loc(iii)
8400 eello_turn6=ekont*eel_turn6
8401 cd write (2,*) 'ekont',ekont
8402 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8405 crc-------------------------------------------------
8406 SUBROUTINE MATVEC2(A1,V1,V2)
8407 implicit real*8 (a-h,o-z)
8408 include 'DIMENSIONS'
8409 DIMENSION A1(2,2),V1(2),V2(2)
8413 c 3 VI=VI+A1(I,K)*V1(K)
8417 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8418 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8423 C---------------------------------------
8424 SUBROUTINE MATMAT2(A1,A2,A3)
8425 implicit real*8 (a-h,o-z)
8426 include 'DIMENSIONS'
8427 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8428 c DIMENSION AI3(2,2)
8432 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8438 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8439 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8440 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8441 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8449 c-------------------------------------------------------------------------
8450 double precision function scalar2(u,v)
8452 double precision u(2),v(2)
8455 scalar2=u(1)*v(1)+u(2)*v(2)
8459 C-----------------------------------------------------------------------------
8461 subroutine transpose2(a,at)
8463 double precision a(2,2),at(2,2)
8470 c--------------------------------------------------------------------------
8471 subroutine transpose(n,a,at)
8474 double precision a(n,n),at(n,n)
8482 C---------------------------------------------------------------------------
8483 subroutine prodmat3(a1,a2,kk,transp,prod)
8486 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8488 crc double precision auxmat(2,2),prod_(2,2)
8491 crc call transpose2(kk(1,1),auxmat(1,1))
8492 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8493 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8495 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8496 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8497 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8498 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8499 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8500 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8501 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8502 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8505 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8506 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8508 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8509 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8510 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8511 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8512 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8513 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8514 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8515 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8518 c call transpose2(a2(1,1),a2t(1,1))
8521 crc print *,((prod_(i,j),i=1,2),j=1,2)
8522 crc print *,((prod(i,j),i=1,2),j=1,2)
8526 C-----------------------------------------------------------------------------
8527 double precision function scalar(u,v)
8529 double precision u(3),v(3)
8539 C-----------------------------------------------------------------------
8540 double precision function sscale(r)
8541 double precision r,gamm
8542 include "COMMON.SPLITELE"
8543 if(r.lt.r_cut-rlamb) then
8545 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8546 gamm=(r-(r_cut-rlamb))/rlamb
8547 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8553 C-----------------------------------------------------------------------
8554 C-----------------------------------------------------------------------
8555 double precision function sscagrad(r)
8556 double precision r,gamm
8557 include "COMMON.SPLITELE"
8558 if(r.lt.r_cut-rlamb) then
8560 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8561 gamm=(r-(r_cut-rlamb))/rlamb
8562 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8568 C-----------------------------------------------------------------------
8569 C first for shielding is setting of function of side-chains
8570 subroutine set_shield_fac2
8571 implicit real*8 (a-h,o-z)
8572 include 'DIMENSIONS'
8573 include 'COMMON.CHAIN'
8574 include 'COMMON.DERIV'
8575 include 'COMMON.IOUNITS'
8576 include 'COMMON.SHIELD'
8577 include 'COMMON.INTERACT'
8578 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8579 double precision div77_81/0.974996043d0/,
8580 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8582 C the vector between center of side_chain and peptide group
8583 double precision pep_side(3),long,side_calf(3),
8584 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8585 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8586 C the line belowe needs to be changed for FGPROC>1
8588 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8590 Cif there two consequtive dummy atoms there is no peptide group between them
8591 C the line below has to be changed for FGPROC>1
8594 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8598 C first lets set vector conecting the ithe side-chain with kth side-chain
8599 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8601 C and vector conecting the side-chain with its proper calfa
8602 side_calf(j)=c(j,k+nres)-c(j,k)
8603 C side_calf(j)=2.0d0
8604 pept_group(j)=c(j,i)-c(j,i+1)
8605 C lets have their lenght
8606 dist_pep_side=pep_side(j)**2+dist_pep_side
8607 dist_side_calf=dist_side_calf+side_calf(j)**2
8608 dist_pept_group=dist_pept_group+pept_group(j)**2
8610 dist_pep_side=dsqrt(dist_pep_side)
8611 dist_pept_group=dsqrt(dist_pept_group)
8612 dist_side_calf=dsqrt(dist_side_calf)
8614 pep_side_norm(j)=pep_side(j)/dist_pep_side
8615 side_calf_norm(j)=dist_side_calf
8617 C now sscale fraction
8618 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8619 C print *,buff_shield,"buff"
8621 if (sh_frac_dist.le.0.0) cycle
8622 C If we reach here it means that this side chain reaches the shielding sphere
8623 C Lets add him to the list for gradient
8624 ishield_list(i)=ishield_list(i)+1
8625 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8626 C this list is essential otherwise problem would be O3
8627 shield_list(ishield_list(i),i)=k
8628 C Lets have the sscale value
8629 if (sh_frac_dist.gt.1.0) then
8630 scale_fac_dist=1.0d0
8632 sh_frac_dist_grad(j)=0.0d0
8635 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8636 & *(2.0d0*sh_frac_dist-3.0d0)
8637 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8638 & /dist_pep_side/buff_shield*0.5d0
8639 C remember for the final gradient multiply sh_frac_dist_grad(j)
8640 C for side_chain by factor -2 !
8642 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8643 C sh_frac_dist_grad(j)=0.0d0
8644 C scale_fac_dist=1.0d0
8645 C print *,"jestem",scale_fac_dist,fac_help_scale,
8646 C & sh_frac_dist_grad(j)
8649 C this is what is now we have the distance scaling now volume...
8650 short=short_r_sidechain(itype(k))
8651 long=long_r_sidechain(itype(k))
8652 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8653 sinthet=short/dist_pep_side*costhet
8657 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8658 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8659 C & -short/dist_pep_side**2/costhet)
8662 costhet_grad(j)=costhet_fac*pep_side(j)
8664 C remember for the final gradient multiply costhet_grad(j)
8665 C for side_chain by factor -2 !
8666 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8667 C pep_side0pept_group is vector multiplication
8668 pep_side0pept_group=0.0d0
8670 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8672 cosalfa=(pep_side0pept_group/
8673 & (dist_pep_side*dist_side_calf))
8674 fac_alfa_sin=1.0d0-cosalfa**2
8675 fac_alfa_sin=dsqrt(fac_alfa_sin)
8676 rkprim=fac_alfa_sin*(long-short)+short
8680 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8682 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8683 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8687 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8688 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8689 &*(long-short)/fac_alfa_sin*cosalfa/
8690 &((dist_pep_side*dist_side_calf))*
8691 &((side_calf(j))-cosalfa*
8692 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8693 C cosphi_grad_long(j)=0.0d0
8694 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8695 &*(long-short)/fac_alfa_sin*cosalfa
8696 &/((dist_pep_side*dist_side_calf))*
8698 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8699 C cosphi_grad_loc(j)=0.0d0
8701 C print *,sinphi,sinthet
8702 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8705 C now the gradient...
8707 grad_shield(j,i)=grad_shield(j,i)
8708 C gradient po skalowaniu
8709 & +(sh_frac_dist_grad(j)*VofOverlap
8710 C gradient po costhet
8711 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8712 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8713 & sinphi/sinthet*costhet*costhet_grad(j)
8714 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8716 C grad_shield_side is Cbeta sidechain gradient
8717 grad_shield_side(j,ishield_list(i),i)=
8718 & (sh_frac_dist_grad(j)*-2.0d0
8720 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8721 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8722 & sinphi/sinthet*costhet*costhet_grad(j)
8723 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8726 grad_shield_loc(j,ishield_list(i),i)=
8727 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8728 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8729 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8733 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8735 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8736 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8740 C first for shielding is setting of function of side-chains
8741 subroutine set_shield_fac
8742 implicit real*8 (a-h,o-z)
8743 include 'DIMENSIONS'
8744 include 'COMMON.CHAIN'
8745 include 'COMMON.DERIV'
8746 include 'COMMON.IOUNITS'
8747 include 'COMMON.SHIELD'
8748 include 'COMMON.INTERACT'
8749 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8750 double precision div77_81/0.974996043d0/,
8751 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8753 C the vector between center of side_chain and peptide group
8754 double precision pep_side(3),long,side_calf(3),
8755 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8756 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8757 C the line belowe needs to be changed for FGPROC>1
8759 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8761 Cif there two consequtive dummy atoms there is no peptide group between them
8762 C the line below has to be changed for FGPROC>1
8765 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8769 C first lets set vector conecting the ithe side-chain with kth side-chain
8770 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8772 C and vector conecting the side-chain with its proper calfa
8773 side_calf(j)=c(j,k+nres)-c(j,k)
8774 C side_calf(j)=2.0d0
8775 pept_group(j)=c(j,i)-c(j,i+1)
8776 C lets have their lenght
8777 dist_pep_side=pep_side(j)**2+dist_pep_side
8778 dist_side_calf=dist_side_calf+side_calf(j)**2
8779 dist_pept_group=dist_pept_group+pept_group(j)**2
8781 dist_pep_side=dsqrt(dist_pep_side)
8782 dist_pept_group=dsqrt(dist_pept_group)
8783 dist_side_calf=dsqrt(dist_side_calf)
8785 pep_side_norm(j)=pep_side(j)/dist_pep_side
8786 side_calf_norm(j)=dist_side_calf
8788 C now sscale fraction
8789 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8790 C print *,buff_shield,"buff"
8792 if (sh_frac_dist.le.0.0) cycle
8793 C If we reach here it means that this side chain reaches the shielding sphere
8794 C Lets add him to the list for gradient
8795 ishield_list(i)=ishield_list(i)+1
8796 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8797 C this list is essential otherwise problem would be O3
8798 shield_list(ishield_list(i),i)=k
8799 C Lets have the sscale value
8800 if (sh_frac_dist.gt.1.0) then
8801 scale_fac_dist=1.0d0
8803 sh_frac_dist_grad(j)=0.0d0
8806 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8807 & *(2.0*sh_frac_dist-3.0d0)
8808 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8809 & /dist_pep_side/buff_shield*0.5
8810 C remember for the final gradient multiply sh_frac_dist_grad(j)
8811 C for side_chain by factor -2 !
8813 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8814 C print *,"jestem",scale_fac_dist,fac_help_scale,
8815 C & sh_frac_dist_grad(j)
8818 C if ((i.eq.3).and.(k.eq.2)) then
8819 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8823 C this is what is now we have the distance scaling now volume...
8824 short=short_r_sidechain(itype(k))
8825 long=long_r_sidechain(itype(k))
8826 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8829 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8832 costhet_grad(j)=costhet_fac*pep_side(j)
8834 C remember for the final gradient multiply costhet_grad(j)
8835 C for side_chain by factor -2 !
8836 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8837 C pep_side0pept_group is vector multiplication
8838 pep_side0pept_group=0.0
8840 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8842 cosalfa=(pep_side0pept_group/
8843 & (dist_pep_side*dist_side_calf))
8844 fac_alfa_sin=1.0-cosalfa**2
8845 fac_alfa_sin=dsqrt(fac_alfa_sin)
8846 rkprim=fac_alfa_sin*(long-short)+short
8848 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8849 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8852 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8853 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8854 &*(long-short)/fac_alfa_sin*cosalfa/
8855 &((dist_pep_side*dist_side_calf))*
8856 &((side_calf(j))-cosalfa*
8857 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8859 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8860 &*(long-short)/fac_alfa_sin*cosalfa
8861 &/((dist_pep_side*dist_side_calf))*
8863 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8866 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8869 C now the gradient...
8870 C grad_shield is gradient of Calfa for peptide groups
8871 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8873 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8874 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8876 grad_shield(j,i)=grad_shield(j,i)
8877 C gradient po skalowaniu
8878 & +(sh_frac_dist_grad(j)
8879 C gradient po costhet
8880 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8881 &-scale_fac_dist*(cosphi_grad_long(j))
8882 &/(1.0-cosphi) )*div77_81
8884 C grad_shield_side is Cbeta sidechain gradient
8885 grad_shield_side(j,ishield_list(i),i)=
8886 & (sh_frac_dist_grad(j)*-2.0d0
8887 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8888 & +scale_fac_dist*(cosphi_grad_long(j))
8889 & *2.0d0/(1.0-cosphi))
8890 & *div77_81*VofOverlap
8892 grad_shield_loc(j,ishield_list(i),i)=
8893 & scale_fac_dist*cosphi_grad_loc(j)
8894 & *2.0d0/(1.0-cosphi)
8895 & *div77_81*VofOverlap
8897 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8899 fac_shield(i)=VolumeTotal*div77_81+div4_81
8900 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8904 C--------------------------------------------------------------------------
8905 C-----------------------------------------------------------------------
8906 double precision function sscalelip(r)
8907 double precision r,gamm
8908 include "COMMON.SPLITELE"
8909 C if(r.lt.r_cut-rlamb) then
8911 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8912 C gamm=(r-(r_cut-rlamb))/rlamb
8913 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8919 C-----------------------------------------------------------------------
8920 double precision function sscagradlip(r)
8921 double precision r,gamm
8922 include "COMMON.SPLITELE"
8923 C if(r.lt.r_cut-rlamb) then
8925 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8926 C gamm=(r-(r_cut-rlamb))/rlamb
8927 sscagradlip=r*(6*r-6.0d0)
8934 C-----------------------------------------------------------------------
8935 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8936 subroutine Eliptransfer(eliptran)
8937 implicit real*8 (a-h,o-z)
8938 include 'DIMENSIONS'
8939 include 'COMMON.GEO'
8940 include 'COMMON.VAR'
8941 include 'COMMON.LOCAL'
8942 include 'COMMON.CHAIN'
8943 include 'COMMON.DERIV'
8944 include 'COMMON.INTERACT'
8945 include 'COMMON.IOUNITS'
8946 include 'COMMON.CALC'
8947 include 'COMMON.CONTROL'
8948 include 'COMMON.SPLITELE'
8949 include 'COMMON.SBRIDGE'
8950 C this is done by Adasko
8954 C--bordliptop-- buffore starts
8955 C--bufliptop--- here true lipid starts
8957 C--buflipbot--- lipid ends buffore starts
8958 C--bordlipbot--buffore ends
8960 write(iout,*) "I am in?"
8963 if (itype(i).eq.ntyp1) cycle
8965 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8966 if (positi.le.0) positi=positi+boxzsize
8968 C first for peptide groups
8969 c for each residue check if it is in lipid or lipid water border area
8970 if ((positi.gt.bordlipbot)
8971 &.and.(positi.lt.bordliptop)) then
8972 C the energy transfer exist
8973 if (positi.lt.buflipbot) then
8974 C what fraction I am in
8976 & ((positi-bordlipbot)/lipbufthick)
8977 C lipbufthick is thickenes of lipid buffore
8978 sslip=sscalelip(fracinbuf)
8979 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8980 eliptran=eliptran+sslip*pepliptran
8981 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8982 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8983 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8984 elseif (positi.gt.bufliptop) then
8985 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8986 sslip=sscalelip(fracinbuf)
8987 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8988 eliptran=eliptran+sslip*pepliptran
8989 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8990 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8991 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8992 C print *, "doing sscalefor top part"
8993 C print *,i,sslip,fracinbuf,ssgradlip
8995 eliptran=eliptran+pepliptran
8996 C print *,"I am in true lipid"
8999 C eliptran=elpitran+0.0 ! I am in water
9002 C print *, "nic nie bylo w lipidzie?"
9003 C now multiply all by the peptide group transfer factor
9004 C eliptran=eliptran*pepliptran
9005 C now the same for side chains
9008 if (itype(i).eq.ntyp1) cycle
9009 positi=(mod(c(3,i+nres),boxzsize))
9010 if (positi.le.0) positi=positi+boxzsize
9011 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9012 c for each residue check if it is in lipid or lipid water border area
9013 C respos=mod(c(3,i+nres),boxzsize)
9014 C print *,positi,bordlipbot,buflipbot
9015 if ((positi.gt.bordlipbot)
9016 & .and.(positi.lt.bordliptop)) then
9017 C the energy transfer exist
9018 if (positi.lt.buflipbot) then
9020 & ((positi-bordlipbot)/lipbufthick)
9021 C lipbufthick is thickenes of lipid buffore
9022 sslip=sscalelip(fracinbuf)
9023 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9024 eliptran=eliptran+sslip*liptranene(itype(i))
9025 gliptranx(3,i)=gliptranx(3,i)
9026 &+ssgradlip*liptranene(itype(i))
9027 gliptranc(3,i-1)= gliptranc(3,i-1)
9028 &+ssgradlip*liptranene(itype(i))
9029 C print *,"doing sccale for lower part"
9030 elseif (positi.gt.bufliptop) then
9032 &((bordliptop-positi)/lipbufthick)
9033 sslip=sscalelip(fracinbuf)
9034 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9035 eliptran=eliptran+sslip*liptranene(itype(i))
9036 gliptranx(3,i)=gliptranx(3,i)
9037 &+ssgradlip*liptranene(itype(i))
9038 gliptranc(3,i-1)= gliptranc(3,i-1)
9039 &+ssgradlip*liptranene(itype(i))
9040 C print *, "doing sscalefor top part",sslip,fracinbuf
9042 eliptran=eliptran+liptranene(itype(i))
9043 C print *,"I am in true lipid"
9045 endif ! if in lipid or buffor
9047 C eliptran=elpitran+0.0 ! I am in water
9051 C-------------------------------------------------------------------------------------