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
121 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
122 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
124 write (iout,*) "ft(6)",fact(6),wliptran,eliptran
126 if (shield_mode.gt.0) then
127 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
129 & +fact(1)*wvdwpp*evdw1
130 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
131 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
132 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
133 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
134 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
135 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
138 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
140 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
141 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
142 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
143 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
144 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
145 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
149 if (shield_mode.gt.0) then
150 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
151 & +welec*fact(1)*(ees+evdw1)
152 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
153 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
154 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
155 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
156 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
157 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
160 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
161 & +welec*fact(1)*(ees+evdw1)
162 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
163 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
164 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
165 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
166 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
167 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
175 energia(2)=evdw2-evdw2_14
192 energia(8)=eello_turn3
193 energia(9)=eello_turn4
202 energia(20)=edihcnstr
204 energia(24)=ethetacnstr
209 if (isnan(etot).ne.0) energia(0)=1.0d+99
211 if (isnan(etot)) energia(0)=1.0d+99
216 idumm=proc_proc(etot,i)
218 call proc_proc(etot,i)
220 if(i.eq.1)energia(0)=1.0d+99
227 C Sum up the components of the Cartesian gradient.
232 if (shield_mode.eq.0) then
233 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
234 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
236 & wstrain*ghpbc(j,i)+
237 & wcorr*fact(3)*gradcorr(j,i)+
238 & wel_loc*fact(2)*gel_loc(j,i)+
239 & wturn3*fact(2)*gcorr3_turn(j,i)+
240 & wturn4*fact(3)*gcorr4_turn(j,i)+
241 & wcorr5*fact(4)*gradcorr5(j,i)+
242 & wcorr6*fact(5)*gradcorr6(j,i)+
243 & wturn6*fact(5)*gcorr6_turn(j,i)+
244 & wsccor*fact(2)*gsccorc(j,i)
245 & +wliptran*gliptranc(j,i)
246 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
248 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
249 & wsccor*fact(2)*gsccorx(j,i)
250 & +wliptran*gliptranx(j,i)
252 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
253 & +fact(1)*wscp*gvdwc_scp(j,i)+
254 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
256 & wstrain*ghpbc(j,i)+
257 & wcorr*fact(3)*gradcorr(j,i)+
258 & wel_loc*fact(2)*gel_loc(j,i)+
259 & wturn3*fact(2)*gcorr3_turn(j,i)+
260 & wturn4*fact(3)*gcorr4_turn(j,i)+
261 & wcorr5*fact(4)*gradcorr5(j,i)+
262 & wcorr6*fact(5)*gradcorr6(j,i)+
263 & wturn6*fact(5)*gcorr6_turn(j,i)+
264 & wsccor*fact(2)*gsccorc(j,i)
265 & +wliptran*gliptranc(j,i)
266 & +welec*gshieldc(j,i)
267 & +welec*gshieldc_loc(j,i)
268 & +wcorr*gshieldc_ec(j,i)
269 & +wcorr*gshieldc_loc_ec(j,i)
270 & +wturn3*gshieldc_t3(j,i)
271 & +wturn3*gshieldc_loc_t3(j,i)
272 & +wturn4*gshieldc_t4(j,i)
273 & +wturn4*gshieldc_loc_t4(j,i)
274 & +wel_loc*gshieldc_ll(j,i)
275 & +wel_loc*gshieldc_loc_ll(j,i)
277 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
278 & +fact(1)*wscp*gradx_scp(j,i)+
280 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
281 & wsccor*fact(2)*gsccorx(j,i)
282 & +wliptran*gliptranx(j,i)
283 & +welec*gshieldx(j,i)
284 & +wcorr*gshieldx_ec(j,i)
285 & +wturn3*gshieldx_t3(j,i)
286 & +wturn4*gshieldx_t4(j,i)
287 & +wel_loc*gshieldx_ll(j,i)
295 if (shield_mode.eq.0) then
296 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
297 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
299 & wcorr*fact(3)*gradcorr(j,i)+
300 & wel_loc*fact(2)*gel_loc(j,i)+
301 & wturn3*fact(2)*gcorr3_turn(j,i)+
302 & wturn4*fact(3)*gcorr4_turn(j,i)+
303 & wcorr5*fact(4)*gradcorr5(j,i)+
304 & wcorr6*fact(5)*gradcorr6(j,i)+
305 & wturn6*fact(5)*gcorr6_turn(j,i)+
306 & wsccor*fact(2)*gsccorc(j,i)
307 & +wliptran*gliptranc(j,i)
308 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
310 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
311 & wsccor*fact(1)*gsccorx(j,i)
312 & +wliptran*gliptranx(j,i)
314 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
315 & fact(1)*wscp*gvdwc_scp(j,i)+
316 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
318 & wcorr*fact(3)*gradcorr(j,i)+
319 & wel_loc*fact(2)*gel_loc(j,i)+
320 & wturn3*fact(2)*gcorr3_turn(j,i)+
321 & wturn4*fact(3)*gcorr4_turn(j,i)+
322 & wcorr5*fact(4)*gradcorr5(j,i)+
323 & wcorr6*fact(5)*gradcorr6(j,i)+
324 & wturn6*fact(5)*gcorr6_turn(j,i)+
325 & wsccor*fact(2)*gsccorc(j,i)
326 & +wliptran*gliptranc(j,i)
327 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
328 & fact(1)*wscp*gradx_scp(j,i)+
330 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
331 & wsccor*fact(1)*gsccorx(j,i)
332 & +wliptran*gliptranx(j,i)
340 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
341 & +wcorr5*fact(4)*g_corr5_loc(i)
342 & +wcorr6*fact(5)*g_corr6_loc(i)
343 & +wturn4*fact(3)*gel_loc_turn4(i)
344 & +wturn3*fact(2)*gel_loc_turn3(i)
345 & +wturn6*fact(5)*gel_loc_turn6(i)
346 & +wel_loc*fact(2)*gel_loc_loc(i)
347 c & +wsccor*fact(1)*gsccor_loc(i)
351 if (dyn_ss) call dyn_set_nss
354 C------------------------------------------------------------------------
355 subroutine enerprint(energia,fact)
356 implicit real*8 (a-h,o-z)
358 include 'sizesclu.dat'
359 include 'COMMON.IOUNITS'
360 include 'COMMON.FFIELD'
361 include 'COMMON.SBRIDGE'
362 double precision energia(0:max_ene),fact(6)
364 evdw=energia(1)+fact(6)*energia(21)
366 evdw2=energia(2)+energia(17)
378 eello_turn3=energia(8)
379 eello_turn4=energia(9)
380 eello_turn6=energia(10)
387 edihcnstr=energia(20)
389 ethetacnstr=energia(24)
391 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
393 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
394 & etors_d,wtor_d*fact(2),ehpb,wstrain,
395 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
396 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
397 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
398 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
399 10 format (/'Virtual-chain energies:'//
400 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
401 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
402 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
403 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
404 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
405 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
406 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
407 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
408 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
409 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
410 & ' (SS bridges & dist. cnstr.)'/
411 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
412 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
413 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
414 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
415 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
416 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
417 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
418 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
419 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
420 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
421 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
422 & 'ETOT= ',1pE16.6,' (total)')
424 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
425 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
426 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
427 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
428 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
429 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
430 & edihcnstr,ethetacnstr,ebr*nss,etot
431 10 format (/'Virtual-chain energies:'//
432 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
433 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
434 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
435 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
436 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
437 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
438 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
439 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
440 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
441 & ' (SS bridges & dist. cnstr.)'/
442 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
443 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
444 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
445 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
446 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
447 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
448 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
449 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
450 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
451 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
452 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
453 & 'ETOT= ',1pE16.6,' (total)')
457 C-----------------------------------------------------------------------
458 subroutine elj(evdw,evdw_t)
460 C This subroutine calculates the interaction energy of nonbonded side chains
461 C assuming the LJ potential of interaction.
463 implicit real*8 (a-h,o-z)
465 include 'sizesclu.dat'
466 include "DIMENSIONS.COMPAR"
467 parameter (accur=1.0d-10)
470 include 'COMMON.LOCAL'
471 include 'COMMON.CHAIN'
472 include 'COMMON.DERIV'
473 include 'COMMON.INTERACT'
474 include 'COMMON.TORSION'
475 include 'COMMON.SBRIDGE'
476 include 'COMMON.NAMES'
477 include 'COMMON.IOUNITS'
478 include 'COMMON.CONTACTS'
482 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
483 c ROZNICA DODANE Z WHAM
486 c eneps_temp(j,i)=0.0d0
495 if (itypi.eq.ntyp1) cycle
496 itypi1=iabs(itype(i+1))
503 C Calculate SC interaction energy.
506 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
507 cd & 'iend=',iend(i,iint)
508 do j=istart(i,iint),iend(i,iint)
510 if (itypj.eq.ntyp1) cycle
514 C Change 12/1/95 to calculate four-body interactions
515 rij=xj*xj+yj*yj+zj*zj
517 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
518 eps0ij=eps(itypi,itypj)
523 ij=icant(itypi,itypj)
525 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
526 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
529 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
530 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
531 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
532 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
533 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
534 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
535 if (bb.gt.0.0d0) then
542 C Calculate the components of the gradient in DC and X
544 fac=-rrij*(e1+evdwij)
549 gvdwx(k,i)=gvdwx(k,i)-gg(k)
550 gvdwx(k,j)=gvdwx(k,j)+gg(k)
554 gvdwc(l,k)=gvdwc(l,k)+gg(l)
559 C 12/1/95, revised on 5/20/97
561 C Calculate the contact function. The ith column of the array JCONT will
562 C contain the numbers of atoms that make contacts with the atom I (of numbers
563 C greater than I). The arrays FACONT and GACONT will contain the values of
564 C the contact function and its derivative.
566 C Uncomment next line, if the correlation interactions include EVDW explicitly.
567 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
568 C Uncomment next line, if the correlation interactions are contact function only
569 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
571 sigij=sigma(itypi,itypj)
572 r0ij=rs0(itypi,itypj)
574 C Check whether the SC's are not too far to make a contact.
577 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
578 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
580 if (fcont.gt.0.0D0) then
581 C If the SC-SC distance if close to sigma, apply spline.
582 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
583 cAdam & fcont1,fprimcont1)
584 cAdam fcont1=1.0d0-fcont1
585 cAdam if (fcont1.gt.0.0d0) then
586 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
587 cAdam fcont=fcont*fcont1
589 C Uncomment following 4 lines to have the geometric average of the epsilon0's
590 cga eps0ij=1.0d0/dsqrt(eps0ij)
592 cga gg(k)=gg(k)*eps0ij
594 cga eps0ij=-evdwij*eps0ij
595 C Uncomment for AL's type of SC correlation interactions.
597 num_conti=num_conti+1
599 facont(num_conti,i)=fcont*eps0ij
600 fprimcont=eps0ij*fprimcont/rij
602 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
603 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
604 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
605 C Uncomment following 3 lines for Skolnick's type of SC correlation.
606 gacont(1,num_conti,i)=-fprimcont*xj
607 gacont(2,num_conti,i)=-fprimcont*yj
608 gacont(3,num_conti,i)=-fprimcont*zj
609 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
610 cd write (iout,'(2i3,3f10.5)')
611 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
617 num_cont(i)=num_conti
622 gvdwc(j,i)=expon*gvdwc(j,i)
623 gvdwx(j,i)=expon*gvdwx(j,i)
627 C******************************************************************************
631 C To save time, the factor of EXPON has been extracted from ALL components
632 C of GVDWC and GRADX. Remember to multiply them by this factor before further
635 C******************************************************************************
638 C-----------------------------------------------------------------------------
639 subroutine eljk(evdw,evdw_t)
641 C This subroutine calculates the interaction energy of nonbonded side chains
642 C assuming the LJK potential of interaction.
644 implicit real*8 (a-h,o-z)
646 include 'sizesclu.dat'
647 include "DIMENSIONS.COMPAR"
650 include 'COMMON.LOCAL'
651 include 'COMMON.CHAIN'
652 include 'COMMON.DERIV'
653 include 'COMMON.INTERACT'
654 include 'COMMON.IOUNITS'
655 include 'COMMON.NAMES'
660 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
665 if (itypi.eq.ntyp1) cycle
666 itypi1=iabs(itype(i+1))
671 C Calculate SC interaction energy.
674 do j=istart(i,iint),iend(i,iint)
676 if (itypj.eq.ntyp1) cycle
680 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
682 e_augm=augm(itypi,itypj)*fac_augm
685 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
686 fac=r_shift_inv**expon
690 ij=icant(itypi,itypj)
691 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
692 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
693 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
694 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
695 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
696 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
697 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
698 if (bb.gt.0.0d0) then
705 C Calculate the components of the gradient in DC and X
707 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
712 gvdwx(k,i)=gvdwx(k,i)-gg(k)
713 gvdwx(k,j)=gvdwx(k,j)+gg(k)
717 gvdwc(l,k)=gvdwc(l,k)+gg(l)
727 gvdwc(j,i)=expon*gvdwc(j,i)
728 gvdwx(j,i)=expon*gvdwx(j,i)
734 C-----------------------------------------------------------------------------
735 subroutine ebp(evdw,evdw_t)
737 C This subroutine calculates the interaction energy of nonbonded side chains
738 C assuming the Berne-Pechukas potential of interaction.
740 implicit real*8 (a-h,o-z)
742 include 'sizesclu.dat'
743 include "DIMENSIONS.COMPAR"
746 include 'COMMON.LOCAL'
747 include 'COMMON.CHAIN'
748 include 'COMMON.DERIV'
749 include 'COMMON.NAMES'
750 include 'COMMON.INTERACT'
751 include 'COMMON.IOUNITS'
752 include 'COMMON.CALC'
754 c double precision rrsave(maxdim)
760 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
761 c if (icall.eq.0) then
769 if (itypi.eq.ntyp1) cycle
770 itypi1=iabs(itype(i+1))
774 dxi=dc_norm(1,nres+i)
775 dyi=dc_norm(2,nres+i)
776 dzi=dc_norm(3,nres+i)
777 dsci_inv=vbld_inv(i+nres)
779 C Calculate SC interaction energy.
782 do j=istart(i,iint),iend(i,iint)
785 if (itypj.eq.ntyp1) cycle
786 dscj_inv=vbld_inv(j+nres)
787 chi1=chi(itypi,itypj)
788 chi2=chi(itypj,itypi)
795 alf12=0.5D0*(alf1+alf2)
796 C For diagnostics only!!!
809 dxj=dc_norm(1,nres+j)
810 dyj=dc_norm(2,nres+j)
811 dzj=dc_norm(3,nres+j)
812 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
813 cd if (icall.eq.0) then
819 C Calculate the angle-dependent terms of energy & contributions to derivatives.
821 C Calculate whole angle-dependent part of epsilon and contributions
823 fac=(rrij*sigsq)**expon2
826 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
827 eps2der=evdwij*eps3rt
828 eps3der=evdwij*eps2rt
829 evdwij=evdwij*eps2rt*eps3rt
830 ij=icant(itypi,itypj)
831 aux=eps1*eps2rt**2*eps3rt**2
832 if (bb.gt.0.0d0) then
839 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
841 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
842 cd & restyp(itypi),i,restyp(itypj),j,
843 cd & epsi,sigm,chi1,chi2,chip1,chip2,
844 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
845 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
848 C Calculate gradient components.
849 e1=e1*eps1*eps2rt**2*eps3rt**2
850 fac=-expon*(e1+evdwij)
853 C Calculate radial part of the gradient
857 C Calculate the angular part of the gradient and sum add the contributions
858 C to the appropriate components of the Cartesian gradient.
867 C-----------------------------------------------------------------------------
868 subroutine egb(evdw,evdw_t)
870 C This subroutine calculates the interaction energy of nonbonded side chains
871 C assuming the Gay-Berne potential of interaction.
873 implicit real*8 (a-h,o-z)
875 include 'sizesclu.dat'
876 include "DIMENSIONS.COMPAR"
879 include 'COMMON.LOCAL'
880 include 'COMMON.CHAIN'
881 include 'COMMON.DERIV'
882 include 'COMMON.NAMES'
883 include 'COMMON.INTERACT'
884 include 'COMMON.IOUNITS'
885 include 'COMMON.CALC'
886 include 'COMMON.SBRIDGE'
891 integer xshift,yshift,zshift
892 logical energy_dec /.false./
893 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
897 c if (icall.gt.0) lprn=.true.
901 if (itypi.eq.ntyp1) cycle
902 itypi1=iabs(itype(i+1))
907 if (xi.lt.0) xi=xi+boxxsize
909 if (yi.lt.0) yi=yi+boxysize
911 if (zi.lt.0) zi=zi+boxzsize
912 if ((zi.gt.bordlipbot)
913 &.and.(zi.lt.bordliptop)) then
914 C the energy transfer exist
915 if (zi.lt.buflipbot) then
916 C what fraction I am in
918 & ((zi-bordlipbot)/lipbufthick)
919 C lipbufthick is thickenes of lipid buffore
920 sslipi=sscalelip(fracinbuf)
921 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
922 elseif (zi.gt.bufliptop) then
923 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
924 sslipi=sscalelip(fracinbuf)
925 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
934 dxi=dc_norm(1,nres+i)
935 dyi=dc_norm(2,nres+i)
936 dzi=dc_norm(3,nres+i)
937 dsci_inv=vbld_inv(i+nres)
939 C Calculate SC interaction energy.
942 do j=istart(i,iint),iend(i,iint)
943 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
945 c write(iout,*) "PRZED ZWYKLE", evdwij
946 call dyn_ssbond_ene(i,j,evdwij)
947 c write(iout,*) "PO ZWYKLE", evdwij
950 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
951 & 'evdw',i,j,evdwij,' ss'
952 C triple bond artifac removal
953 do k=j+1,iend(i,iint)
954 C search over all next residues
955 if (dyn_ss_mask(k)) then
956 C check if they are cysteins
957 C write(iout,*) 'k=',k
959 c write(iout,*) "PRZED TRI", evdwij
960 evdwij_przed_tri=evdwij
961 call triple_ssbond_ene(i,j,k,evdwij)
962 c if(evdwij_przed_tri.ne.evdwij) then
963 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
966 c write(iout,*) "PO TRI", evdwij
967 C call the energy function that removes the artifical triple disulfide
968 C bond the soubroutine is located in ssMD.F
970 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
971 & 'evdw',i,j,evdwij,'tss'
977 if (itypj.eq.ntyp1) cycle
978 dscj_inv=vbld_inv(j+nres)
979 sig0ij=sigma(itypi,itypj)
980 chi1=chi(itypi,itypj)
981 chi2=chi(itypj,itypi)
988 alf12=0.5D0*(alf1+alf2)
989 C For diagnostics only!!!
1003 if (xj.lt.0) xj=xj+boxxsize
1005 if (yj.lt.0) yj=yj+boxysize
1007 if (zj.lt.0) zj=zj+boxzsize
1008 if ((zj.gt.bordlipbot)
1009 &.and.(zj.lt.bordliptop)) then
1010 C the energy transfer exist
1011 if (zj.lt.buflipbot) then
1012 C what fraction I am in
1014 & ((zj-bordlipbot)/lipbufthick)
1015 C lipbufthick is thickenes of lipid buffore
1016 sslipj=sscalelip(fracinbuf)
1017 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1018 elseif (zj.gt.bufliptop) then
1019 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1020 sslipj=sscalelip(fracinbuf)
1021 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1030 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1031 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1032 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1033 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1034 C write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
1035 C & bb-bb_aq(itypi,itypj)
1036 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1044 xj=xj_safe+xshift*boxxsize
1045 yj=yj_safe+yshift*boxysize
1046 zj=zj_safe+zshift*boxzsize
1047 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1048 if(dist_temp.lt.dist_init) then
1058 if (subchap.eq.1) then
1067 dxj=dc_norm(1,nres+j)
1068 dyj=dc_norm(2,nres+j)
1069 dzj=dc_norm(3,nres+j)
1070 c write (iout,*) i,j,xj,yj,zj
1071 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1073 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1074 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1075 if (sss.le.0.0d0) cycle
1076 C Calculate angle-dependent terms of energy and contributions to their
1080 sig=sig0ij*dsqrt(sigsq)
1081 rij_shift=1.0D0/rij-sig+sig0ij
1082 C I hate to put IF's in the loops, but here don't have another choice!!!!
1083 if (rij_shift.le.0.0D0) then
1088 c---------------------------------------------------------------
1089 rij_shift=1.0D0/rij_shift
1090 fac=rij_shift**expon
1093 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1094 eps2der=evdwij*eps3rt
1095 eps3der=evdwij*eps2rt
1096 evdwij=evdwij*eps2rt*eps3rt
1098 evdw=evdw+evdwij*sss
1100 evdw_t=evdw_t+evdwij*sss
1102 ij=icant(itypi,itypj)
1103 aux=eps1*eps2rt**2*eps3rt**2
1104 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1105 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1106 c & aux*e2/eps(itypi,itypj)
1108 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1112 C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1113 C & restyp(itypi),i,restyp(itypj),j,
1114 C & epsi,sigm,chi1,chi2,chip1,chip2,
1115 C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1116 C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1118 write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
1123 C Calculate gradient components.
1124 e1=e1*eps1*eps2rt**2*eps3rt**2
1125 fac=-expon*(e1+evdwij)*rij_shift
1128 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1129 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1130 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1131 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1132 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1133 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1134 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1135 C Calculate the radial part of the gradient
1139 C Calculate angular part of the gradient.
1148 C-----------------------------------------------------------------------------
1149 subroutine egbv(evdw,evdw_t)
1151 C This subroutine calculates the interaction energy of nonbonded side chains
1152 C assuming the Gay-Berne-Vorobjev potential of interaction.
1154 implicit real*8 (a-h,o-z)
1155 include 'DIMENSIONS'
1156 include 'sizesclu.dat'
1157 include "DIMENSIONS.COMPAR"
1158 include 'COMMON.GEO'
1159 include 'COMMON.VAR'
1160 include 'COMMON.LOCAL'
1161 include 'COMMON.CHAIN'
1162 include 'COMMON.DERIV'
1163 include 'COMMON.NAMES'
1164 include 'COMMON.INTERACT'
1165 include 'COMMON.IOUNITS'
1166 include 'COMMON.CALC'
1167 common /srutu/ icall
1173 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1176 c if (icall.gt.0) lprn=.true.
1178 do i=iatsc_s,iatsc_e
1179 itypi=iabs(itype(i))
1180 if (itypi.eq.ntyp1) cycle
1181 itypi1=iabs(itype(i+1))
1185 dxi=dc_norm(1,nres+i)
1186 dyi=dc_norm(2,nres+i)
1187 dzi=dc_norm(3,nres+i)
1188 dsci_inv=vbld_inv(i+nres)
1189 C returning the ith atom to box
1191 if (xi.lt.0) xi=xi+boxxsize
1193 if (yi.lt.0) yi=yi+boxysize
1195 if (zi.lt.0) zi=zi+boxzsize
1196 if ((zi.gt.bordlipbot)
1197 &.and.(zi.lt.bordliptop)) then
1198 C the energy transfer exist
1199 if (zi.lt.buflipbot) then
1200 C what fraction I am in
1202 & ((zi-bordlipbot)/lipbufthick)
1203 C lipbufthick is thickenes of lipid buffore
1204 sslipi=sscalelip(fracinbuf)
1205 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1206 elseif (zi.gt.bufliptop) then
1207 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1208 sslipi=sscalelip(fracinbuf)
1209 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1219 C Calculate SC interaction energy.
1221 do iint=1,nint_gr(i)
1222 do j=istart(i,iint),iend(i,iint)
1224 itypj=iabs(itype(j))
1225 if (itypj.eq.ntyp1) cycle
1226 dscj_inv=vbld_inv(j+nres)
1227 sig0ij=sigma(itypi,itypj)
1228 r0ij=r0(itypi,itypj)
1229 chi1=chi(itypi,itypj)
1230 chi2=chi(itypj,itypi)
1237 alf12=0.5D0*(alf1+alf2)
1238 C For diagnostics only!!!
1251 C returning jth atom to box
1253 if (xj.lt.0) xj=xj+boxxsize
1255 if (yj.lt.0) yj=yj+boxysize
1257 if (zj.lt.0) zj=zj+boxzsize
1258 if ((zj.gt.bordlipbot)
1259 &.and.(zj.lt.bordliptop)) then
1260 C the energy transfer exist
1261 if (zj.lt.buflipbot) then
1262 C what fraction I am in
1264 & ((zj-bordlipbot)/lipbufthick)
1265 C lipbufthick is thickenes of lipid buffore
1266 sslipj=sscalelip(fracinbuf)
1267 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1268 elseif (zj.gt.bufliptop) then
1269 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1270 sslipj=sscalelip(fracinbuf)
1271 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1280 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1281 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1282 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1283 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1284 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1285 C checking the distance
1286 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1291 C finding the closest
1295 xj=xj_safe+xshift*boxxsize
1296 yj=yj_safe+yshift*boxysize
1297 zj=zj_safe+zshift*boxzsize
1298 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1299 if(dist_temp.lt.dist_init) then
1309 if (subchap.eq.1) then
1318 dxj=dc_norm(1,nres+j)
1319 dyj=dc_norm(2,nres+j)
1320 dzj=dc_norm(3,nres+j)
1321 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1323 C Calculate angle-dependent terms of energy and contributions to their
1327 sig=sig0ij*dsqrt(sigsq)
1328 rij_shift=1.0D0/rij-sig+r0ij
1329 C I hate to put IF's in the loops, but here don't have another choice!!!!
1330 if (rij_shift.le.0.0D0) then
1335 c---------------------------------------------------------------
1336 rij_shift=1.0D0/rij_shift
1337 fac=rij_shift**expon
1340 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1341 eps2der=evdwij*eps3rt
1342 eps3der=evdwij*eps2rt
1343 fac_augm=rrij**expon
1344 e_augm=augm(itypi,itypj)*fac_augm
1345 evdwij=evdwij*eps2rt*eps3rt
1346 if (bb.gt.0.0d0) then
1347 evdw=evdw+evdwij+e_augm
1349 evdw_t=evdw_t+evdwij+e_augm
1351 ij=icant(itypi,itypj)
1352 aux=eps1*eps2rt**2*eps3rt**2
1354 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1355 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1356 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1357 c & restyp(itypi),i,restyp(itypj),j,
1358 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1359 c & chi1,chi2,chip1,chip2,
1360 c & eps1,eps2rt**2,eps3rt**2,
1361 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1365 C Calculate gradient components.
1366 e1=e1*eps1*eps2rt**2*eps3rt**2
1367 fac=-expon*(e1+evdwij)*rij_shift
1369 fac=rij*fac-2*expon*rrij*e_augm
1370 C Calculate the radial part of the gradient
1374 C Calculate angular part of the gradient.
1382 C-----------------------------------------------------------------------------
1383 subroutine sc_angular
1384 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1385 C om12. Called by ebp, egb, and egbv.
1387 include 'COMMON.CALC'
1391 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1392 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1393 om12=dxi*dxj+dyi*dyj+dzi*dzj
1395 C Calculate eps1(om12) and its derivative in om12
1396 faceps1=1.0D0-om12*chiom12
1397 faceps1_inv=1.0D0/faceps1
1398 eps1=dsqrt(faceps1_inv)
1399 C Following variable is eps1*deps1/dom12
1400 eps1_om12=faceps1_inv*chiom12
1401 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1406 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1407 sigsq=1.0D0-facsig*faceps1_inv
1408 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1409 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1410 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1411 C Calculate eps2 and its derivatives in om1, om2, and om12.
1414 chipom12=chip12*om12
1415 facp=1.0D0-om12*chipom12
1417 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1418 C Following variable is the square root of eps2
1419 eps2rt=1.0D0-facp1*facp_inv
1420 C Following three variables are the derivatives of the square root of eps
1421 C in om1, om2, and om12.
1422 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1423 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1424 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1425 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1426 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1427 C Calculate whole angle-dependent part of epsilon and contributions
1428 C to its derivatives
1431 C----------------------------------------------------------------------------
1433 implicit real*8 (a-h,o-z)
1434 include 'DIMENSIONS'
1435 include 'sizesclu.dat'
1436 include 'COMMON.CHAIN'
1437 include 'COMMON.DERIV'
1438 include 'COMMON.CALC'
1439 double precision dcosom1(3),dcosom2(3)
1440 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1441 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1442 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1443 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1445 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1446 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1449 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1452 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
1453 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1454 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1455 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipi(k)
1456 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1457 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1460 C Calculate the components of the gradient in DC and X
1464 gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
1468 gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
1472 c------------------------------------------------------------------------------
1473 subroutine vec_and_deriv
1474 implicit real*8 (a-h,o-z)
1475 include 'DIMENSIONS'
1476 include 'sizesclu.dat'
1477 include 'COMMON.IOUNITS'
1478 include 'COMMON.GEO'
1479 include 'COMMON.VAR'
1480 include 'COMMON.LOCAL'
1481 include 'COMMON.CHAIN'
1482 include 'COMMON.VECTORS'
1483 include 'COMMON.DERIV'
1484 include 'COMMON.INTERACT'
1485 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1486 C Compute the local reference systems. For reference system (i), the
1487 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1488 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1490 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1491 if (i.eq.nres-1) then
1492 C Case of the last full residue
1493 C Compute the Z-axis
1494 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1495 costh=dcos(pi-theta(nres))
1496 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1501 C Compute the derivatives of uz
1503 uzder(2,1,1)=-dc_norm(3,i-1)
1504 uzder(3,1,1)= dc_norm(2,i-1)
1505 uzder(1,2,1)= dc_norm(3,i-1)
1507 uzder(3,2,1)=-dc_norm(1,i-1)
1508 uzder(1,3,1)=-dc_norm(2,i-1)
1509 uzder(2,3,1)= dc_norm(1,i-1)
1512 uzder(2,1,2)= dc_norm(3,i)
1513 uzder(3,1,2)=-dc_norm(2,i)
1514 uzder(1,2,2)=-dc_norm(3,i)
1516 uzder(3,2,2)= dc_norm(1,i)
1517 uzder(1,3,2)= dc_norm(2,i)
1518 uzder(2,3,2)=-dc_norm(1,i)
1521 C Compute the Y-axis
1524 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1527 C Compute the derivatives of uy
1530 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1531 & -dc_norm(k,i)*dc_norm(j,i-1)
1532 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1534 uyder(j,j,1)=uyder(j,j,1)-costh
1535 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1540 uygrad(l,k,j,i)=uyder(l,k,j)
1541 uzgrad(l,k,j,i)=uzder(l,k,j)
1545 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1546 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1547 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1548 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1552 C Compute the Z-axis
1553 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1554 costh=dcos(pi-theta(i+2))
1555 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1560 C Compute the derivatives of uz
1562 uzder(2,1,1)=-dc_norm(3,i+1)
1563 uzder(3,1,1)= dc_norm(2,i+1)
1564 uzder(1,2,1)= dc_norm(3,i+1)
1566 uzder(3,2,1)=-dc_norm(1,i+1)
1567 uzder(1,3,1)=-dc_norm(2,i+1)
1568 uzder(2,3,1)= dc_norm(1,i+1)
1571 uzder(2,1,2)= dc_norm(3,i)
1572 uzder(3,1,2)=-dc_norm(2,i)
1573 uzder(1,2,2)=-dc_norm(3,i)
1575 uzder(3,2,2)= dc_norm(1,i)
1576 uzder(1,3,2)= dc_norm(2,i)
1577 uzder(2,3,2)=-dc_norm(1,i)
1580 C Compute the Y-axis
1583 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1586 C Compute the derivatives of uy
1589 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1590 & -dc_norm(k,i)*dc_norm(j,i+1)
1591 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1593 uyder(j,j,1)=uyder(j,j,1)-costh
1594 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1599 uygrad(l,k,j,i)=uyder(l,k,j)
1600 uzgrad(l,k,j,i)=uzder(l,k,j)
1604 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1605 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1606 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1607 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1613 vbld_inv_temp(1)=vbld_inv(i+1)
1614 if (i.lt.nres-1) then
1615 vbld_inv_temp(2)=vbld_inv(i+2)
1617 vbld_inv_temp(2)=vbld_inv(i)
1622 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1623 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1631 C-----------------------------------------------------------------------------
1632 subroutine vec_and_deriv_test
1633 implicit real*8 (a-h,o-z)
1634 include 'DIMENSIONS'
1635 include 'sizesclu.dat'
1636 include 'COMMON.IOUNITS'
1637 include 'COMMON.GEO'
1638 include 'COMMON.VAR'
1639 include 'COMMON.LOCAL'
1640 include 'COMMON.CHAIN'
1641 include 'COMMON.VECTORS'
1642 dimension uyder(3,3,2),uzder(3,3,2)
1643 C Compute the local reference systems. For reference system (i), the
1644 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1645 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1647 if (i.eq.nres-1) then
1648 C Case of the last full residue
1649 C Compute the Z-axis
1650 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1651 costh=dcos(pi-theta(nres))
1652 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1653 c write (iout,*) 'fac',fac,
1654 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1655 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1659 C Compute the derivatives of uz
1661 uzder(2,1,1)=-dc_norm(3,i-1)
1662 uzder(3,1,1)= dc_norm(2,i-1)
1663 uzder(1,2,1)= dc_norm(3,i-1)
1665 uzder(3,2,1)=-dc_norm(1,i-1)
1666 uzder(1,3,1)=-dc_norm(2,i-1)
1667 uzder(2,3,1)= dc_norm(1,i-1)
1670 uzder(2,1,2)= dc_norm(3,i)
1671 uzder(3,1,2)=-dc_norm(2,i)
1672 uzder(1,2,2)=-dc_norm(3,i)
1674 uzder(3,2,2)= dc_norm(1,i)
1675 uzder(1,3,2)= dc_norm(2,i)
1676 uzder(2,3,2)=-dc_norm(1,i)
1678 C Compute the Y-axis
1680 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1683 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1684 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1685 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1687 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1690 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1691 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1694 c write (iout,*) 'facy',facy,
1695 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1696 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1698 uy(k,i)=facy*uy(k,i)
1700 C Compute the derivatives of uy
1703 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1704 & -dc_norm(k,i)*dc_norm(j,i-1)
1705 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1707 c uyder(j,j,1)=uyder(j,j,1)-costh
1708 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1709 uyder(j,j,1)=uyder(j,j,1)
1710 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1711 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1717 uygrad(l,k,j,i)=uyder(l,k,j)
1718 uzgrad(l,k,j,i)=uzder(l,k,j)
1722 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1723 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1724 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1725 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1728 C Compute the Z-axis
1729 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1730 costh=dcos(pi-theta(i+2))
1731 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1732 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1736 C Compute the derivatives of uz
1738 uzder(2,1,1)=-dc_norm(3,i+1)
1739 uzder(3,1,1)= dc_norm(2,i+1)
1740 uzder(1,2,1)= dc_norm(3,i+1)
1742 uzder(3,2,1)=-dc_norm(1,i+1)
1743 uzder(1,3,1)=-dc_norm(2,i+1)
1744 uzder(2,3,1)= dc_norm(1,i+1)
1747 uzder(2,1,2)= dc_norm(3,i)
1748 uzder(3,1,2)=-dc_norm(2,i)
1749 uzder(1,2,2)=-dc_norm(3,i)
1751 uzder(3,2,2)= dc_norm(1,i)
1752 uzder(1,3,2)= dc_norm(2,i)
1753 uzder(2,3,2)=-dc_norm(1,i)
1755 C Compute the Y-axis
1757 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1758 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1759 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1761 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1764 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1765 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1768 c write (iout,*) 'facy',facy,
1769 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1770 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1772 uy(k,i)=facy*uy(k,i)
1774 C Compute the derivatives of uy
1777 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1778 & -dc_norm(k,i)*dc_norm(j,i+1)
1779 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1781 c uyder(j,j,1)=uyder(j,j,1)-costh
1782 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1783 uyder(j,j,1)=uyder(j,j,1)
1784 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1785 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1791 uygrad(l,k,j,i)=uyder(l,k,j)
1792 uzgrad(l,k,j,i)=uzder(l,k,j)
1796 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1797 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1798 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1799 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1806 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1807 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1814 C-----------------------------------------------------------------------------
1815 subroutine check_vecgrad
1816 implicit real*8 (a-h,o-z)
1817 include 'DIMENSIONS'
1818 include 'sizesclu.dat'
1819 include 'COMMON.IOUNITS'
1820 include 'COMMON.GEO'
1821 include 'COMMON.VAR'
1822 include 'COMMON.LOCAL'
1823 include 'COMMON.CHAIN'
1824 include 'COMMON.VECTORS'
1825 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1826 dimension uyt(3,maxres),uzt(3,maxres)
1827 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1828 double precision delta /1.0d-7/
1831 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1832 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1833 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1834 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1835 cd & (dc_norm(if90,i),if90=1,3)
1836 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1837 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1838 cd write(iout,'(a)')
1844 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1845 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1858 cd write (iout,*) 'i=',i
1860 erij(k)=dc_norm(k,i)
1864 dc_norm(k,i)=erij(k)
1866 dc_norm(j,i)=dc_norm(j,i)+delta
1867 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1869 c dc_norm(k,i)=dc_norm(k,i)/fac
1871 c write (iout,*) (dc_norm(k,i),k=1,3)
1872 c write (iout,*) (erij(k),k=1,3)
1875 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1876 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1877 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1878 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1880 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1881 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1882 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1885 dc_norm(k,i)=erij(k)
1888 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1889 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1890 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1891 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1892 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1893 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1894 cd write (iout,'(a)')
1899 C--------------------------------------------------------------------------
1900 subroutine set_matrices
1901 implicit real*8 (a-h,o-z)
1902 include 'DIMENSIONS'
1903 include 'sizesclu.dat'
1904 include 'COMMON.IOUNITS'
1905 include 'COMMON.GEO'
1906 include 'COMMON.VAR'
1907 include 'COMMON.LOCAL'
1908 include 'COMMON.CHAIN'
1909 include 'COMMON.DERIV'
1910 include 'COMMON.INTERACT'
1911 include 'COMMON.CONTACTS'
1912 include 'COMMON.TORSION'
1913 include 'COMMON.VECTORS'
1914 include 'COMMON.FFIELD'
1915 double precision auxvec(2),auxmat(2,2)
1917 C Compute the virtual-bond-torsional-angle dependent quantities needed
1918 C to calculate the el-loc multibody terms of various order.
1921 if (i .lt. nres+1) then
1958 if (i .gt. 3 .and. i .lt. nres+1) then
1959 obrot_der(1,i-2)=-sin1
1960 obrot_der(2,i-2)= cos1
1961 Ugder(1,1,i-2)= sin1
1962 Ugder(1,2,i-2)=-cos1
1963 Ugder(2,1,i-2)=-cos1
1964 Ugder(2,2,i-2)=-sin1
1967 obrot2_der(1,i-2)=-dwasin2
1968 obrot2_der(2,i-2)= dwacos2
1969 Ug2der(1,1,i-2)= dwasin2
1970 Ug2der(1,2,i-2)=-dwacos2
1971 Ug2der(2,1,i-2)=-dwacos2
1972 Ug2der(2,2,i-2)=-dwasin2
1974 obrot_der(1,i-2)=0.0d0
1975 obrot_der(2,i-2)=0.0d0
1976 Ugder(1,1,i-2)=0.0d0
1977 Ugder(1,2,i-2)=0.0d0
1978 Ugder(2,1,i-2)=0.0d0
1979 Ugder(2,2,i-2)=0.0d0
1980 obrot2_der(1,i-2)=0.0d0
1981 obrot2_der(2,i-2)=0.0d0
1982 Ug2der(1,1,i-2)=0.0d0
1983 Ug2der(1,2,i-2)=0.0d0
1984 Ug2der(2,1,i-2)=0.0d0
1985 Ug2der(2,2,i-2)=0.0d0
1987 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1988 if (itype(i-2).le.ntyp) then
1989 iti = itortyp(itype(i-2))
1996 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1997 if (itype(i-1).le.ntyp) then
1998 iti1 = itortyp(itype(i-1))
2005 cd write (iout,*) '*******i',i,' iti1',iti
2006 cd write (iout,*) 'b1',b1(:,iti)
2007 cd write (iout,*) 'b2',b2(:,iti)
2008 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2009 c print *,"itilde1 i iti iti1",i,iti,iti1
2010 if (i .gt. iatel_s+2) then
2011 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2012 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2013 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2014 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2015 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2016 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2017 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2027 DtUg2(l,k,i-2)=0.0d0
2031 c print *,"itilde2 i iti iti1",i,iti,iti1
2032 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2033 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2034 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2035 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2036 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2037 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2038 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2039 c print *,"itilde3 i iti iti1",i,iti,iti1
2041 muder(k,i-2)=Ub2der(k,i-2)
2043 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2044 if (itype(i-1).le.ntyp) then
2045 iti1 = itortyp(itype(i-1))
2053 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2055 C Vectors and matrices dependent on a single virtual-bond dihedral.
2056 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2057 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2058 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2059 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2060 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2061 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2062 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2063 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2064 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2065 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2066 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2068 C Matrices dependent on two consecutive virtual-bond dihedrals.
2069 C The order of matrices is from left to right.
2071 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2072 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2073 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2074 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2075 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2076 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2077 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2078 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2081 cd iti = itortyp(itype(i))
2084 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2085 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2090 C--------------------------------------------------------------------------
2091 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2093 C This subroutine calculates the average interaction energy and its gradient
2094 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2095 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2096 C The potential depends both on the distance of peptide-group centers and on
2097 C the orientation of the CA-CA virtual bonds.
2099 implicit real*8 (a-h,o-z)
2100 include 'DIMENSIONS'
2101 include 'sizesclu.dat'
2102 include 'COMMON.CONTROL'
2103 include 'COMMON.IOUNITS'
2104 include 'COMMON.GEO'
2105 include 'COMMON.VAR'
2106 include 'COMMON.LOCAL'
2107 include 'COMMON.CHAIN'
2108 include 'COMMON.DERIV'
2109 include 'COMMON.INTERACT'
2110 include 'COMMON.CONTACTS'
2111 include 'COMMON.TORSION'
2112 include 'COMMON.VECTORS'
2113 include 'COMMON.FFIELD'
2114 include 'COMMON.SHIELD'
2116 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2117 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2118 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2119 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2120 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2121 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2122 double precision scal_el /0.5d0/
2124 C 13-go grudnia roku pamietnego...
2125 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2126 & 0.0d0,1.0d0,0.0d0,
2127 & 0.0d0,0.0d0,1.0d0/
2128 cd write(iout,*) 'In EELEC'
2130 cd write(iout,*) 'Type',i
2131 cd write(iout,*) 'B1',B1(:,i)
2132 cd write(iout,*) 'B2',B2(:,i)
2133 cd write(iout,*) 'CC',CC(:,:,i)
2134 cd write(iout,*) 'DD',DD(:,:,i)
2135 cd write(iout,*) 'EE',EE(:,:,i)
2137 cd call check_vecgrad
2139 if (icheckgrad.eq.1) then
2141 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2143 dc_norm(k,i)=dc(k,i)*fac
2145 c write (iout,*) 'i',i,' fac',fac
2148 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2149 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2150 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2151 cd if (wel_loc.gt.0.0d0) then
2152 if (icheckgrad.eq.1) then
2153 call vec_and_deriv_test
2160 cd write (iout,*) 'i=',i
2162 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2165 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2166 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2179 cd print '(a)','Enter EELEC'
2180 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2182 gel_loc_loc(i)=0.0d0
2185 do i=iatel_s,iatel_e
2187 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2188 C & .or. itype(i+2).eq.ntyp1) cycle
2190 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2191 C & .or. itype(i+2).eq.ntyp1
2192 C & .or. itype(i-1).eq.ntyp1
2195 if (itel(i).eq.0) goto 1215
2199 dx_normi=dc_norm(1,i)
2200 dy_normi=dc_norm(2,i)
2201 dz_normi=dc_norm(3,i)
2202 xmedi=c(1,i)+0.5d0*dxi
2203 ymedi=c(2,i)+0.5d0*dyi
2204 zmedi=c(3,i)+0.5d0*dzi
2205 xmedi=mod(xmedi,boxxsize)
2206 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2207 ymedi=mod(ymedi,boxysize)
2208 if (ymedi.lt.0) ymedi=ymedi+boxysize
2209 zmedi=mod(zmedi,boxzsize)
2210 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2212 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2213 do j=ielstart(i),ielend(i)
2215 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2216 C & .or.itype(j+2).eq.ntyp1
2219 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2220 C & .or.itype(j+2).eq.ntyp1
2221 C & .or.itype(j-1).eq.ntyp1
2224 if (itel(j).eq.0) goto 1216
2228 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2229 aaa=app(iteli,itelj)
2230 bbb=bpp(iteli,itelj)
2231 C Diagnostics only!!!
2237 ael6i=ael6(iteli,itelj)
2238 ael3i=ael3(iteli,itelj)
2242 dx_normj=dc_norm(1,j)
2243 dy_normj=dc_norm(2,j)
2244 dz_normj=dc_norm(3,j)
2249 if (xj.lt.0) xj=xj+boxxsize
2251 if (yj.lt.0) yj=yj+boxysize
2253 if (zj.lt.0) zj=zj+boxzsize
2254 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2262 xj=xj_safe+xshift*boxxsize
2263 yj=yj_safe+yshift*boxysize
2264 zj=zj_safe+zshift*boxzsize
2265 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2266 if(dist_temp.lt.dist_init) then
2276 if (isubchap.eq.1) then
2286 rij=xj*xj+yj*yj+zj*zj
2287 sss=sscale(sqrt(rij))
2288 sssgrad=sscagrad(sqrt(rij))
2294 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2295 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2296 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2297 fac=cosa-3.0D0*cosb*cosg
2299 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2300 if (j.eq.i+2) ev1=scal_el*ev1
2305 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2308 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2309 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2310 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2311 if (shield_mode.gt.0) then
2316 write(iout,*) "ees_compon",i,j,el1,el2,
2317 & fac_shield(i),fac_shield(j)
2320 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2321 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2331 evdw1=evdw1+evdwij*sss
2332 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2333 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2334 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2335 cd & xmedi,ymedi,zmedi,xj,yj,zj
2337 C Calculate contributions to the Cartesian gradient.
2340 facvdw=-6*rrmij*(ev1+evdwij)*sss
2341 facel=-3*rrmij*(el1+eesij)
2348 * Radial derivatives. First process both termini of the fragment (i,j)
2354 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2355 & (shield_mode.gt.0)) then
2357 do ilist=1,ishield_list(i)
2358 iresshield=shield_list(ilist,i)
2360 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2362 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2364 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2365 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2366 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2367 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2368 C if (iresshield.gt.i) then
2369 C do ishi=i+1,iresshield-1
2370 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2371 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2375 C do ishi=iresshield,i
2376 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2377 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2385 do ilist=1,ishield_list(j)
2386 iresshield=shield_list(ilist,j)
2388 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2390 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2392 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2393 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2398 gshieldc(k,i)=gshieldc(k,i)+
2399 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2400 gshieldc(k,j)=gshieldc(k,j)+
2401 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2402 gshieldc(k,i-1)=gshieldc(k,i-1)+
2403 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2404 gshieldc(k,j-1)=gshieldc(k,j-1)+
2405 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2412 gelc(k,i)=gelc(k,i)+ghalf
2413 gelc(k,j)=gelc(k,j)+ghalf
2416 * Loop over residues i+1 thru j-1.
2420 gelc(l,k)=gelc(l,k)+ggg(l)
2426 if (sss.gt.0.0) then
2427 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2428 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2429 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2437 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2438 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2441 * Loop over residues i+1 thru j-1.
2445 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2449 facvdw=(ev1+evdwij)*sss
2452 fac=-3*rrmij*(facvdw+facvdw+facel)
2458 * Radial derivatives. First process both termini of the fragment (i,j)
2465 gelc(k,i)=gelc(k,i)+ghalf
2466 gelc(k,j)=gelc(k,j)+ghalf
2469 * Loop over residues i+1 thru j-1.
2473 gelc(l,k)=gelc(l,k)+ggg(l)
2480 ecosa=2.0D0*fac3*fac1+fac4
2483 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2484 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2486 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2487 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2489 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2490 cd & (dcosg(k),k=1,3)
2492 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2493 & *fac_shield(i)**2*fac_shield(j)**2
2497 gelc(k,i)=gelc(k,i)+ghalf
2498 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2499 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2500 & *fac_shield(i)**2*fac_shield(j)**2
2502 gelc(k,j)=gelc(k,j)+ghalf
2503 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2504 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2505 & *fac_shield(i)**2*fac_shield(j)**2
2509 gelc(l,k)=gelc(l,k)+ggg(l)
2514 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2515 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2516 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2518 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2519 C energy of a peptide unit is assumed in the form of a second-order
2520 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2521 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2522 C are computed for EVERY pair of non-contiguous peptide groups.
2524 if (j.lt.nres-1) then
2535 muij(kkk)=mu(k,i)*mu(l,j)
2538 cd write (iout,*) 'EELEC: i',i,' j',j
2539 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2540 cd write(iout,*) 'muij',muij
2541 ury=scalar(uy(1,i),erij)
2542 urz=scalar(uz(1,i),erij)
2543 vry=scalar(uy(1,j),erij)
2544 vrz=scalar(uz(1,j),erij)
2545 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2546 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2547 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2548 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2549 C For diagnostics only
2554 fac=dsqrt(-ael6i)*r3ij
2555 cd write (2,*) 'fac=',fac
2556 C For diagnostics only
2562 cd write (iout,'(4i5,4f10.5)')
2563 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2564 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2565 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2566 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2567 cd write (iout,'(4f10.5)')
2568 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2569 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2570 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2571 cd write (iout,'(2i3,9f10.5/)') i,j,
2572 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2574 C Derivatives of the elements of A in virtual-bond vectors
2575 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2582 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2583 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2584 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2585 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2586 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2587 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2588 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2589 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2590 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2591 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2592 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2593 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2603 C Compute radial contributions to the gradient
2625 C Add the contributions coming from er
2628 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2629 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2630 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2631 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2634 C Derivatives in DC(i)
2635 ghalf1=0.5d0*agg(k,1)
2636 ghalf2=0.5d0*agg(k,2)
2637 ghalf3=0.5d0*agg(k,3)
2638 ghalf4=0.5d0*agg(k,4)
2639 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2640 & -3.0d0*uryg(k,2)*vry)+ghalf1
2641 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2642 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2643 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2644 & -3.0d0*urzg(k,2)*vry)+ghalf3
2645 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2646 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2647 C Derivatives in DC(i+1)
2648 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2649 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2650 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2651 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2652 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2653 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2654 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2655 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2656 C Derivatives in DC(j)
2657 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2658 & -3.0d0*vryg(k,2)*ury)+ghalf1
2659 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2660 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2661 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2662 & -3.0d0*vryg(k,2)*urz)+ghalf3
2663 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2664 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2665 C Derivatives in DC(j+1) or DC(nres-1)
2666 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2667 & -3.0d0*vryg(k,3)*ury)
2668 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2669 & -3.0d0*vrzg(k,3)*ury)
2670 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2671 & -3.0d0*vryg(k,3)*urz)
2672 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2673 & -3.0d0*vrzg(k,3)*urz)
2678 C Derivatives in DC(i+1)
2679 cd aggi1(k,1)=agg(k,1)
2680 cd aggi1(k,2)=agg(k,2)
2681 cd aggi1(k,3)=agg(k,3)
2682 cd aggi1(k,4)=agg(k,4)
2683 C Derivatives in DC(j)
2688 C Derivatives in DC(j+1)
2693 if (j.eq.nres-1 .and. i.lt.j-2) then
2695 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2696 cd aggj1(k,l)=agg(k,l)
2702 C Check the loc-el terms by numerical integration
2712 aggi(k,l)=-aggi(k,l)
2713 aggi1(k,l)=-aggi1(k,l)
2714 aggj(k,l)=-aggj(k,l)
2715 aggj1(k,l)=-aggj1(k,l)
2718 if (j.lt.nres-1) then
2724 aggi(k,l)=-aggi(k,l)
2725 aggi1(k,l)=-aggi1(k,l)
2726 aggj(k,l)=-aggj(k,l)
2727 aggj1(k,l)=-aggj1(k,l)
2738 aggi(k,l)=-aggi(k,l)
2739 aggi1(k,l)=-aggi1(k,l)
2740 aggj(k,l)=-aggj(k,l)
2741 aggj1(k,l)=-aggj1(k,l)
2747 IF (wel_loc.gt.0.0d0) THEN
2748 C Contribution to the local-electrostatic energy coming from the i-j pair
2749 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2751 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2752 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2753 if (shield_mode.eq.0) then
2760 eel_loc_ij=eel_loc_ij
2761 & *fac_shield(i)*fac_shield(j)
2762 eel_loc=eel_loc+eel_loc_ij
2763 C Partial derivatives in virtual-bond dihedral angles gamma
2765 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2766 & (shield_mode.gt.0)) then
2769 do ilist=1,ishield_list(i)
2770 iresshield=shield_list(ilist,i)
2772 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2775 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2777 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2778 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2782 do ilist=1,ishield_list(j)
2783 iresshield=shield_list(ilist,j)
2785 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2788 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2790 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2791 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2797 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2798 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2799 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2800 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2801 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2802 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2803 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2804 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2808 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2809 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2810 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2811 & *fac_shield(i)*fac_shield(j)
2812 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2813 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2814 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2815 & *fac_shield(i)*fac_shield(j)
2817 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2818 cd write(iout,*) 'agg ',agg
2819 cd write(iout,*) 'aggi ',aggi
2820 cd write(iout,*) 'aggi1',aggi1
2821 cd write(iout,*) 'aggj ',aggj
2822 cd write(iout,*) 'aggj1',aggj1
2824 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2826 ggg(l)=agg(l,1)*muij(1)+
2827 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2828 & *fac_shield(i)*fac_shield(j)
2833 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2836 C Remaining derivatives of eello
2838 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2839 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2840 & *fac_shield(i)*fac_shield(j)
2842 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2843 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2844 & *fac_shield(i)*fac_shield(j)
2846 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2847 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2848 & *fac_shield(i)*fac_shield(j)
2850 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2851 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2852 & *fac_shield(i)*fac_shield(j)
2857 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2858 C Contributions from turns
2863 call eturn34(i,j,eello_turn3,eello_turn4)
2865 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2866 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2868 C Calculate the contact function. The ith column of the array JCONT will
2869 C contain the numbers of atoms that make contacts with the atom I (of numbers
2870 C greater than I). The arrays FACONT and GACONT will contain the values of
2871 C the contact function and its derivative.
2872 c r0ij=1.02D0*rpp(iteli,itelj)
2873 c r0ij=1.11D0*rpp(iteli,itelj)
2874 r0ij=2.20D0*rpp(iteli,itelj)
2875 c r0ij=1.55D0*rpp(iteli,itelj)
2876 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2877 if (fcont.gt.0.0D0) then
2878 num_conti=num_conti+1
2879 if (num_conti.gt.maxconts) then
2880 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2881 & ' will skip next contacts for this conf.'
2883 jcont_hb(num_conti,i)=j
2884 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2885 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2886 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2888 d_cont(num_conti,i)=rij
2889 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2890 C --- Electrostatic-interaction matrix ---
2891 a_chuj(1,1,num_conti,i)=a22
2892 a_chuj(1,2,num_conti,i)=a23
2893 a_chuj(2,1,num_conti,i)=a32
2894 a_chuj(2,2,num_conti,i)=a33
2895 C --- Gradient of rij
2897 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2900 c a_chuj(1,1,num_conti,i)=-0.61d0
2901 c a_chuj(1,2,num_conti,i)= 0.4d0
2902 c a_chuj(2,1,num_conti,i)= 0.65d0
2903 c a_chuj(2,2,num_conti,i)= 0.50d0
2904 c else if (i.eq.2) then
2905 c a_chuj(1,1,num_conti,i)= 0.0d0
2906 c a_chuj(1,2,num_conti,i)= 0.0d0
2907 c a_chuj(2,1,num_conti,i)= 0.0d0
2908 c a_chuj(2,2,num_conti,i)= 0.0d0
2910 C --- and its gradients
2911 cd write (iout,*) 'i',i,' j',j
2913 cd write (iout,*) 'iii 1 kkk',kkk
2914 cd write (iout,*) agg(kkk,:)
2917 cd write (iout,*) 'iii 2 kkk',kkk
2918 cd write (iout,*) aggi(kkk,:)
2921 cd write (iout,*) 'iii 3 kkk',kkk
2922 cd write (iout,*) aggi1(kkk,:)
2925 cd write (iout,*) 'iii 4 kkk',kkk
2926 cd write (iout,*) aggj(kkk,:)
2929 cd write (iout,*) 'iii 5 kkk',kkk
2930 cd write (iout,*) aggj1(kkk,:)
2937 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2938 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2939 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2940 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2941 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2943 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2949 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2950 C Calculate contact energies
2952 wij=cosa-3.0D0*cosb*cosg
2955 c fac3=dsqrt(-ael6i)/r0ij**3
2956 fac3=dsqrt(-ael6i)*r3ij
2957 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2958 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2959 if (shield_mode.eq.0) then
2963 ees0plist(num_conti,i)=j
2964 C fac_shield(i)=0.4d0
2965 C fac_shield(j)=0.6d0
2968 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2969 & *fac_shield(i)*fac_shield(j)
2971 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2972 & *fac_shield(i)*fac_shield(j)
2974 C Diagnostics. Comment out or remove after debugging!
2975 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2976 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2977 c ees0m(num_conti,i)=0.0D0
2979 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2980 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2981 facont_hb(num_conti,i)=fcont
2983 C Angular derivatives of the contact function
2984 ees0pij1=fac3/ees0pij
2985 ees0mij1=fac3/ees0mij
2986 fac3p=-3.0D0*fac3*rrmij
2987 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2988 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2990 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2991 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2992 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2993 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2994 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2995 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2996 ecosap=ecosa1+ecosa2
2997 ecosbp=ecosb1+ecosb2
2998 ecosgp=ecosg1+ecosg2
2999 ecosam=ecosa1-ecosa2
3000 ecosbm=ecosb1-ecosb2
3001 ecosgm=ecosg1-ecosg2
3010 fprimcont=fprimcont/rij
3011 cd facont_hb(num_conti,i)=1.0D0
3012 C Following line is for diagnostics.
3015 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3016 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3019 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3020 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3022 gggp(1)=gggp(1)+ees0pijp*xj
3023 gggp(2)=gggp(2)+ees0pijp*yj
3024 gggp(3)=gggp(3)+ees0pijp*zj
3025 gggm(1)=gggm(1)+ees0mijp*xj
3026 gggm(2)=gggm(2)+ees0mijp*yj
3027 gggm(3)=gggm(3)+ees0mijp*zj
3028 C Derivatives due to the contact function
3029 gacont_hbr(1,num_conti,i)=fprimcont*xj
3030 gacont_hbr(2,num_conti,i)=fprimcont*yj
3031 gacont_hbr(3,num_conti,i)=fprimcont*zj
3033 ghalfp=0.5D0*gggp(k)
3034 ghalfm=0.5D0*gggm(k)
3035 gacontp_hb1(k,num_conti,i)=ghalfp
3036 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3037 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3038 & *fac_shield(i)*fac_shield(j)
3040 gacontp_hb2(k,num_conti,i)=ghalfp
3041 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3042 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3043 & *fac_shield(i)*fac_shield(j)
3045 gacontp_hb3(k,num_conti,i)=gggp(k)
3046 & *fac_shield(i)*fac_shield(j)
3048 gacontm_hb1(k,num_conti,i)=ghalfm
3049 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3050 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3051 & *fac_shield(i)*fac_shield(j)
3053 gacontm_hb2(k,num_conti,i)=ghalfm
3054 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3055 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3056 & *fac_shield(i)*fac_shield(j)
3058 gacontm_hb3(k,num_conti,i)=gggm(k)
3059 & *fac_shield(i)*fac_shield(j)
3063 C Diagnostics. Comment out or remove after debugging!
3065 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3066 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3067 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3068 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3069 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3070 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3073 endif ! num_conti.le.maxconts
3078 num_cont_hb(i)=num_conti
3082 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3083 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3085 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3086 ccc eel_loc=eel_loc+eello_turn3
3089 C-----------------------------------------------------------------------------
3090 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3091 C Third- and fourth-order contributions from turns
3092 implicit real*8 (a-h,o-z)
3093 include 'DIMENSIONS'
3094 include 'sizesclu.dat'
3095 include 'COMMON.IOUNITS'
3096 include 'COMMON.GEO'
3097 include 'COMMON.VAR'
3098 include 'COMMON.LOCAL'
3099 include 'COMMON.CHAIN'
3100 include 'COMMON.DERIV'
3101 include 'COMMON.INTERACT'
3102 include 'COMMON.CONTACTS'
3103 include 'COMMON.TORSION'
3104 include 'COMMON.VECTORS'
3105 include 'COMMON.FFIELD'
3106 include 'COMMON.SHIELD'
3107 include 'COMMON.CONTROL'
3110 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3111 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3112 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3113 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3114 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3115 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3117 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3118 C changes suggested by Ana to avoid out of bounds
3119 C & .or.((i+5).gt.nres)
3120 C & .or.((i-1).le.0)
3121 C end of changes suggested by Ana
3122 & .or. itype(i+2).eq.ntyp1
3123 & .or. itype(i+3).eq.ntyp1
3124 C & .or. itype(i+5).eq.ntyp1
3125 C & .or. itype(i).eq.ntyp1
3126 C & .or. itype(i-1).eq.ntyp1
3129 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3131 C Third-order contributions
3138 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3139 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3140 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3141 call transpose2(auxmat(1,1),auxmat1(1,1))
3142 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3143 if (shield_mode.eq.0) then
3150 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3151 & *fac_shield(i)*fac_shield(j)
3152 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3153 & *fac_shield(i)*fac_shield(j)
3155 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3156 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3157 cd & ' eello_turn3_num',4*eello_turn3_num
3159 C Derivatives in shield mode
3160 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3161 & (shield_mode.gt.0)) then
3164 do ilist=1,ishield_list(i)
3165 iresshield=shield_list(ilist,i)
3167 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3169 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3171 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3172 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3176 do ilist=1,ishield_list(j)
3177 iresshield=shield_list(ilist,j)
3179 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3181 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3183 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3184 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3191 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3192 & grad_shield(k,i)*eello_t3/fac_shield(i)
3193 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3194 & grad_shield(k,j)*eello_t3/fac_shield(j)
3195 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3196 & grad_shield(k,i)*eello_t3/fac_shield(i)
3197 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3198 & grad_shield(k,j)*eello_t3/fac_shield(j)
3202 C Derivatives in gamma(i)
3203 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3204 call transpose2(auxmat2(1,1),pizda(1,1))
3205 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3206 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3207 & *fac_shield(i)*fac_shield(j)
3209 C Derivatives in gamma(i+1)
3210 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3211 call transpose2(auxmat2(1,1),pizda(1,1))
3212 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3213 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3214 & +0.5d0*(pizda(1,1)+pizda(2,2))
3215 & *fac_shield(i)*fac_shield(j)
3217 C Cartesian derivatives
3219 a_temp(1,1)=aggi(l,1)
3220 a_temp(1,2)=aggi(l,2)
3221 a_temp(2,1)=aggi(l,3)
3222 a_temp(2,2)=aggi(l,4)
3223 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3224 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3225 & +0.5d0*(pizda(1,1)+pizda(2,2))
3226 & *fac_shield(i)*fac_shield(j)
3228 a_temp(1,1)=aggi1(l,1)
3229 a_temp(1,2)=aggi1(l,2)
3230 a_temp(2,1)=aggi1(l,3)
3231 a_temp(2,2)=aggi1(l,4)
3232 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3233 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3234 & +0.5d0*(pizda(1,1)+pizda(2,2))
3235 & *fac_shield(i)*fac_shield(j)
3237 a_temp(1,1)=aggj(l,1)
3238 a_temp(1,2)=aggj(l,2)
3239 a_temp(2,1)=aggj(l,3)
3240 a_temp(2,2)=aggj(l,4)
3241 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3242 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3243 & +0.5d0*(pizda(1,1)+pizda(2,2))
3244 & *fac_shield(i)*fac_shield(j)
3246 a_temp(1,1)=aggj1(l,1)
3247 a_temp(1,2)=aggj1(l,2)
3248 a_temp(2,1)=aggj1(l,3)
3249 a_temp(2,2)=aggj1(l,4)
3250 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3251 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3252 & +0.5d0*(pizda(1,1)+pizda(2,2))
3253 & *fac_shield(i)*fac_shield(j)
3258 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3259 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3260 C changes suggested by Ana to avoid out of bounds
3261 C & .or.((i+5).gt.nres)
3262 C & .or.((i-1).le.0)
3263 C end of changes suggested by Ana
3264 & .or. itype(i+3).eq.ntyp1
3265 & .or. itype(i+4).eq.ntyp1
3266 C & .or. itype(i+5).eq.ntyp1
3267 & .or. itype(i).eq.ntyp1
3268 C & .or. itype(i-1).eq.ntyp1
3271 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3273 C Fourth-order contributions
3281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3282 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3283 iti1=itortyp(itype(i+1))
3284 iti2=itortyp(itype(i+2))
3285 iti3=itortyp(itype(i+3))
3286 call transpose2(EUg(1,1,i+1),e1t(1,1))
3287 call transpose2(Eug(1,1,i+2),e2t(1,1))
3288 call transpose2(Eug(1,1,i+3),e3t(1,1))
3289 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3290 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3291 s1=scalar2(b1(1,iti2),auxvec(1))
3292 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3293 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3294 s2=scalar2(b1(1,iti1),auxvec(1))
3295 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3296 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3297 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3298 if (shield_mode.eq.0) then
3305 eello_turn4=eello_turn4-(s1+s2+s3)
3306 & *fac_shield(i)*fac_shield(j)
3307 eello_t4=-(s1+s2+s3)
3308 & *fac_shield(i)*fac_shield(j)
3310 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3311 cd & ' eello_turn4_num',8*eello_turn4_num
3312 C Derivatives in gamma(i)
3314 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3315 & (shield_mode.gt.0)) then
3318 do ilist=1,ishield_list(i)
3319 iresshield=shield_list(ilist,i)
3321 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3323 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3325 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3326 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3330 do ilist=1,ishield_list(j)
3331 iresshield=shield_list(ilist,j)
3333 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3335 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3337 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3338 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3345 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3346 & grad_shield(k,i)*eello_t4/fac_shield(i)
3347 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3348 & grad_shield(k,j)*eello_t4/fac_shield(j)
3349 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3350 & grad_shield(k,i)*eello_t4/fac_shield(i)
3351 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3352 & grad_shield(k,j)*eello_t4/fac_shield(j)
3356 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3357 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3358 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3359 s1=scalar2(b1(1,iti2),auxvec(1))
3360 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3361 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3362 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3363 & *fac_shield(i)*fac_shield(j)
3365 C Derivatives in gamma(i+1)
3366 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3367 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3368 s2=scalar2(b1(1,iti1),auxvec(1))
3369 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3370 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3371 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3372 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3373 & *fac_shield(i)*fac_shield(j)
3375 C Derivatives in gamma(i+2)
3376 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3377 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3378 s1=scalar2(b1(1,iti2),auxvec(1))
3379 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3380 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3381 s2=scalar2(b1(1,iti1),auxvec(1))
3382 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3383 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3384 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3385 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3386 & *fac_shield(i)*fac_shield(j)
3388 C Cartesian derivatives
3389 C Derivatives of this turn contributions in DC(i+2)
3390 if (j.lt.nres-1) then
3392 a_temp(1,1)=agg(l,1)
3393 a_temp(1,2)=agg(l,2)
3394 a_temp(2,1)=agg(l,3)
3395 a_temp(2,2)=agg(l,4)
3396 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3397 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3398 s1=scalar2(b1(1,iti2),auxvec(1))
3399 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3400 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3401 s2=scalar2(b1(1,iti1),auxvec(1))
3402 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3403 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3404 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3406 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3407 & *fac_shield(i)*fac_shield(j)
3411 C Remaining derivatives of this turn contribution
3413 a_temp(1,1)=aggi(l,1)
3414 a_temp(1,2)=aggi(l,2)
3415 a_temp(2,1)=aggi(l,3)
3416 a_temp(2,2)=aggi(l,4)
3417 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3418 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3419 s1=scalar2(b1(1,iti2),auxvec(1))
3420 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3421 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3422 s2=scalar2(b1(1,iti1),auxvec(1))
3423 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3424 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3425 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3426 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3427 & *fac_shield(i)*fac_shield(j)
3429 a_temp(1,1)=aggi1(l,1)
3430 a_temp(1,2)=aggi1(l,2)
3431 a_temp(2,1)=aggi1(l,3)
3432 a_temp(2,2)=aggi1(l,4)
3433 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3434 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3435 s1=scalar2(b1(1,iti2),auxvec(1))
3436 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3437 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3438 s2=scalar2(b1(1,iti1),auxvec(1))
3439 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3440 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3441 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3442 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3443 & *fac_shield(i)*fac_shield(j)
3445 a_temp(1,1)=aggj(l,1)
3446 a_temp(1,2)=aggj(l,2)
3447 a_temp(2,1)=aggj(l,3)
3448 a_temp(2,2)=aggj(l,4)
3449 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3450 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3451 s1=scalar2(b1(1,iti2),auxvec(1))
3452 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3453 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3454 s2=scalar2(b1(1,iti1),auxvec(1))
3455 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3456 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3457 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3458 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3459 & *fac_shield(i)*fac_shield(j)
3461 a_temp(1,1)=aggj1(l,1)
3462 a_temp(1,2)=aggj1(l,2)
3463 a_temp(2,1)=aggj1(l,3)
3464 a_temp(2,2)=aggj1(l,4)
3465 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3466 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3467 s1=scalar2(b1(1,iti2),auxvec(1))
3468 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3469 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3470 s2=scalar2(b1(1,iti1),auxvec(1))
3471 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3472 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3473 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3474 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3475 & *fac_shield(i)*fac_shield(j)
3483 C-----------------------------------------------------------------------------
3484 subroutine vecpr(u,v,w)
3485 implicit real*8(a-h,o-z)
3486 dimension u(3),v(3),w(3)
3487 w(1)=u(2)*v(3)-u(3)*v(2)
3488 w(2)=-u(1)*v(3)+u(3)*v(1)
3489 w(3)=u(1)*v(2)-u(2)*v(1)
3492 C-----------------------------------------------------------------------------
3493 subroutine unormderiv(u,ugrad,unorm,ungrad)
3494 C This subroutine computes the derivatives of a normalized vector u, given
3495 C the derivatives computed without normalization conditions, ugrad. Returns
3498 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3499 double precision vec(3)
3500 double precision scalar
3502 c write (2,*) 'ugrad',ugrad
3505 vec(i)=scalar(ugrad(1,i),u(1))
3507 c write (2,*) 'vec',vec
3510 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3513 c write (2,*) 'ungrad',ungrad
3516 C-----------------------------------------------------------------------------
3517 subroutine escp(evdw2,evdw2_14)
3519 C This subroutine calculates the excluded-volume interaction energy between
3520 C peptide-group centers and side chains and its gradient in virtual-bond and
3521 C side-chain vectors.
3523 implicit real*8 (a-h,o-z)
3524 include 'DIMENSIONS'
3525 include 'sizesclu.dat'
3526 include 'COMMON.GEO'
3527 include 'COMMON.VAR'
3528 include 'COMMON.LOCAL'
3529 include 'COMMON.CHAIN'
3530 include 'COMMON.DERIV'
3531 include 'COMMON.INTERACT'
3532 include 'COMMON.FFIELD'
3533 include 'COMMON.IOUNITS'
3537 cd print '(a)','Enter ESCP'
3538 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3539 c & ' scal14',scal14
3540 do i=iatscp_s,iatscp_e
3541 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3543 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3544 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3545 if (iteli.eq.0) goto 1225
3546 xi=0.5D0*(c(1,i)+c(1,i+1))
3547 yi=0.5D0*(c(2,i)+c(2,i+1))
3548 zi=0.5D0*(c(3,i)+c(3,i+1))
3549 C Returning the ith atom to box
3551 if (xi.lt.0) xi=xi+boxxsize
3553 if (yi.lt.0) yi=yi+boxysize
3555 if (zi.lt.0) zi=zi+boxzsize
3557 do iint=1,nscp_gr(i)
3559 do j=iscpstart(i,iint),iscpend(i,iint)
3560 itypj=iabs(itype(j))
3561 if (itypj.eq.ntyp1) cycle
3562 C Uncomment following three lines for SC-p interactions
3566 C Uncomment following three lines for Ca-p interactions
3570 C returning the jth atom to box
3572 if (xj.lt.0) xj=xj+boxxsize
3574 if (yj.lt.0) yj=yj+boxysize
3576 if (zj.lt.0) zj=zj+boxzsize
3577 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3582 C Finding the closest jth atom
3586 xj=xj_safe+xshift*boxxsize
3587 yj=yj_safe+yshift*boxysize
3588 zj=zj_safe+zshift*boxzsize
3589 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3590 if(dist_temp.lt.dist_init) then
3600 if (subchap.eq.1) then
3610 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3611 C sss is scaling function for smoothing the cutoff gradient otherwise
3612 C the gradient would not be continuouse
3613 sss=sscale(1.0d0/(dsqrt(rrij)))
3614 if (sss.le.0.0d0) cycle
3615 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3617 e1=fac*fac*aad(itypj,iteli)
3618 e2=fac*bad(itypj,iteli)
3619 if (iabs(j-i) .le. 2) then
3622 evdw2_14=evdw2_14+(e1+e2)*sss
3625 c write (iout,*) i,j,evdwij
3626 evdw2=evdw2+evdwij*sss
3629 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3631 fac=-(evdwij+e1)*rrij*sss
3632 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3637 cd write (iout,*) 'j<i'
3638 C Uncomment following three lines for SC-p interactions
3640 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3643 cd write (iout,*) 'j>i'
3646 C Uncomment following line for SC-p interactions
3647 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3651 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3655 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3656 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3659 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3669 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3670 gradx_scp(j,i)=expon*gradx_scp(j,i)
3673 C******************************************************************************
3677 C To save time the factor EXPON has been extracted from ALL components
3678 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3681 C******************************************************************************
3684 C--------------------------------------------------------------------------
3685 subroutine edis(ehpb)
3687 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3689 implicit real*8 (a-h,o-z)
3690 include 'DIMENSIONS'
3691 include 'sizesclu.dat'
3692 include 'COMMON.SBRIDGE'
3693 include 'COMMON.CHAIN'
3694 include 'COMMON.DERIV'
3695 include 'COMMON.VAR'
3696 include 'COMMON.INTERACT'
3697 include 'COMMON.CONTROL'
3700 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3701 cd print *,'link_start=',link_start,' link_end=',link_end
3702 if (link_end.eq.0) return
3703 do i=link_start,link_end
3704 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3705 C CA-CA distance used in regularization of structure.
3708 C iii and jjj point to the residues for which the distance is assigned.
3709 if (ii.gt.nres) then
3716 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3717 C distance and angle dependent SS bond potential.
3718 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3719 C & iabs(itype(jjj)).eq.1) then
3720 C call ssbond_ene(iii,jjj,eij)
3723 if (.not.dyn_ss .and. i.le.nss) then
3724 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3725 & iabs(itype(jjj)).eq.1) then
3726 call ssbond_ene(iii,jjj,eij)
3729 else if (ii.gt.nres .and. jj.gt.nres) then
3730 c Restraints from contact prediction
3732 if (constr_dist.eq.11) then
3733 C ehpb=ehpb+fordepth(i)**4.0d0
3734 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3735 ehpb=ehpb+fordepth(i)**4.0d0
3736 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3737 fac=fordepth(i)**4.0d0
3738 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3739 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3740 C & ehpb,fordepth(i),dd
3742 C write(iout,*) ehpb,"atu?"
3744 C fac=fordepth(i)**4.0d0
3745 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3746 else !constr_dist.eq.11
3747 if (dhpb1(i).gt.0.0d0) then
3748 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3749 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3750 c write (iout,*) "beta nmr",
3751 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3752 else !dhpb(i).gt.0.00
3754 C Calculate the distance between the two points and its difference from the
3758 C Get the force constant corresponding to this distance.
3760 C Calculate the contribution to energy.
3761 ehpb=ehpb+waga*rdis*rdis
3763 C Evaluate gradient.
3768 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3769 cd & ' waga=',waga,' fac=',fac
3771 ggg(j)=fac*(c(j,jj)-c(j,ii))
3773 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3774 C If this is a SC-SC distance, we need to calculate the contributions to the
3775 C Cartesian gradient in the SC vectors (ghpbx).
3778 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3779 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3783 C write(iout,*) "before"
3785 C write(iout,*) "after",dd
3786 if (constr_dist.eq.11) then
3787 ehpb=ehpb+fordepth(i)**4.0d0
3788 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3789 fac=fordepth(i)**4.0d0
3790 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3791 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3792 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3793 C print *,ehpb,"tu?"
3794 C write(iout,*) ehpb,"btu?",
3795 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3796 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3797 C & ehpb,fordepth(i),dd
3799 if (dhpb1(i).gt.0.0d0) then
3800 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3801 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3802 c write (iout,*) "alph nmr",
3803 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3806 C Get the force constant corresponding to this distance.
3808 C Calculate the contribution to energy.
3809 ehpb=ehpb+waga*rdis*rdis
3810 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3812 C Evaluate gradient.
3818 ggg(j)=fac*(c(j,jj)-c(j,ii))
3820 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3821 C If this is a SC-SC distance, we need to calculate the contributions to the
3822 C Cartesian gradient in the SC vectors (ghpbx).
3825 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3826 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3831 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3836 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3839 C--------------------------------------------------------------------------
3840 subroutine ssbond_ene(i,j,eij)
3842 C Calculate the distance and angle dependent SS-bond potential energy
3843 C using a free-energy function derived based on RHF/6-31G** ab initio
3844 C calculations of diethyl disulfide.
3846 C A. Liwo and U. Kozlowska, 11/24/03
3848 implicit real*8 (a-h,o-z)
3849 include 'DIMENSIONS'
3850 include 'sizesclu.dat'
3851 include 'COMMON.SBRIDGE'
3852 include 'COMMON.CHAIN'
3853 include 'COMMON.DERIV'
3854 include 'COMMON.LOCAL'
3855 include 'COMMON.INTERACT'
3856 include 'COMMON.VAR'
3857 include 'COMMON.IOUNITS'
3858 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3859 itypi=iabs(itype(i))
3863 dxi=dc_norm(1,nres+i)
3864 dyi=dc_norm(2,nres+i)
3865 dzi=dc_norm(3,nres+i)
3866 dsci_inv=dsc_inv(itypi)
3867 itypj=iabs(itype(j))
3868 dscj_inv=dsc_inv(itypj)
3872 dxj=dc_norm(1,nres+j)
3873 dyj=dc_norm(2,nres+j)
3874 dzj=dc_norm(3,nres+j)
3875 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3880 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3881 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3882 om12=dxi*dxj+dyi*dyj+dzi*dzj
3884 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3885 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3891 deltat12=om2-om1+2.0d0
3893 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3894 & +akct*deltad*deltat12
3895 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3896 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3897 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3898 c & " deltat12",deltat12," eij",eij
3899 ed=2*akcm*deltad+akct*deltat12
3901 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3902 eom1=-2*akth*deltat1-pom1-om2*pom2
3903 eom2= 2*akth*deltat2+pom1-om1*pom2
3906 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3909 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3910 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3911 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3912 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3915 C Calculate the components of the gradient in DC and X
3919 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3924 C--------------------------------------------------------------------------
3925 subroutine ebond(estr)
3927 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3929 implicit real*8 (a-h,o-z)
3930 include 'DIMENSIONS'
3931 include 'sizesclu.dat'
3932 include 'COMMON.LOCAL'
3933 include 'COMMON.GEO'
3934 include 'COMMON.INTERACT'
3935 include 'COMMON.DERIV'
3936 include 'COMMON.VAR'
3937 include 'COMMON.CHAIN'
3938 include 'COMMON.IOUNITS'
3939 include 'COMMON.NAMES'
3940 include 'COMMON.FFIELD'
3941 include 'COMMON.CONTROL'
3942 logical energy_dec /.false./
3943 double precision u(3),ud(3)
3947 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3948 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3950 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3951 C & *dc(j,i-1)/vbld(i)
3953 C if (energy_dec) write(iout,*)
3954 C & "estr1",i,vbld(i),distchainmax,
3955 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3957 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3958 diff = vbld(i)-vbldpDUM
3960 diff = vbld(i)-vbldp0
3961 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3965 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3968 C write (iout,'(a7,i5,4f7.3)')
3969 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3971 estr=0.5d0*AKP*estr+estr1
3973 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3977 if (iti.ne.10 .and. iti.ne.ntyp1) then
3980 diff=vbld(i+nres)-vbldsc0(1,iti)
3981 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3982 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3983 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3985 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3989 diff=vbld(i+nres)-vbldsc0(j,iti)
3990 ud(j)=aksc(j,iti)*diff
3991 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4005 uprod2=uprod2*u(k)*u(k)
4009 usumsqder=usumsqder+ud(j)*uprod2
4011 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4012 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4013 estr=estr+uprod/usum
4015 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4023 C--------------------------------------------------------------------------
4024 subroutine ebend(etheta,ethetacnstr)
4026 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4027 C angles gamma and its derivatives in consecutive thetas and gammas.
4029 implicit real*8 (a-h,o-z)
4030 include 'DIMENSIONS'
4031 include 'sizesclu.dat'
4032 include 'COMMON.LOCAL'
4033 include 'COMMON.GEO'
4034 include 'COMMON.INTERACT'
4035 include 'COMMON.DERIV'
4036 include 'COMMON.VAR'
4037 include 'COMMON.CHAIN'
4038 include 'COMMON.IOUNITS'
4039 include 'COMMON.NAMES'
4040 include 'COMMON.FFIELD'
4041 include 'COMMON.TORCNSTR'
4042 common /calcthet/ term1,term2,termm,diffak,ratak,
4043 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4044 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4045 double precision y(2),z(2)
4047 c time11=dexp(-2*time)
4050 c write (iout,*) "nres",nres
4051 c write (*,'(a,i2)') 'EBEND ICG=',icg
4052 c write (iout,*) ithet_start,ithet_end
4053 do i=ithet_start,ithet_end
4055 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4056 & .or.itype(i).eq.ntyp1) cycle
4057 C Zero the energy function and its derivative at 0 or pi.
4058 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4060 ichir1=isign(1,itype(i-2))
4061 ichir2=isign(1,itype(i))
4062 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4063 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4064 if (itype(i-1).eq.10) then
4065 itype1=isign(10,itype(i-2))
4066 ichir11=isign(1,itype(i-2))
4067 ichir12=isign(1,itype(i-2))
4068 itype2=isign(10,itype(i))
4069 ichir21=isign(1,itype(i))
4070 ichir22=isign(1,itype(i))
4076 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4080 c call proc_proc(phii,icrc)
4081 if (icrc.eq.1) phii=150.0
4092 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4096 c call proc_proc(phii1,icrc)
4097 if (icrc.eq.1) phii1=150.0
4109 C Calculate the "mean" value of theta from the part of the distribution
4110 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4111 C In following comments this theta will be referred to as t_c.
4112 thet_pred_mean=0.0d0
4114 athetk=athet(k,it,ichir1,ichir2)
4115 bthetk=bthet(k,it,ichir1,ichir2)
4117 athetk=athet(k,itype1,ichir11,ichir12)
4118 bthetk=bthet(k,itype2,ichir21,ichir22)
4120 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4122 c write (iout,*) "thet_pred_mean",thet_pred_mean
4123 dthett=thet_pred_mean*ssd
4124 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4125 c write (iout,*) "thet_pred_mean",thet_pred_mean
4126 C Derivatives of the "mean" values in gamma1 and gamma2.
4127 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4128 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4129 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4130 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4132 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4133 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4134 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4135 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4137 if (theta(i).gt.pi-delta) then
4138 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4140 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4141 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4142 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4144 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4146 else if (theta(i).lt.delta) then
4147 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4148 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4149 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4151 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4152 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4155 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4158 etheta=etheta+ethetai
4159 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4160 c & rad2deg*phii,rad2deg*phii1,ethetai
4161 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4162 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4163 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4166 C Ufff.... We've done all this!!!
4169 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4170 do i=1,ntheta_constr
4171 itheta=itheta_constr(i)
4172 thetiii=theta(itheta)
4173 difi=pinorm(thetiii-theta_constr0(i))
4174 if (difi.gt.theta_drange(i)) then
4175 difi=difi-theta_drange(i)
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
4179 else if (difi.lt.-drange(i)) then
4181 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4182 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4183 & +for_thet_constr(i)*difi**3
4187 C if (energy_dec) then
4188 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4189 C & i,itheta,rad2deg*thetiii,
4190 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4191 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4192 C & gloc(itheta+nphi-2,icg)
4197 C---------------------------------------------------------------------------
4198 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4200 implicit real*8 (a-h,o-z)
4201 include 'DIMENSIONS'
4202 include 'COMMON.LOCAL'
4203 include 'COMMON.IOUNITS'
4204 common /calcthet/ term1,term2,termm,diffak,ratak,
4205 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4206 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4207 C Calculate the contributions to both Gaussian lobes.
4208 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4209 C The "polynomial part" of the "standard deviation" of this part of
4213 sig=sig*thet_pred_mean+polthet(j,it)
4215 C Derivative of the "interior part" of the "standard deviation of the"
4216 C gamma-dependent Gaussian lobe in t_c.
4217 sigtc=3*polthet(3,it)
4219 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4222 C Set the parameters of both Gaussian lobes of the distribution.
4223 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4224 fac=sig*sig+sigc0(it)
4227 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4228 sigsqtc=-4.0D0*sigcsq*sigtc
4229 c print *,i,sig,sigtc,sigsqtc
4230 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4231 sigtc=-sigtc/(fac*fac)
4232 C Following variable is sigma(t_c)**(-2)
4233 sigcsq=sigcsq*sigcsq
4235 sig0inv=1.0D0/sig0i**2
4236 delthec=thetai-thet_pred_mean
4237 delthe0=thetai-theta0i
4238 term1=-0.5D0*sigcsq*delthec*delthec
4239 term2=-0.5D0*sig0inv*delthe0*delthe0
4240 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4241 C NaNs in taking the logarithm. We extract the largest exponent which is added
4242 C to the energy (this being the log of the distribution) at the end of energy
4243 C term evaluation for this virtual-bond angle.
4244 if (term1.gt.term2) then
4246 term2=dexp(term2-termm)
4250 term1=dexp(term1-termm)
4253 C The ratio between the gamma-independent and gamma-dependent lobes of
4254 C the distribution is a Gaussian function of thet_pred_mean too.
4255 diffak=gthet(2,it)-thet_pred_mean
4256 ratak=diffak/gthet(3,it)**2
4257 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4258 C Let's differentiate it in thet_pred_mean NOW.
4260 C Now put together the distribution terms to make complete distribution.
4261 termexp=term1+ak*term2
4262 termpre=sigc+ak*sig0i
4263 C Contribution of the bending energy from this theta is just the -log of
4264 C the sum of the contributions from the two lobes and the pre-exponential
4265 C factor. Simple enough, isn't it?
4266 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4267 C NOW the derivatives!!!
4268 C 6/6/97 Take into account the deformation.
4269 E_theta=(delthec*sigcsq*term1
4270 & +ak*delthe0*sig0inv*term2)/termexp
4271 E_tc=((sigtc+aktc*sig0i)/termpre
4272 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4273 & aktc*term2)/termexp)
4276 c-----------------------------------------------------------------------------
4277 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4278 implicit real*8 (a-h,o-z)
4279 include 'DIMENSIONS'
4280 include 'COMMON.LOCAL'
4281 include 'COMMON.IOUNITS'
4282 common /calcthet/ term1,term2,termm,diffak,ratak,
4283 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4284 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4285 delthec=thetai-thet_pred_mean
4286 delthe0=thetai-theta0i
4287 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4288 t3 = thetai-thet_pred_mean
4292 t14 = t12+t6*sigsqtc
4294 t21 = thetai-theta0i
4300 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4301 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4302 & *(-t12*t9-ak*sig0inv*t27)
4306 C--------------------------------------------------------------------------
4307 subroutine ebend(etheta,ethetacnstr)
4309 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4310 C angles gamma and its derivatives in consecutive thetas and gammas.
4311 C ab initio-derived potentials from
4312 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4314 implicit real*8 (a-h,o-z)
4315 include 'DIMENSIONS'
4316 include 'sizesclu.dat'
4317 include 'COMMON.LOCAL'
4318 include 'COMMON.GEO'
4319 include 'COMMON.INTERACT'
4320 include 'COMMON.DERIV'
4321 include 'COMMON.VAR'
4322 include 'COMMON.CHAIN'
4323 include 'COMMON.IOUNITS'
4324 include 'COMMON.NAMES'
4325 include 'COMMON.FFIELD'
4326 include 'COMMON.CONTROL'
4327 include 'COMMON.TORCNSTR'
4328 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4329 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4330 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4331 & sinph1ph2(maxdouble,maxdouble)
4332 logical lprn /.false./, lprn1 /.false./
4334 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4335 do i=ithet_start,ithet_end
4337 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4338 & .or.itype(i).eq.ntyp1) cycle
4339 c if (itype(i-1).eq.ntyp1) cycle
4340 if (iabs(itype(i+1)).eq.20) iblock=2
4341 if (iabs(itype(i+1)).ne.20) iblock=1
4345 theti2=0.5d0*theta(i)
4346 ityp2=ithetyp((itype(i-1)))
4348 coskt(k)=dcos(k*theti2)
4349 sinkt(k)=dsin(k*theti2)
4359 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4362 if (phii.ne.phii) phii=150.0
4366 ityp1=ithetyp((itype(i-2)))
4368 cosph1(k)=dcos(k*phii)
4369 sinph1(k)=dsin(k*phii)
4375 ityp1=ithetyp((itype(i-2)))
4381 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4384 if (phii1.ne.phii1) phii1=150.0
4389 ityp3=ithetyp((itype(i)))
4391 cosph2(k)=dcos(k*phii1)
4392 sinph2(k)=dsin(k*phii1)
4397 ityp3=ithetyp((itype(i)))
4403 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4404 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4406 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4409 ccl=cosph1(l)*cosph2(k-l)
4410 ssl=sinph1(l)*sinph2(k-l)
4411 scl=sinph1(l)*cosph2(k-l)
4412 csl=cosph1(l)*sinph2(k-l)
4413 cosph1ph2(l,k)=ccl-ssl
4414 cosph1ph2(k,l)=ccl+ssl
4415 sinph1ph2(l,k)=scl+csl
4416 sinph1ph2(k,l)=scl-csl
4420 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4421 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4422 write (iout,*) "coskt and sinkt"
4424 write (iout,*) k,coskt(k),sinkt(k)
4428 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4429 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4432 & write (iout,*) "k",k," aathet",
4433 & aathet(k,ityp1,ityp2,ityp3,iblock),
4434 & " ethetai",ethetai
4437 write (iout,*) "cosph and sinph"
4439 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4441 write (iout,*) "cosph1ph2 and sinph2ph2"
4444 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4445 & sinph1ph2(l,k),sinph1ph2(k,l)
4448 write(iout,*) "ethetai",ethetai
4452 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4453 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4454 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4455 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4456 ethetai=ethetai+sinkt(m)*aux
4457 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4458 dephii=dephii+k*sinkt(m)*(
4459 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4460 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4461 dephii1=dephii1+k*sinkt(m)*(
4462 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4463 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4465 & write (iout,*) "m",m," k",k," bbthet",
4466 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4467 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4468 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4469 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4473 & write(iout,*) "ethetai",ethetai
4477 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4478 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4479 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4480 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4481 ethetai=ethetai+sinkt(m)*aux
4482 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4483 dephii=dephii+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))
4488 dephii1=dephii1+(k-l)*sinkt(m)*(
4489 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4490 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4491 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4492 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4494 write (iout,*) "m",m," k",k," l",l," ffthet",
4495 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4496 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4497 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4498 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4499 & " ethetai",ethetai
4500 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4501 & cosph1ph2(k,l)*sinkt(m),
4502 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4508 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4509 & i,theta(i)*rad2deg,phii*rad2deg,
4510 & phii1*rad2deg,ethetai
4511 etheta=etheta+ethetai
4512 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4513 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4514 c gloc(nphi+i-2,icg)=wang*dethetai
4515 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4519 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4520 do i=1,ntheta_constr
4521 itheta=itheta_constr(i)
4522 thetiii=theta(itheta)
4523 difi=pinorm(thetiii-theta_constr0(i))
4524 if (difi.gt.theta_drange(i)) then
4525 difi=difi-theta_drange(i)
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
4529 else if (difi.lt.-drange(i)) then
4531 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4532 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4533 & +for_thet_constr(i)*difi**3
4537 C if (energy_dec) then
4538 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4539 C & i,itheta,rad2deg*thetiii,
4540 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4541 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4542 C & gloc(itheta+nphi-2,icg)
4549 c-----------------------------------------------------------------------------
4550 subroutine esc(escloc)
4551 C Calculate the local energy of a side chain and its derivatives in the
4552 C corresponding virtual-bond valence angles THETA and the spherical angles
4554 implicit real*8 (a-h,o-z)
4555 include 'DIMENSIONS'
4556 include 'sizesclu.dat'
4557 include 'COMMON.GEO'
4558 include 'COMMON.LOCAL'
4559 include 'COMMON.VAR'
4560 include 'COMMON.INTERACT'
4561 include 'COMMON.DERIV'
4562 include 'COMMON.CHAIN'
4563 include 'COMMON.IOUNITS'
4564 include 'COMMON.NAMES'
4565 include 'COMMON.FFIELD'
4566 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4567 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4568 common /sccalc/ time11,time12,time112,theti,it,nlobit
4571 c write (iout,'(a)') 'ESC'
4572 do i=loc_start,loc_end
4574 if (it.eq.ntyp1) cycle
4575 if (it.eq.10) goto 1
4576 nlobit=nlob(iabs(it))
4577 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4578 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4579 theti=theta(i+1)-pipol
4583 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4585 if (x(2).gt.pi-delta) then
4589 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4591 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4592 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4594 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4595 & ddersc0(1),dersc(1))
4596 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4597 & ddersc0(3),dersc(3))
4599 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4601 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4602 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4603 & dersc0(2),esclocbi,dersc02)
4604 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4606 call splinthet(x(2),0.5d0*delta,ss,ssd)
4611 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4613 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4614 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4616 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4618 c write (iout,*) escloci
4619 else if (x(2).lt.delta) then
4623 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4625 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4626 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4628 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4629 & ddersc0(1),dersc(1))
4630 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4631 & ddersc0(3),dersc(3))
4633 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4635 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4636 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4637 & dersc0(2),esclocbi,dersc02)
4638 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4643 call splinthet(x(2),0.5d0*delta,ss,ssd)
4645 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4647 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4648 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4650 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4651 c write (iout,*) escloci
4653 call enesc(x,escloci,dersc,ddummy,.false.)
4656 escloc=escloc+escloci
4657 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4659 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4661 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4662 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4667 C---------------------------------------------------------------------------
4668 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4669 implicit real*8 (a-h,o-z)
4670 include 'DIMENSIONS'
4671 include 'COMMON.GEO'
4672 include 'COMMON.LOCAL'
4673 include 'COMMON.IOUNITS'
4674 common /sccalc/ time11,time12,time112,theti,it,nlobit
4675 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4676 double precision contr(maxlob,-1:1)
4678 c write (iout,*) 'it=',it,' nlobit=',nlobit
4682 if (mixed) ddersc(j)=0.0d0
4686 C Because of periodicity of the dependence of the SC energy in omega we have
4687 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4688 C To avoid underflows, first compute & store the exponents.
4696 z(k)=x(k)-censc(k,j,it)
4701 Axk=Axk+gaussc(l,k,j,it)*z(l)
4707 expfac=expfac+Ax(k,j,iii)*z(k)
4715 C As in the case of ebend, we want to avoid underflows in exponentiation and
4716 C subsequent NaNs and INFs in energy calculation.
4717 C Find the largest exponent
4721 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4725 cd print *,'it=',it,' emin=',emin
4727 C Compute the contribution to SC energy and derivatives
4731 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4732 cd print *,'j=',j,' expfac=',expfac
4733 escloc_i=escloc_i+expfac
4735 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4739 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4740 & +gaussc(k,2,j,it))*expfac
4747 dersc(1)=dersc(1)/cos(theti)**2
4748 ddersc(1)=ddersc(1)/cos(theti)**2
4751 escloci=-(dlog(escloc_i)-emin)
4753 dersc(j)=dersc(j)/escloc_i
4757 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4762 C------------------------------------------------------------------------------
4763 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4764 implicit real*8 (a-h,o-z)
4765 include 'DIMENSIONS'
4766 include 'COMMON.GEO'
4767 include 'COMMON.LOCAL'
4768 include 'COMMON.IOUNITS'
4769 common /sccalc/ time11,time12,time112,theti,it,nlobit
4770 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4771 double precision contr(maxlob)
4782 z(k)=x(k)-censc(k,j,it)
4788 Axk=Axk+gaussc(l,k,j,it)*z(l)
4794 expfac=expfac+Ax(k,j)*z(k)
4799 C As in the case of ebend, we want to avoid underflows in exponentiation and
4800 C subsequent NaNs and INFs in energy calculation.
4801 C Find the largest exponent
4804 if (emin.gt.contr(j)) emin=contr(j)
4808 C Compute the contribution to SC energy and derivatives
4812 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4813 escloc_i=escloc_i+expfac
4815 dersc(k)=dersc(k)+Ax(k,j)*expfac
4817 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4818 & +gaussc(1,2,j,it))*expfac
4822 dersc(1)=dersc(1)/cos(theti)**2
4823 dersc12=dersc12/cos(theti)**2
4824 escloci=-(dlog(escloc_i)-emin)
4826 dersc(j)=dersc(j)/escloc_i
4828 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4832 c----------------------------------------------------------------------------------
4833 subroutine esc(escloc)
4834 C Calculate the local energy of a side chain and its derivatives in the
4835 C corresponding virtual-bond valence angles THETA and the spherical angles
4836 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4837 C added by Urszula Kozlowska. 07/11/2007
4839 implicit real*8 (a-h,o-z)
4840 include 'DIMENSIONS'
4841 include 'sizesclu.dat'
4842 include 'COMMON.GEO'
4843 include 'COMMON.LOCAL'
4844 include 'COMMON.VAR'
4845 include 'COMMON.SCROT'
4846 include 'COMMON.INTERACT'
4847 include 'COMMON.DERIV'
4848 include 'COMMON.CHAIN'
4849 include 'COMMON.IOUNITS'
4850 include 'COMMON.NAMES'
4851 include 'COMMON.FFIELD'
4852 include 'COMMON.CONTROL'
4853 include 'COMMON.VECTORS'
4854 double precision x_prime(3),y_prime(3),z_prime(3)
4855 & , sumene,dsc_i,dp2_i,x(65),
4856 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4857 & de_dxx,de_dyy,de_dzz,de_dt
4858 double precision s1_t,s1_6_t,s2_t,s2_6_t
4860 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4861 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4862 & dt_dCi(3),dt_dCi1(3)
4863 common /sccalc/ time11,time12,time112,theti,it,nlobit
4866 do i=loc_start,loc_end
4867 if (itype(i).eq.ntyp1) cycle
4868 costtab(i+1) =dcos(theta(i+1))
4869 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4870 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4871 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4872 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4873 cosfac=dsqrt(cosfac2)
4874 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4875 sinfac=dsqrt(sinfac2)
4877 if (it.eq.10) goto 1
4879 C Compute the axes of tghe local cartesian coordinates system; store in
4880 c x_prime, y_prime and z_prime
4887 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4888 C & dc_norm(3,i+nres)
4890 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4891 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4894 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4897 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4898 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4899 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4900 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4901 c & " xy",scalar(x_prime(1),y_prime(1)),
4902 c & " xz",scalar(x_prime(1),z_prime(1)),
4903 c & " yy",scalar(y_prime(1),y_prime(1)),
4904 c & " yz",scalar(y_prime(1),z_prime(1)),
4905 c & " zz",scalar(z_prime(1),z_prime(1))
4907 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4908 C to local coordinate system. Store in xx, yy, zz.
4914 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4915 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4916 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4923 C Compute the energy of the ith side cbain
4925 c write (2,*) "xx",xx," yy",yy," zz",zz
4928 x(j) = sc_parmin(j,it)
4931 Cc diagnostics - remove later
4933 yy1 = dsin(alph(2))*dcos(omeg(2))
4934 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4935 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4936 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4937 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4939 C," --- ", xx_w,yy_w,zz_w
4942 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4943 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4945 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4946 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4948 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4949 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4950 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4951 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4952 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4954 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4955 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4956 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4957 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4958 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4960 dsc_i = 0.743d0+x(61)
4962 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4963 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4964 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4965 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4966 s1=(1+x(63))/(0.1d0 + dscp1)
4967 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4968 s2=(1+x(65))/(0.1d0 + dscp2)
4969 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4970 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4971 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4972 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4974 c & dscp1,dscp2,sumene
4975 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4976 escloc = escloc + sumene
4977 c write (2,*) "escloc",escloc
4978 if (.not. calc_grad) goto 1
4981 C This section to check the numerical derivatives of the energy of ith side
4982 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4983 C #define DEBUG in the code to turn it on.
4985 write (2,*) "sumene =",sumene
4989 write (2,*) xx,yy,zz
4990 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4991 de_dxx_num=(sumenep-sumene)/aincr
4993 write (2,*) "xx+ sumene from enesc=",sumenep
4996 write (2,*) xx,yy,zz
4997 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4998 de_dyy_num=(sumenep-sumene)/aincr
5000 write (2,*) "yy+ sumene from enesc=",sumenep
5003 write (2,*) xx,yy,zz
5004 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5005 de_dzz_num=(sumenep-sumene)/aincr
5007 write (2,*) "zz+ sumene from enesc=",sumenep
5008 costsave=cost2tab(i+1)
5009 sintsave=sint2tab(i+1)
5010 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5011 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5012 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5013 de_dt_num=(sumenep-sumene)/aincr
5014 write (2,*) " t+ sumene from enesc=",sumenep
5015 cost2tab(i+1)=costsave
5016 sint2tab(i+1)=sintsave
5017 C End of diagnostics section.
5020 C Compute the gradient of esc
5022 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5023 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5024 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5025 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5026 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5027 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5028 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5029 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5030 pom1=(sumene3*sint2tab(i+1)+sumene1)
5031 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5032 pom2=(sumene4*cost2tab(i+1)+sumene2)
5033 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5034 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5035 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5036 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5038 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5039 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5040 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5042 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5043 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5044 & +(pom1+pom2)*pom_dx
5046 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5049 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5050 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5051 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5053 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5054 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5055 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5056 & +x(59)*zz**2 +x(60)*xx*zz
5057 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5058 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5059 & +(pom1-pom2)*pom_dy
5061 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5064 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5065 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5066 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5067 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5068 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5069 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5070 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5071 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5073 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5076 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5077 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5078 & +pom1*pom_dt1+pom2*pom_dt2
5080 write(2,*), "de_dt = ", de_dt,de_dt_num
5084 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5085 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5086 cosfac2xx=cosfac2*xx
5087 sinfac2yy=sinfac2*yy
5089 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5091 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5093 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5094 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5095 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5096 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5097 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5098 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5099 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5100 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5101 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5102 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5106 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5107 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5108 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5109 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5112 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5113 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5114 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5116 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5117 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5121 dXX_Ctab(k,i)=dXX_Ci(k)
5122 dXX_C1tab(k,i)=dXX_Ci1(k)
5123 dYY_Ctab(k,i)=dYY_Ci(k)
5124 dYY_C1tab(k,i)=dYY_Ci1(k)
5125 dZZ_Ctab(k,i)=dZZ_Ci(k)
5126 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5127 dXX_XYZtab(k,i)=dXX_XYZ(k)
5128 dYY_XYZtab(k,i)=dYY_XYZ(k)
5129 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5133 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5134 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5135 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5136 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5137 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5139 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5140 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5141 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5142 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5143 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5144 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5145 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5146 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5148 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5149 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5151 C to check gradient call subroutine check_grad
5158 c------------------------------------------------------------------------------
5159 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5161 C This procedure calculates two-body contact function g(rij) and its derivative:
5164 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5167 C where x=(rij-r0ij)/delta
5169 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5172 double precision rij,r0ij,eps0ij,fcont,fprimcont
5173 double precision x,x2,x4,delta
5177 if (x.lt.-1.0D0) then
5180 else if (x.le.1.0D0) then
5183 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5184 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5191 c------------------------------------------------------------------------------
5192 subroutine splinthet(theti,delta,ss,ssder)
5193 implicit real*8 (a-h,o-z)
5194 include 'DIMENSIONS'
5195 include 'sizesclu.dat'
5196 include 'COMMON.VAR'
5197 include 'COMMON.GEO'
5200 if (theti.gt.pipol) then
5201 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5203 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5208 c------------------------------------------------------------------------------
5209 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5211 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5212 double precision ksi,ksi2,ksi3,a1,a2,a3
5213 a1=fprim0*delta/(f1-f0)
5219 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5220 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5223 c------------------------------------------------------------------------------
5224 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5226 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5227 double precision ksi,ksi2,ksi3,a1,a2,a3
5232 a2=3*(f1x-f0x)-2*fprim0x*delta
5233 a3=fprim0x*delta-2*(f1x-f0x)
5234 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5237 C-----------------------------------------------------------------------------
5239 C-----------------------------------------------------------------------------
5240 subroutine etor(etors,edihcnstr,fact)
5241 implicit real*8 (a-h,o-z)
5242 include 'DIMENSIONS'
5243 include 'sizesclu.dat'
5244 include 'COMMON.VAR'
5245 include 'COMMON.GEO'
5246 include 'COMMON.LOCAL'
5247 include 'COMMON.TORSION'
5248 include 'COMMON.INTERACT'
5249 include 'COMMON.DERIV'
5250 include 'COMMON.CHAIN'
5251 include 'COMMON.NAMES'
5252 include 'COMMON.IOUNITS'
5253 include 'COMMON.FFIELD'
5254 include 'COMMON.TORCNSTR'
5256 C Set lprn=.true. for debugging
5260 do i=iphi_start,iphi_end
5261 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5262 & .or. itype(i).eq.ntyp1) cycle
5263 itori=itortyp(itype(i-2))
5264 itori1=itortyp(itype(i-1))
5267 C Proline-Proline pair is a special case...
5268 if (itori.eq.3 .and. itori1.eq.3) then
5269 if (phii.gt.-dwapi3) then
5271 fac=1.0D0/(1.0D0-cosphi)
5272 etorsi=v1(1,3,3)*fac
5273 etorsi=etorsi+etorsi
5274 etors=etors+etorsi-v1(1,3,3)
5275 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5278 v1ij=v1(j+1,itori,itori1)
5279 v2ij=v2(j+1,itori,itori1)
5282 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5283 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5287 v1ij=v1(j,itori,itori1)
5288 v2ij=v2(j,itori,itori1)
5291 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5292 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5296 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5297 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5298 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5299 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5300 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5302 ! 6/20/98 - dihedral angle constraints
5305 itori=idih_constr(i)
5308 if (difi.gt.drange(i)) then
5310 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5311 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5312 else if (difi.lt.-drange(i)) then
5314 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5315 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5317 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5318 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5320 ! write (iout,*) 'edihcnstr',edihcnstr
5323 c------------------------------------------------------------------------------
5325 subroutine etor(etors,edihcnstr,fact)
5326 implicit real*8 (a-h,o-z)
5327 include 'DIMENSIONS'
5328 include 'sizesclu.dat'
5329 include 'COMMON.VAR'
5330 include 'COMMON.GEO'
5331 include 'COMMON.LOCAL'
5332 include 'COMMON.TORSION'
5333 include 'COMMON.INTERACT'
5334 include 'COMMON.DERIV'
5335 include 'COMMON.CHAIN'
5336 include 'COMMON.NAMES'
5337 include 'COMMON.IOUNITS'
5338 include 'COMMON.FFIELD'
5339 include 'COMMON.TORCNSTR'
5341 C Set lprn=.true. for debugging
5345 do i=iphi_start,iphi_end
5347 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5348 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5349 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5350 if (iabs(itype(i)).eq.20) then
5355 itori=itortyp(itype(i-2))
5356 itori1=itortyp(itype(i-1))
5359 C Regular cosine and sine terms
5360 do j=1,nterm(itori,itori1,iblock)
5361 v1ij=v1(j,itori,itori1,iblock)
5362 v2ij=v2(j,itori,itori1,iblock)
5365 etors=etors+v1ij*cosphi+v2ij*sinphi
5366 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5370 C E = SUM ----------------------------------- - v1
5371 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5373 cosphi=dcos(0.5d0*phii)
5374 sinphi=dsin(0.5d0*phii)
5375 do j=1,nlor(itori,itori1,iblock)
5376 vl1ij=vlor1(j,itori,itori1)
5377 vl2ij=vlor2(j,itori,itori1)
5378 vl3ij=vlor3(j,itori,itori1)
5379 pom=vl2ij*cosphi+vl3ij*sinphi
5380 pom1=1.0d0/(pom*pom+1.0d0)
5381 etors=etors+vl1ij*pom1
5383 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5385 C Subtract the constant term
5386 etors=etors-v0(itori,itori1,iblock)
5388 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5389 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5390 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5391 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5392 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5395 ! 6/20/98 - dihedral angle constraints
5398 itori=idih_constr(i)
5400 difi=pinorm(phii-phi0(i))
5402 if (difi.gt.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
5407 else if (difi.lt.-drange(i)) then
5409 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5410 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5411 edihi=0.25d0*ftors(i)*difi**4
5415 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5417 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5418 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5420 ! write (iout,*) 'edihcnstr',edihcnstr
5423 c----------------------------------------------------------------------------
5424 subroutine etor_d(etors_d,fact2)
5425 C 6/23/01 Compute double torsional energy
5426 implicit real*8 (a-h,o-z)
5427 include 'DIMENSIONS'
5428 include 'sizesclu.dat'
5429 include 'COMMON.VAR'
5430 include 'COMMON.GEO'
5431 include 'COMMON.LOCAL'
5432 include 'COMMON.TORSION'
5433 include 'COMMON.INTERACT'
5434 include 'COMMON.DERIV'
5435 include 'COMMON.CHAIN'
5436 include 'COMMON.NAMES'
5437 include 'COMMON.IOUNITS'
5438 include 'COMMON.FFIELD'
5439 include 'COMMON.TORCNSTR'
5441 C Set lprn=.true. for debugging
5445 do i=iphi_start,iphi_end-1
5447 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5448 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5449 & (itype(i+1).eq.ntyp1)) cycle
5450 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5452 itori=itortyp(itype(i-2))
5453 itori1=itortyp(itype(i-1))
5454 itori2=itortyp(itype(i))
5460 if (iabs(itype(i+1)).eq.20) iblock=2
5461 C Regular cosine and sine terms
5462 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5463 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5464 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5465 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5466 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5467 cosphi1=dcos(j*phii)
5468 sinphi1=dsin(j*phii)
5469 cosphi2=dcos(j*phii1)
5470 sinphi2=dsin(j*phii1)
5471 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5472 & v2cij*cosphi2+v2sij*sinphi2
5473 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5474 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5476 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5478 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5479 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5480 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5481 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5482 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5483 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5484 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5485 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5486 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5487 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5488 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5489 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5490 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5491 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5494 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5495 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5501 c------------------------------------------------------------------------------
5502 subroutine eback_sc_corr(esccor)
5503 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5504 c conformational states; temporarily implemented as differences
5505 c between UNRES torsional potentials (dependent on three types of
5506 c residues) and the torsional potentials dependent on all 20 types
5507 c of residues computed from AM1 energy surfaces of terminally-blocked
5508 c amino-acid residues.
5509 implicit real*8 (a-h,o-z)
5510 include 'DIMENSIONS'
5511 include 'sizesclu.dat'
5512 include 'COMMON.VAR'
5513 include 'COMMON.GEO'
5514 include 'COMMON.LOCAL'
5515 include 'COMMON.TORSION'
5516 include 'COMMON.SCCOR'
5517 include 'COMMON.INTERACT'
5518 include 'COMMON.DERIV'
5519 include 'COMMON.CHAIN'
5520 include 'COMMON.NAMES'
5521 include 'COMMON.IOUNITS'
5522 include 'COMMON.FFIELD'
5523 include 'COMMON.CONTROL'
5525 C Set lprn=.true. for debugging
5528 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5530 do i=itau_start,itau_end
5531 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5533 isccori=isccortyp(itype(i-2))
5534 isccori1=isccortyp(itype(i-1))
5536 do intertyp=1,3 !intertyp
5537 cc Added 09 May 2012 (Adasko)
5538 cc Intertyp means interaction type of backbone mainchain correlation:
5539 c 1 = SC...Ca...Ca...Ca
5540 c 2 = Ca...Ca...Ca...SC
5541 c 3 = SC...Ca...Ca...SCi
5543 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5544 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5545 & (itype(i-1).eq.ntyp1)))
5546 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5547 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5548 & .or.(itype(i).eq.ntyp1)))
5549 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5550 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5551 & (itype(i-3).eq.ntyp1)))) cycle
5552 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5553 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5555 do j=1,nterm_sccor(isccori,isccori1)
5556 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5557 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5558 cosphi=dcos(j*tauangle(intertyp,i))
5559 sinphi=dsin(j*tauangle(intertyp,i))
5560 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5561 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5563 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5564 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
5566 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5567 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5568 & (v1sccor(j,1,itori,itori1),j=1,6),
5569 & (v2sccor(j,1,itori,itori1),j=1,6)
5570 gsccor_loc(i-3)=gloci
5575 c------------------------------------------------------------------------------
5576 subroutine multibody(ecorr)
5577 C This subroutine calculates multi-body contributions to energy following
5578 C the idea of Skolnick et al. If side chains I and J make a contact and
5579 C at the same time side chains I+1 and J+1 make a contact, an extra
5580 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5581 implicit real*8 (a-h,o-z)
5582 include 'DIMENSIONS'
5583 include 'COMMON.IOUNITS'
5584 include 'COMMON.DERIV'
5585 include 'COMMON.INTERACT'
5586 include 'COMMON.CONTACTS'
5587 double precision gx(3),gx1(3)
5590 C Set lprn=.true. for debugging
5594 write (iout,'(a)') 'Contact function values:'
5596 write (iout,'(i2,20(1x,i2,f10.5))')
5597 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5612 num_conti=num_cont(i)
5613 num_conti1=num_cont(i1)
5618 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5619 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5620 cd & ' ishift=',ishift
5621 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5622 C The system gains extra energy.
5623 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5624 endif ! j1==j+-ishift
5633 c------------------------------------------------------------------------------
5634 double precision function esccorr(i,j,k,l,jj,kk)
5635 implicit real*8 (a-h,o-z)
5636 include 'DIMENSIONS'
5637 include 'COMMON.IOUNITS'
5638 include 'COMMON.DERIV'
5639 include 'COMMON.INTERACT'
5640 include 'COMMON.CONTACTS'
5641 double precision gx(3),gx1(3)
5646 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5647 C Calculate the multi-body contribution to energy.
5648 C Calculate multi-body contributions to the gradient.
5649 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5650 cd & k,l,(gacont(m,kk,k),m=1,3)
5652 gx(m) =ekl*gacont(m,jj,i)
5653 gx1(m)=eij*gacont(m,kk,k)
5654 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5655 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5656 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5657 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5661 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5666 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5672 c------------------------------------------------------------------------------
5674 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5675 implicit real*8 (a-h,o-z)
5676 include 'DIMENSIONS'
5677 integer dimen1,dimen2,atom,indx
5678 double precision buffer(dimen1,dimen2)
5679 double precision zapas
5680 common /contacts_hb/ zapas(3,20,maxres,7),
5681 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5682 & num_cont_hb(maxres),jcont_hb(20,maxres)
5683 num_kont=num_cont_hb(atom)
5687 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5690 buffer(i,indx+22)=facont_hb(i,atom)
5691 buffer(i,indx+23)=ees0p(i,atom)
5692 buffer(i,indx+24)=ees0m(i,atom)
5693 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5695 buffer(1,indx+26)=dfloat(num_kont)
5698 c------------------------------------------------------------------------------
5699 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5700 implicit real*8 (a-h,o-z)
5701 include 'DIMENSIONS'
5702 integer dimen1,dimen2,atom,indx
5703 double precision buffer(dimen1,dimen2)
5704 double precision zapas
5705 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5706 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5707 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5708 num_kont=buffer(1,indx+26)
5709 num_kont_old=num_cont_hb(atom)
5710 num_cont_hb(atom)=num_kont+num_kont_old
5715 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5718 facont_hb(ii,atom)=buffer(i,indx+22)
5719 ees0p(ii,atom)=buffer(i,indx+23)
5720 ees0m(ii,atom)=buffer(i,indx+24)
5721 jcont_hb(ii,atom)=buffer(i,indx+25)
5725 c------------------------------------------------------------------------------
5727 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5728 C This subroutine calculates multi-body contributions to hydrogen-bonding
5729 implicit real*8 (a-h,o-z)
5730 include 'DIMENSIONS'
5731 include 'sizesclu.dat'
5732 include 'COMMON.IOUNITS'
5734 include 'COMMON.INFO'
5736 include 'COMMON.FFIELD'
5737 include 'COMMON.DERIV'
5738 include 'COMMON.INTERACT'
5739 include 'COMMON.CONTACTS'
5741 parameter (max_cont=maxconts)
5742 parameter (max_dim=2*(8*3+2))
5743 parameter (msglen1=max_cont*max_dim*4)
5744 parameter (msglen2=2*msglen1)
5745 integer source,CorrelType,CorrelID,Error
5746 double precision buffer(max_cont,max_dim)
5748 double precision gx(3),gx1(3)
5751 C Set lprn=.true. for debugging
5756 if (fgProcs.le.1) goto 30
5758 write (iout,'(a)') 'Contact function values:'
5760 write (iout,'(2i3,50(1x,i2,f5.2))')
5761 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5762 & j=1,num_cont_hb(i))
5765 C Caution! Following code assumes that electrostatic interactions concerning
5766 C a given atom are split among at most two processors!
5776 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5779 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5780 if (MyRank.gt.0) then
5781 C Send correlation contributions to the preceding processor
5783 nn=num_cont_hb(iatel_s)
5784 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5785 cd write (iout,*) 'The BUFFER array:'
5787 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5789 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5791 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5792 C Clear the contacts of the atom passed to the neighboring processor
5793 nn=num_cont_hb(iatel_s+1)
5795 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5797 num_cont_hb(iatel_s)=0
5799 cd write (iout,*) 'Processor ',MyID,MyRank,
5800 cd & ' is sending correlation contribution to processor',MyID-1,
5801 cd & ' msglen=',msglen
5802 cd write (*,*) 'Processor ',MyID,MyRank,
5803 cd & ' is sending correlation contribution to processor',MyID-1,
5804 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5805 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5806 cd write (iout,*) 'Processor ',MyID,
5807 cd & ' has sent correlation contribution to processor',MyID-1,
5808 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5809 cd write (*,*) 'Processor ',MyID,
5810 cd & ' has sent correlation contribution to processor',MyID-1,
5811 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5813 endif ! (MyRank.gt.0)
5817 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5818 if (MyRank.lt.fgProcs-1) then
5819 C Receive correlation contributions from the next processor
5821 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5822 cd write (iout,*) 'Processor',MyID,
5823 cd & ' is receiving correlation contribution from processor',MyID+1,
5824 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5825 cd write (*,*) 'Processor',MyID,
5826 cd & ' is receiving correlation contribution from processor',MyID+1,
5827 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5829 do while (nbytes.le.0)
5830 call mp_probe(MyID+1,CorrelType,nbytes)
5832 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5833 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5834 cd write (iout,*) 'Processor',MyID,
5835 cd & ' has received correlation contribution from processor',MyID+1,
5836 cd & ' msglen=',msglen,' nbytes=',nbytes
5837 cd write (iout,*) 'The received BUFFER array:'
5839 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5841 if (msglen.eq.msglen1) then
5842 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5843 else if (msglen.eq.msglen2) then
5844 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5845 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5848 & 'ERROR!!!! message length changed while processing correlations.'
5850 & 'ERROR!!!! message length changed while processing correlations.'
5851 call mp_stopall(Error)
5852 endif ! msglen.eq.msglen1
5853 endif ! MyRank.lt.fgProcs-1
5860 write (iout,'(a)') 'Contact function values:'
5862 write (iout,'(2i3,50(1x,i2,f5.2))')
5863 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5864 & j=1,num_cont_hb(i))
5868 C Remove the loop below after debugging !!!
5875 C Calculate the local-electrostatic correlation terms
5876 do i=iatel_s,iatel_e+1
5878 num_conti=num_cont_hb(i)
5879 num_conti1=num_cont_hb(i+1)
5884 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5885 c & ' jj=',jj,' kk=',kk
5886 if (j1.eq.j+1 .or. j1.eq.j-1) then
5887 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5888 C The system gains extra energy.
5889 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5891 else if (j1.eq.j) then
5892 C Contacts I-J and I-(J+1) occur simultaneously.
5893 C The system loses extra energy.
5894 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5899 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5900 c & ' jj=',jj,' kk=',kk
5902 C Contacts I-J and (I+1)-J occur simultaneously.
5903 C The system loses extra energy.
5904 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5911 c------------------------------------------------------------------------------
5912 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5914 C This subroutine calculates multi-body contributions to hydrogen-bonding
5915 implicit real*8 (a-h,o-z)
5916 include 'DIMENSIONS'
5917 include 'sizesclu.dat'
5918 include 'COMMON.IOUNITS'
5920 include 'COMMON.INFO'
5922 include 'COMMON.FFIELD'
5923 include 'COMMON.DERIV'
5924 include 'COMMON.INTERACT'
5925 include 'COMMON.CONTACTS'
5927 parameter (max_cont=maxconts)
5928 parameter (max_dim=2*(8*3+2))
5929 parameter (msglen1=max_cont*max_dim*4)
5930 parameter (msglen2=2*msglen1)
5931 integer source,CorrelType,CorrelID,Error
5932 double precision buffer(max_cont,max_dim)
5934 double precision gx(3),gx1(3)
5937 C Set lprn=.true. for debugging
5943 if (fgProcs.le.1) goto 30
5945 write (iout,'(a)') 'Contact function values:'
5947 write (iout,'(2i3,50(1x,i2,f5.2))')
5948 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5949 & j=1,num_cont_hb(i))
5952 C Caution! Following code assumes that electrostatic interactions concerning
5953 C a given atom are split among at most two processors!
5963 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5966 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5967 if (MyRank.gt.0) then
5968 C Send correlation contributions to the preceding processor
5970 nn=num_cont_hb(iatel_s)
5971 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5972 cd write (iout,*) 'The BUFFER array:'
5974 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5976 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5978 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5979 C Clear the contacts of the atom passed to the neighboring processor
5980 nn=num_cont_hb(iatel_s+1)
5982 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5984 num_cont_hb(iatel_s)=0
5986 cd write (iout,*) 'Processor ',MyID,MyRank,
5987 cd & ' is sending correlation contribution to processor',MyID-1,
5988 cd & ' msglen=',msglen
5989 cd write (*,*) 'Processor ',MyID,MyRank,
5990 cd & ' is sending correlation contribution to processor',MyID-1,
5991 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5992 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5993 cd write (iout,*) 'Processor ',MyID,
5994 cd & ' has sent correlation contribution to processor',MyID-1,
5995 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5996 cd write (*,*) 'Processor ',MyID,
5997 cd & ' has sent correlation contribution to processor',MyID-1,
5998 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6000 endif ! (MyRank.gt.0)
6004 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6005 if (MyRank.lt.fgProcs-1) then
6006 C Receive correlation contributions from the next processor
6008 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6009 cd write (iout,*) 'Processor',MyID,
6010 cd & ' is receiving correlation contribution from processor',MyID+1,
6011 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6012 cd write (*,*) 'Processor',MyID,
6013 cd & ' is receiving correlation contribution from processor',MyID+1,
6014 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6016 do while (nbytes.le.0)
6017 call mp_probe(MyID+1,CorrelType,nbytes)
6019 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6020 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6021 cd write (iout,*) 'Processor',MyID,
6022 cd & ' has received correlation contribution from processor',MyID+1,
6023 cd & ' msglen=',msglen,' nbytes=',nbytes
6024 cd write (iout,*) 'The received BUFFER array:'
6026 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6028 if (msglen.eq.msglen1) then
6029 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6030 else if (msglen.eq.msglen2) then
6031 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6032 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6035 & 'ERROR!!!! message length changed while processing correlations.'
6037 & 'ERROR!!!! message length changed while processing correlations.'
6038 call mp_stopall(Error)
6039 endif ! msglen.eq.msglen1
6040 endif ! MyRank.lt.fgProcs-1
6047 write (iout,'(a)') 'Contact function values:'
6049 write (iout,'(2i3,50(1x,i2,f5.2))')
6050 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6051 & j=1,num_cont_hb(i))
6057 C Remove the loop below after debugging !!!
6064 C Calculate the dipole-dipole interaction energies
6065 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6066 do i=iatel_s,iatel_e+1
6067 num_conti=num_cont_hb(i)
6074 C Calculate the local-electrostatic correlation terms
6075 do i=iatel_s,iatel_e+1
6077 num_conti=num_cont_hb(i)
6078 num_conti1=num_cont_hb(i+1)
6083 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6084 c & ' jj=',jj,' kk=',kk
6085 if (j1.eq.j+1 .or. j1.eq.j-1) then
6086 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6087 C The system gains extra energy.
6089 sqd1=dsqrt(d_cont(jj,i))
6090 sqd2=dsqrt(d_cont(kk,i1))
6091 sred_geom = sqd1*sqd2
6092 IF (sred_geom.lt.cutoff_corr) THEN
6093 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6095 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6096 c & ' jj=',jj,' kk=',kk
6097 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6098 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6100 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6101 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6104 cd write (iout,*) 'sred_geom=',sred_geom,
6105 cd & ' ekont=',ekont,' fprim=',fprimcont
6106 call calc_eello(i,j,i+1,j1,jj,kk)
6107 if (wcorr4.gt.0.0d0)
6108 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6109 if (wcorr5.gt.0.0d0)
6110 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6111 c print *,"wcorr5",ecorr5
6112 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6113 cd write(2,*)'ijkl',i,j,i+1,j1
6114 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6115 & .or. wturn6.eq.0.0d0))then
6116 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6117 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6118 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6119 cd & 'ecorr6=',ecorr6
6120 cd write (iout,'(4e15.5)') sred_geom,
6121 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6122 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6123 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6124 else if (wturn6.gt.0.0d0
6125 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6126 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6127 eturn6=eturn6+eello_turn6(i,jj,kk)
6128 cd write (2,*) 'multibody_eello:eturn6',eturn6
6132 else if (j1.eq.j) then
6133 C Contacts I-J and I-(J+1) occur simultaneously.
6134 C The system loses extra energy.
6135 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6140 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6141 c & ' jj=',jj,' kk=',kk
6143 C Contacts I-J and (I+1)-J occur simultaneously.
6144 C The system loses extra energy.
6145 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6152 c------------------------------------------------------------------------------
6153 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6154 implicit real*8 (a-h,o-z)
6155 include 'DIMENSIONS'
6156 include 'COMMON.IOUNITS'
6157 include 'COMMON.DERIV'
6158 include 'COMMON.INTERACT'
6159 include 'COMMON.CONTACTS'
6160 include 'COMMON.SHIELD'
6162 double precision gx(3),gx1(3)
6172 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6173 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6174 C Following 4 lines for diagnostics.
6179 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6181 c write (iout,*)'Contacts have occurred for peptide groups',
6182 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6183 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6184 C Calculate the multi-body contribution to energy.
6185 ecorr=ecorr+ekont*ees
6187 C Calculate multi-body contributions to the gradient.
6189 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6190 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6191 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6192 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6193 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6194 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6195 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6196 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6197 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6198 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6199 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6200 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6201 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6202 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6206 gradcorr(ll,m)=gradcorr(ll,m)+
6207 & ees*ekl*gacont_hbr(ll,jj,i)-
6208 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6209 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6214 gradcorr(ll,m)=gradcorr(ll,m)+
6215 & ees*eij*gacont_hbr(ll,kk,k)-
6216 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6217 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6220 if (shield_mode.gt.0) then
6223 C print *,i,j,fac_shield(i),fac_shield(j),
6224 C &fac_shield(k),fac_shield(l)
6225 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6226 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6227 do ilist=1,ishield_list(i)
6228 iresshield=shield_list(ilist,i)
6230 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6232 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6234 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6235 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6239 do ilist=1,ishield_list(j)
6240 iresshield=shield_list(ilist,j)
6242 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6244 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6246 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6247 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6251 do ilist=1,ishield_list(k)
6252 iresshield=shield_list(ilist,k)
6254 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6256 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6258 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6259 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6263 do ilist=1,ishield_list(l)
6264 iresshield=shield_list(ilist,l)
6266 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6268 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6270 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6271 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6275 C print *,gshieldx(m,iresshield)
6277 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6278 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6279 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6280 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6281 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6282 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6283 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6284 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6286 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6287 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6288 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6289 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6290 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6291 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6292 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6293 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6302 C---------------------------------------------------------------------------
6303 subroutine dipole(i,j,jj)
6304 implicit real*8 (a-h,o-z)
6305 include 'DIMENSIONS'
6306 include 'sizesclu.dat'
6307 include 'COMMON.IOUNITS'
6308 include 'COMMON.CHAIN'
6309 include 'COMMON.FFIELD'
6310 include 'COMMON.DERIV'
6311 include 'COMMON.INTERACT'
6312 include 'COMMON.CONTACTS'
6313 include 'COMMON.TORSION'
6314 include 'COMMON.VAR'
6315 include 'COMMON.GEO'
6316 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6318 iti1 = itortyp(itype(i+1))
6319 if (j.lt.nres-1) then
6320 if (itype(j).le.ntyp) then
6321 itj1 = itortyp(itype(j+1))
6329 dipi(iii,1)=Ub2(iii,i)
6330 dipderi(iii)=Ub2der(iii,i)
6331 dipi(iii,2)=b1(iii,iti1)
6332 dipj(iii,1)=Ub2(iii,j)
6333 dipderj(iii)=Ub2der(iii,j)
6334 dipj(iii,2)=b1(iii,itj1)
6338 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6341 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6344 if (.not.calc_grad) return
6349 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6353 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6358 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6359 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6361 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6363 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6365 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6369 C---------------------------------------------------------------------------
6370 subroutine calc_eello(i,j,k,l,jj,kk)
6372 C This subroutine computes matrices and vectors needed to calculate
6373 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6375 implicit real*8 (a-h,o-z)
6376 include 'DIMENSIONS'
6377 include 'sizesclu.dat'
6378 include 'COMMON.IOUNITS'
6379 include 'COMMON.CHAIN'
6380 include 'COMMON.DERIV'
6381 include 'COMMON.INTERACT'
6382 include 'COMMON.CONTACTS'
6383 include 'COMMON.TORSION'
6384 include 'COMMON.VAR'
6385 include 'COMMON.GEO'
6386 include 'COMMON.FFIELD'
6387 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6388 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6391 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6392 cd & ' jj=',jj,' kk=',kk
6393 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6396 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6397 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6400 call transpose2(aa1(1,1),aa1t(1,1))
6401 call transpose2(aa2(1,1),aa2t(1,1))
6404 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6405 & aa1tder(1,1,lll,kkk))
6406 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6407 & aa2tder(1,1,lll,kkk))
6411 C parallel orientation of the two CA-CA-CA frames.
6413 if (i.gt.1 .and. itype(i).le.ntyp) then
6414 iti=itortyp(itype(i))
6418 itk1=itortyp(itype(k+1))
6419 itj=itortyp(itype(j))
6420 c if (l.lt.nres-1) then
6421 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6422 itl1=itortyp(itype(l+1))
6426 C A1 kernel(j+1) A2T
6428 cd write (iout,'(3f10.5,5x,3f10.5)')
6429 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
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.,EUg(1,1,l),EUgder(1,1,l),
6433 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6434 C Following matrices are needed only for 6-th order cumulants
6435 IF (wcorr6.gt.0.0d0) THEN
6436 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6437 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6438 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(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.,Ug2DtEUg(1,1,l),
6441 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6442 & ADtEAderx(1,1,1,1,1,1))
6444 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6445 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6446 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6447 & ADtEA1derx(1,1,1,1,1,1))
6449 C End 6-th order cumulants
6452 cd write (2,*) 'In calc_eello6'
6454 cd write (2,*) 'iii=',iii
6456 cd write (2,*) 'kkk=',kkk
6458 cd write (2,'(3(2f10.5),5x)')
6459 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6464 call transpose2(EUgder(1,1,k),auxmat(1,1))
6465 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6466 call transpose2(EUg(1,1,k),auxmat(1,1))
6467 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6468 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6473 & EAEAderx(1,1,lll,kkk,iii,1))
6477 C A1T kernel(i+1) A2
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.,EUg(1,1,k),EUgder(1,1,k),
6480 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6481 C Following matrices are needed only for 6-th order cumulants
6482 IF (wcorr6.gt.0.0d0) THEN
6483 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6484 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6485 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6486 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6487 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6488 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6489 & ADtEAderx(1,1,1,1,1,2))
6490 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6491 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6492 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6493 & ADtEA1derx(1,1,1,1,1,2))
6495 C End 6-th order cumulants
6496 call transpose2(EUgder(1,1,l),auxmat(1,1))
6497 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6498 call transpose2(EUg(1,1,l),auxmat(1,1))
6499 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6500 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6504 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6505 & EAEAderx(1,1,lll,kkk,iii,2))
6510 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6511 C They are needed only when the fifth- or the sixth-order cumulants are
6513 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6514 call transpose2(AEA(1,1,1),auxmat(1,1))
6515 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6516 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6517 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6518 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6519 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6520 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6521 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6522 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6523 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6524 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6525 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6526 call transpose2(AEA(1,1,2),auxmat(1,1))
6527 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6528 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6529 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6530 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6531 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6532 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6533 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6534 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6535 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6536 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6537 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6538 C Calculate the Cartesian derivatives of the vectors.
6542 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6543 call matvec2(auxmat(1,1),b1(1,iti),
6544 & AEAb1derx(1,lll,kkk,iii,1,1))
6545 call matvec2(auxmat(1,1),Ub2(1,i),
6546 & AEAb2derx(1,lll,kkk,iii,1,1))
6547 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6548 & AEAb1derx(1,lll,kkk,iii,2,1))
6549 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6550 & AEAb2derx(1,lll,kkk,iii,2,1))
6551 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6552 call matvec2(auxmat(1,1),b1(1,itj),
6553 & AEAb1derx(1,lll,kkk,iii,1,2))
6554 call matvec2(auxmat(1,1),Ub2(1,j),
6555 & AEAb2derx(1,lll,kkk,iii,1,2))
6556 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6557 & AEAb1derx(1,lll,kkk,iii,2,2))
6558 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6559 & AEAb2derx(1,lll,kkk,iii,2,2))
6566 C Antiparallel orientation of the two CA-CA-CA frames.
6568 if (i.gt.1 .and. itype(i).le.ntyp) then
6569 iti=itortyp(itype(i))
6573 itk1=itortyp(itype(k+1))
6574 itl=itortyp(itype(l))
6575 itj=itortyp(itype(j))
6576 c if (j.lt.nres-1) then
6577 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6578 itj1=itortyp(itype(j+1))
6582 C A2 kernel(j-1)T A1T
6583 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6584 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6585 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6586 C Following matrices are needed only for 6-th order cumulants
6587 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6588 & j.eq.i+4 .and. l.eq.i+3)) THEN
6589 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6590 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6591 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6592 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6593 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6594 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6595 & ADtEAderx(1,1,1,1,1,1))
6596 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6597 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6598 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6599 & ADtEA1derx(1,1,1,1,1,1))
6601 C End 6-th order cumulants
6602 call transpose2(EUgder(1,1,k),auxmat(1,1))
6603 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6604 call transpose2(EUg(1,1,k),auxmat(1,1))
6605 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6606 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6610 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6611 & EAEAderx(1,1,lll,kkk,iii,1))
6615 C A2T kernel(i+1)T A1
6616 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6617 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6618 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6619 C Following matrices are needed only for 6-th order cumulants
6620 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6621 & j.eq.i+4 .and. l.eq.i+3)) THEN
6622 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6623 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6624 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6625 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6626 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6627 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6628 & ADtEAderx(1,1,1,1,1,2))
6629 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6630 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6631 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6632 & ADtEA1derx(1,1,1,1,1,2))
6634 C End 6-th order cumulants
6635 call transpose2(EUgder(1,1,j),auxmat(1,1))
6636 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6637 call transpose2(EUg(1,1,j),auxmat(1,1))
6638 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6639 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6643 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6644 & EAEAderx(1,1,lll,kkk,iii,2))
6649 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6650 C They are needed only when the fifth- or the sixth-order cumulants are
6652 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6653 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6654 call transpose2(AEA(1,1,1),auxmat(1,1))
6655 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6656 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6657 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6658 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6659 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6660 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6661 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6662 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6663 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6664 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6665 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6666 call transpose2(AEA(1,1,2),auxmat(1,1))
6667 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6668 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6669 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6670 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6671 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6672 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6673 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6674 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6675 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6676 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6677 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6678 C Calculate the Cartesian derivatives of the vectors.
6682 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6683 call matvec2(auxmat(1,1),b1(1,iti),
6684 & AEAb1derx(1,lll,kkk,iii,1,1))
6685 call matvec2(auxmat(1,1),Ub2(1,i),
6686 & AEAb2derx(1,lll,kkk,iii,1,1))
6687 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6688 & AEAb1derx(1,lll,kkk,iii,2,1))
6689 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6690 & AEAb2derx(1,lll,kkk,iii,2,1))
6691 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6692 call matvec2(auxmat(1,1),b1(1,itl),
6693 & AEAb1derx(1,lll,kkk,iii,1,2))
6694 call matvec2(auxmat(1,1),Ub2(1,l),
6695 & AEAb2derx(1,lll,kkk,iii,1,2))
6696 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6697 & AEAb1derx(1,lll,kkk,iii,2,2))
6698 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6699 & AEAb2derx(1,lll,kkk,iii,2,2))
6708 C---------------------------------------------------------------------------
6709 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6710 & KK,KKderg,AKA,AKAderg,AKAderx)
6714 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6715 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6716 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6721 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6723 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6726 cd if (lprn) write (2,*) 'In kernel'
6728 cd if (lprn) write (2,*) 'kkk=',kkk
6730 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6731 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6733 cd write (2,*) 'lll=',lll
6734 cd write (2,*) 'iii=1'
6736 cd write (2,'(3(2f10.5),5x)')
6737 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6740 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6741 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6743 cd write (2,*) 'lll=',lll
6744 cd write (2,*) 'iii=2'
6746 cd write (2,'(3(2f10.5),5x)')
6747 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6754 C---------------------------------------------------------------------------
6755 double precision function eello4(i,j,k,l,jj,kk)
6756 implicit real*8 (a-h,o-z)
6757 include 'DIMENSIONS'
6758 include 'sizesclu.dat'
6759 include 'COMMON.IOUNITS'
6760 include 'COMMON.CHAIN'
6761 include 'COMMON.DERIV'
6762 include 'COMMON.INTERACT'
6763 include 'COMMON.CONTACTS'
6764 include 'COMMON.TORSION'
6765 include 'COMMON.VAR'
6766 include 'COMMON.GEO'
6767 double precision pizda(2,2),ggg1(3),ggg2(3)
6768 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6772 cd print *,'eello4:',i,j,k,l,jj,kk
6773 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6774 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6775 cold eij=facont_hb(jj,i)
6776 cold ekl=facont_hb(kk,k)
6778 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6780 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6781 gcorr_loc(k-1)=gcorr_loc(k-1)
6782 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6784 gcorr_loc(l-1)=gcorr_loc(l-1)
6785 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6787 gcorr_loc(j-1)=gcorr_loc(j-1)
6788 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6793 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6794 & -EAEAderx(2,2,lll,kkk,iii,1)
6795 cd derx(lll,kkk,iii)=0.0d0
6799 cd gcorr_loc(l-1)=0.0d0
6800 cd gcorr_loc(j-1)=0.0d0
6801 cd gcorr_loc(k-1)=0.0d0
6803 cd write (iout,*)'Contacts have occurred for peptide groups',
6804 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6805 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6806 if (j.lt.nres-1) then
6813 if (l.lt.nres-1) then
6821 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6822 ggg1(ll)=eel4*g_contij(ll,1)
6823 ggg2(ll)=eel4*g_contij(ll,2)
6824 ghalf=0.5d0*ggg1(ll)
6826 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6827 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6828 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6829 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6830 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6831 ghalf=0.5d0*ggg2(ll)
6833 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6834 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6835 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6836 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6841 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6842 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6847 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6848 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6854 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6859 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6863 cd write (2,*) iii,gcorr_loc(iii)
6867 cd write (2,*) 'ekont',ekont
6868 cd write (iout,*) 'eello4',ekont*eel4
6871 C---------------------------------------------------------------------------
6872 double precision function eello5(i,j,k,l,jj,kk)
6873 implicit real*8 (a-h,o-z)
6874 include 'DIMENSIONS'
6875 include 'sizesclu.dat'
6876 include 'COMMON.IOUNITS'
6877 include 'COMMON.CHAIN'
6878 include 'COMMON.DERIV'
6879 include 'COMMON.INTERACT'
6880 include 'COMMON.CONTACTS'
6881 include 'COMMON.TORSION'
6882 include 'COMMON.VAR'
6883 include 'COMMON.GEO'
6884 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6885 double precision ggg1(3),ggg2(3)
6886 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6891 C /l\ / \ \ / \ / \ / C
6892 C / \ / \ \ / \ / \ / C
6893 C j| o |l1 | o | o| o | | o |o C
6894 C \ |/k\| |/ \| / |/ \| |/ \| C
6895 C \i/ \ / \ / / \ / \ C
6897 C (I) (II) (III) (IV) C
6899 C eello5_1 eello5_2 eello5_3 eello5_4 C
6901 C Antiparallel chains C
6904 C /j\ / \ \ / \ / \ / C
6905 C / \ / \ \ / \ / \ / C
6906 C j1| o |l | o | o| o | | o |o C
6907 C \ |/k\| |/ \| / |/ \| |/ \| C
6908 C \i/ \ / \ / / \ / \ C
6910 C (I) (II) (III) (IV) C
6912 C eello5_1 eello5_2 eello5_3 eello5_4 C
6914 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6916 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6917 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6922 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6924 itk=itortyp(itype(k))
6925 itl=itortyp(itype(l))
6926 itj=itortyp(itype(j))
6931 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6932 cd & eel5_3_num,eel5_4_num)
6936 derx(lll,kkk,iii)=0.0d0
6940 cd eij=facont_hb(jj,i)
6941 cd ekl=facont_hb(kk,k)
6943 cd write (iout,*)'Contacts have occurred for peptide groups',
6944 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6946 C Contribution from the graph I.
6947 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6948 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6949 call transpose2(EUg(1,1,k),auxmat(1,1))
6950 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6951 vv(1)=pizda(1,1)-pizda(2,2)
6952 vv(2)=pizda(1,2)+pizda(2,1)
6953 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6954 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6956 C Explicit gradient in virtual-dihedral angles.
6957 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6958 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6959 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6960 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6961 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6962 vv(1)=pizda(1,1)-pizda(2,2)
6963 vv(2)=pizda(1,2)+pizda(2,1)
6964 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6965 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6966 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6967 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6968 vv(1)=pizda(1,1)-pizda(2,2)
6969 vv(2)=pizda(1,2)+pizda(2,1)
6971 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6972 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6973 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6975 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6976 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6977 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6979 C Cartesian gradient
6983 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6985 vv(1)=pizda(1,1)-pizda(2,2)
6986 vv(2)=pizda(1,2)+pizda(2,1)
6987 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6988 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6989 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6996 C Contribution from graph II
6997 call transpose2(EE(1,1,itk),auxmat(1,1))
6998 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6999 vv(1)=pizda(1,1)+pizda(2,2)
7000 vv(2)=pizda(2,1)-pizda(1,2)
7001 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7002 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7004 C Explicit gradient in virtual-dihedral angles.
7005 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7006 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7007 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7008 vv(1)=pizda(1,1)+pizda(2,2)
7009 vv(2)=pizda(2,1)-pizda(1,2)
7011 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7012 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7013 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7015 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7016 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7017 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7019 C Cartesian gradient
7023 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7025 vv(1)=pizda(1,1)+pizda(2,2)
7026 vv(2)=pizda(2,1)-pizda(1,2)
7027 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7028 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7029 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7038 C Parallel orientation
7039 C Contribution from graph III
7040 call transpose2(EUg(1,1,l),auxmat(1,1))
7041 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7042 vv(1)=pizda(1,1)-pizda(2,2)
7043 vv(2)=pizda(1,2)+pizda(2,1)
7044 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7045 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7047 C Explicit gradient in virtual-dihedral angles.
7048 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7049 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7050 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7051 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7052 vv(1)=pizda(1,1)-pizda(2,2)
7053 vv(2)=pizda(1,2)+pizda(2,1)
7054 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7055 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7056 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7057 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7058 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7059 vv(1)=pizda(1,1)-pizda(2,2)
7060 vv(2)=pizda(1,2)+pizda(2,1)
7061 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7062 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7063 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7064 C Cartesian gradient
7068 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7070 vv(1)=pizda(1,1)-pizda(2,2)
7071 vv(2)=pizda(1,2)+pizda(2,1)
7072 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7073 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7074 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7080 C Contribution from graph IV
7082 call transpose2(EE(1,1,itl),auxmat(1,1))
7083 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7084 vv(1)=pizda(1,1)+pizda(2,2)
7085 vv(2)=pizda(2,1)-pizda(1,2)
7086 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7087 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7089 C Explicit gradient in virtual-dihedral angles.
7090 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7091 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7092 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7093 vv(1)=pizda(1,1)+pizda(2,2)
7094 vv(2)=pizda(2,1)-pizda(1,2)
7095 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7096 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7097 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7098 C Cartesian gradient
7102 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7104 vv(1)=pizda(1,1)+pizda(2,2)
7105 vv(2)=pizda(2,1)-pizda(1,2)
7106 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7107 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7108 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7114 C Antiparallel orientation
7115 C Contribution from graph III
7117 call transpose2(EUg(1,1,j),auxmat(1,1))
7118 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7119 vv(1)=pizda(1,1)-pizda(2,2)
7120 vv(2)=pizda(1,2)+pizda(2,1)
7121 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7122 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7124 C Explicit gradient in virtual-dihedral angles.
7125 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7126 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7127 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7128 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7129 vv(1)=pizda(1,1)-pizda(2,2)
7130 vv(2)=pizda(1,2)+pizda(2,1)
7131 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7132 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7133 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7134 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7135 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7136 vv(1)=pizda(1,1)-pizda(2,2)
7137 vv(2)=pizda(1,2)+pizda(2,1)
7138 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7139 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7140 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7141 C Cartesian gradient
7145 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7147 vv(1)=pizda(1,1)-pizda(2,2)
7148 vv(2)=pizda(1,2)+pizda(2,1)
7149 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7150 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7151 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7157 C Contribution from graph IV
7159 call transpose2(EE(1,1,itj),auxmat(1,1))
7160 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7161 vv(1)=pizda(1,1)+pizda(2,2)
7162 vv(2)=pizda(2,1)-pizda(1,2)
7163 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7164 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7166 C Explicit gradient in virtual-dihedral angles.
7167 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7168 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7169 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7170 vv(1)=pizda(1,1)+pizda(2,2)
7171 vv(2)=pizda(2,1)-pizda(1,2)
7172 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7173 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7174 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7175 C Cartesian gradient
7179 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7181 vv(1)=pizda(1,1)+pizda(2,2)
7182 vv(2)=pizda(2,1)-pizda(1,2)
7183 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7184 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7185 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7192 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7193 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7194 cd write (2,*) 'ijkl',i,j,k,l
7195 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7196 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7198 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7199 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7200 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7201 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7203 if (j.lt.nres-1) then
7210 if (l.lt.nres-1) then
7220 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7222 ggg1(ll)=eel5*g_contij(ll,1)
7223 ggg2(ll)=eel5*g_contij(ll,2)
7224 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7225 ghalf=0.5d0*ggg1(ll)
7227 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7228 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7229 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7230 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7231 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7232 ghalf=0.5d0*ggg2(ll)
7234 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7235 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7236 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7237 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7242 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7243 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7248 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7249 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7255 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7260 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7264 cd write (2,*) iii,g_corr5_loc(iii)
7268 cd write (2,*) 'ekont',ekont
7269 cd write (iout,*) 'eello5',ekont*eel5
7272 c--------------------------------------------------------------------------
7273 double precision function eello6(i,j,k,l,jj,kk)
7274 implicit real*8 (a-h,o-z)
7275 include 'DIMENSIONS'
7276 include 'sizesclu.dat'
7277 include 'COMMON.IOUNITS'
7278 include 'COMMON.CHAIN'
7279 include 'COMMON.DERIV'
7280 include 'COMMON.INTERACT'
7281 include 'COMMON.CONTACTS'
7282 include 'COMMON.TORSION'
7283 include 'COMMON.VAR'
7284 include 'COMMON.GEO'
7285 include 'COMMON.FFIELD'
7286 double precision ggg1(3),ggg2(3)
7287 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7292 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7300 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7301 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7305 derx(lll,kkk,iii)=0.0d0
7309 cd eij=facont_hb(jj,i)
7310 cd ekl=facont_hb(kk,k)
7316 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7317 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7318 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7319 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7320 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7321 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7323 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7324 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7325 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7326 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7327 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7328 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7332 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7334 C If turn contributions are considered, they will be handled separately.
7335 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7336 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7337 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7338 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7339 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7340 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7341 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7344 if (j.lt.nres-1) then
7351 if (l.lt.nres-1) then
7359 ggg1(ll)=eel6*g_contij(ll,1)
7360 ggg2(ll)=eel6*g_contij(ll,2)
7361 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7362 ghalf=0.5d0*ggg1(ll)
7364 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7365 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7366 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7367 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7368 ghalf=0.5d0*ggg2(ll)
7369 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7371 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7372 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7373 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7374 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7379 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7380 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7385 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7386 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7392 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7397 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7401 cd write (2,*) iii,g_corr6_loc(iii)
7405 cd write (2,*) 'ekont',ekont
7406 cd write (iout,*) 'eello6',ekont*eel6
7409 c--------------------------------------------------------------------------
7410 double precision function eello6_graph1(i,j,k,l,imat,swap)
7411 implicit real*8 (a-h,o-z)
7412 include 'DIMENSIONS'
7413 include 'sizesclu.dat'
7414 include 'COMMON.IOUNITS'
7415 include 'COMMON.CHAIN'
7416 include 'COMMON.DERIV'
7417 include 'COMMON.INTERACT'
7418 include 'COMMON.CONTACTS'
7419 include 'COMMON.TORSION'
7420 include 'COMMON.VAR'
7421 include 'COMMON.GEO'
7422 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7428 C Parallel Antiparallel C
7434 C \ j|/k\| / \ |/k\|l / C
7439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7440 itk=itortyp(itype(k))
7441 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7442 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7443 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7444 call transpose2(EUgC(1,1,k),auxmat(1,1))
7445 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7446 vv1(1)=pizda1(1,1)-pizda1(2,2)
7447 vv1(2)=pizda1(1,2)+pizda1(2,1)
7448 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7449 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7450 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7451 s5=scalar2(vv(1),Dtobr2(1,i))
7452 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7453 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7454 if (.not. calc_grad) return
7455 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7456 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7457 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7458 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7459 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7460 & +scalar2(vv(1),Dtobr2der(1,i)))
7461 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7462 vv1(1)=pizda1(1,1)-pizda1(2,2)
7463 vv1(2)=pizda1(1,2)+pizda1(2,1)
7464 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7465 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7467 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7468 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7469 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7470 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7471 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7473 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7474 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7475 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7476 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7477 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7479 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7480 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7481 vv1(1)=pizda1(1,1)-pizda1(2,2)
7482 vv1(2)=pizda1(1,2)+pizda1(2,1)
7483 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7484 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7485 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7486 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7495 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7496 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7497 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7498 call transpose2(EUgC(1,1,k),auxmat(1,1))
7499 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7501 vv1(1)=pizda1(1,1)-pizda1(2,2)
7502 vv1(2)=pizda1(1,2)+pizda1(2,1)
7503 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7504 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7505 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7506 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7507 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7508 s5=scalar2(vv(1),Dtobr2(1,i))
7509 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7515 c----------------------------------------------------------------------------
7516 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7517 implicit real*8 (a-h,o-z)
7518 include 'DIMENSIONS'
7519 include 'sizesclu.dat'
7520 include 'COMMON.IOUNITS'
7521 include 'COMMON.CHAIN'
7522 include 'COMMON.DERIV'
7523 include 'COMMON.INTERACT'
7524 include 'COMMON.CONTACTS'
7525 include 'COMMON.TORSION'
7526 include 'COMMON.VAR'
7527 include 'COMMON.GEO'
7529 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7530 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7535 C Parallel Antiparallel C
7541 C \ j|/k\| \ |/k\|l C
7546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7547 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7548 C AL 7/4/01 s1 would occur in the sixth-order moment,
7549 C but not in a cluster cumulant
7551 s1=dip(1,jj,i)*dip(1,kk,k)
7553 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7554 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7555 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7556 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7557 call transpose2(EUg(1,1,k),auxmat(1,1))
7558 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7559 vv(1)=pizda(1,1)-pizda(2,2)
7560 vv(2)=pizda(1,2)+pizda(2,1)
7561 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7562 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7564 eello6_graph2=-(s1+s2+s3+s4)
7566 eello6_graph2=-(s2+s3+s4)
7569 if (.not. calc_grad) return
7570 C Derivatives in gamma(i-1)
7573 s1=dipderg(1,jj,i)*dip(1,kk,k)
7575 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7576 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7577 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7578 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7580 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7582 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7584 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7586 C Derivatives in gamma(k-1)
7588 s1=dip(1,jj,i)*dipderg(1,kk,k)
7590 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7591 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7592 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7593 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7594 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7595 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7596 vv(1)=pizda(1,1)-pizda(2,2)
7597 vv(2)=pizda(1,2)+pizda(2,1)
7598 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7600 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7602 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7604 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7605 C Derivatives in gamma(j-1) or gamma(l-1)
7608 s1=dipderg(3,jj,i)*dip(1,kk,k)
7610 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7611 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7612 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7613 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7616 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7619 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7621 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7624 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7625 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7627 C Derivatives in gamma(l-1) or gamma(j-1)
7630 s1=dip(1,jj,i)*dipderg(3,kk,k)
7632 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7633 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7634 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7635 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7636 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7637 vv(1)=pizda(1,1)-pizda(2,2)
7638 vv(2)=pizda(1,2)+pizda(2,1)
7639 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7642 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7644 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7647 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7648 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7650 C Cartesian derivatives.
7652 write (2,*) 'In eello6_graph2'
7654 write (2,*) 'iii=',iii
7656 write (2,*) 'kkk=',kkk
7658 write (2,'(3(2f10.5),5x)')
7659 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7669 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7671 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7674 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7676 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7677 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7679 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7680 call transpose2(EUg(1,1,k),auxmat(1,1))
7681 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7683 vv(1)=pizda(1,1)-pizda(2,2)
7684 vv(2)=pizda(1,2)+pizda(2,1)
7685 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7686 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7688 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7693 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7695 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7702 c----------------------------------------------------------------------------
7703 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7704 implicit real*8 (a-h,o-z)
7705 include 'DIMENSIONS'
7706 include 'sizesclu.dat'
7707 include 'COMMON.IOUNITS'
7708 include 'COMMON.CHAIN'
7709 include 'COMMON.DERIV'
7710 include 'COMMON.INTERACT'
7711 include 'COMMON.CONTACTS'
7712 include 'COMMON.TORSION'
7713 include 'COMMON.VAR'
7714 include 'COMMON.GEO'
7715 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7717 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7719 C Parallel Antiparallel C
7725 C j|/k\| / |/k\|l / C
7730 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7732 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7733 C energy moment and not to the cluster cumulant.
7734 iti=itortyp(itype(i))
7735 c if (j.lt.nres-1) then
7736 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7737 itj1=itortyp(itype(j+1))
7741 itk=itortyp(itype(k))
7742 itk1=itortyp(itype(k+1))
7743 c if (l.lt.nres-1) then
7744 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7745 itl1=itortyp(itype(l+1))
7750 s1=dip(4,jj,i)*dip(4,kk,k)
7752 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7753 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7754 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7755 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7756 call transpose2(EE(1,1,itk),auxmat(1,1))
7757 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)+pizda(2,2)
7759 vv(2)=pizda(2,1)-pizda(1,2)
7760 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7761 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7763 eello6_graph3=-(s1+s2+s3+s4)
7765 eello6_graph3=-(s2+s3+s4)
7768 if (.not. calc_grad) return
7769 C Derivatives in gamma(k-1)
7770 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7771 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7772 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7773 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7774 C Derivatives in gamma(l-1)
7775 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7776 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7777 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7778 vv(1)=pizda(1,1)+pizda(2,2)
7779 vv(2)=pizda(2,1)-pizda(1,2)
7780 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7781 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7782 C Cartesian derivatives.
7788 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7790 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7793 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7795 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7796 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7798 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7799 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7801 vv(1)=pizda(1,1)+pizda(2,2)
7802 vv(2)=pizda(2,1)-pizda(1,2)
7803 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7805 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7807 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7810 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7812 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7814 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7820 c----------------------------------------------------------------------------
7821 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7822 implicit real*8 (a-h,o-z)
7823 include 'DIMENSIONS'
7824 include 'sizesclu.dat'
7825 include 'COMMON.IOUNITS'
7826 include 'COMMON.CHAIN'
7827 include 'COMMON.DERIV'
7828 include 'COMMON.INTERACT'
7829 include 'COMMON.CONTACTS'
7830 include 'COMMON.TORSION'
7831 include 'COMMON.VAR'
7832 include 'COMMON.GEO'
7833 include 'COMMON.FFIELD'
7834 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7835 & auxvec1(2),auxmat1(2,2)
7837 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7839 C Parallel Antiparallel C
7845 C \ j|/k\| \ |/k\|l C
7850 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7852 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7853 C energy moment and not to the cluster cumulant.
7854 cd write (2,*) 'eello_graph4: wturn6',wturn6
7855 iti=itortyp(itype(i))
7856 itj=itortyp(itype(j))
7857 c if (j.lt.nres-1) then
7858 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7859 itj1=itortyp(itype(j+1))
7863 itk=itortyp(itype(k))
7864 c if (k.lt.nres-1) then
7865 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7866 itk1=itortyp(itype(k+1))
7870 itl=itortyp(itype(l))
7871 if (l.lt.nres-1) then
7872 itl1=itortyp(itype(l+1))
7876 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7877 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7878 cd & ' itl',itl,' itl1',itl1
7881 s1=dip(3,jj,i)*dip(3,kk,k)
7883 s1=dip(2,jj,j)*dip(2,kk,l)
7886 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7887 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7889 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7890 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7892 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7893 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7895 call transpose2(EUg(1,1,k),auxmat(1,1))
7896 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7897 vv(1)=pizda(1,1)-pizda(2,2)
7898 vv(2)=pizda(2,1)+pizda(1,2)
7899 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7900 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7902 eello6_graph4=-(s1+s2+s3+s4)
7904 eello6_graph4=-(s2+s3+s4)
7906 if (.not. calc_grad) return
7907 C Derivatives in gamma(i-1)
7911 s1=dipderg(2,jj,i)*dip(3,kk,k)
7913 s1=dipderg(4,jj,j)*dip(2,kk,l)
7916 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7918 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7919 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7921 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7922 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7924 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7925 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7926 cd write (2,*) 'turn6 derivatives'
7928 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7930 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7934 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7936 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7940 C Derivatives in gamma(k-1)
7943 s1=dip(3,jj,i)*dipderg(2,kk,k)
7945 s1=dip(2,jj,j)*dipderg(4,kk,l)
7948 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7949 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7951 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7952 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7954 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7955 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7957 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7958 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7959 vv(1)=pizda(1,1)-pizda(2,2)
7960 vv(2)=pizda(2,1)+pizda(1,2)
7961 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7962 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7964 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7966 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7970 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7975 C Derivatives in gamma(j-1) or gamma(l-1)
7976 if (l.eq.j+1 .and. l.gt.1) then
7977 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7978 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7979 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7980 vv(1)=pizda(1,1)-pizda(2,2)
7981 vv(2)=pizda(2,1)+pizda(1,2)
7982 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7983 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7984 else if (j.gt.1) then
7985 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7986 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7987 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7988 vv(1)=pizda(1,1)-pizda(2,2)
7989 vv(2)=pizda(2,1)+pizda(1,2)
7990 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7991 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7992 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7994 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7997 C Cartesian derivatives.
8004 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8006 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8010 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8012 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8016 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8018 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8020 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8021 & b1(1,itj1),auxvec(1))
8022 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8024 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8025 & b1(1,itl1),auxvec(1))
8026 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8028 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8030 vv(1)=pizda(1,1)-pizda(2,2)
8031 vv(2)=pizda(2,1)+pizda(1,2)
8032 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8034 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8036 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8039 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8042 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8045 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8047 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8049 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8053 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8055 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8058 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8060 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8068 c----------------------------------------------------------------------------
8069 double precision function eello_turn6(i,jj,kk)
8070 implicit real*8 (a-h,o-z)
8071 include 'DIMENSIONS'
8072 include 'sizesclu.dat'
8073 include 'COMMON.IOUNITS'
8074 include 'COMMON.CHAIN'
8075 include 'COMMON.DERIV'
8076 include 'COMMON.INTERACT'
8077 include 'COMMON.CONTACTS'
8078 include 'COMMON.TORSION'
8079 include 'COMMON.VAR'
8080 include 'COMMON.GEO'
8081 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8082 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8084 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8085 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8086 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8087 C the respective energy moment and not to the cluster cumulant.
8092 iti=itortyp(itype(i))
8093 itk=itortyp(itype(k))
8094 itk1=itortyp(itype(k+1))
8095 itl=itortyp(itype(l))
8096 itj=itortyp(itype(j))
8097 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8098 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8099 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8104 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8106 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8110 derx_turn(lll,kkk,iii)=0.0d0
8117 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8119 cd write (2,*) 'eello6_5',eello6_5
8121 call transpose2(AEA(1,1,1),auxmat(1,1))
8122 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8123 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8124 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8128 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8129 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8130 s2 = scalar2(b1(1,itk),vtemp1(1))
8132 call transpose2(AEA(1,1,2),atemp(1,1))
8133 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8134 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8135 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8139 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8140 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8141 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8143 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8144 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8145 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8146 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8147 ss13 = scalar2(b1(1,itk),vtemp4(1))
8148 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8152 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8158 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8160 C Derivatives in gamma(i+2)
8162 call transpose2(AEA(1,1,1),auxmatd(1,1))
8163 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8164 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8165 call transpose2(AEAderg(1,1,2),atempd(1,1))
8166 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8167 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8171 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8172 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8173 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8179 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8180 C Derivatives in gamma(i+3)
8182 call transpose2(AEA(1,1,1),auxmatd(1,1))
8183 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8184 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8185 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8189 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8190 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8191 s2d = scalar2(b1(1,itk),vtemp1d(1))
8193 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8194 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8196 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8198 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8199 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8200 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8210 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8211 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8213 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8214 & -0.5d0*ekont*(s2d+s12d)
8216 C Derivatives in gamma(i+4)
8217 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8218 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8219 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8221 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8222 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8223 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8233 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8235 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8237 C Derivatives in gamma(i+5)
8239 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8240 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8241 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8245 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8246 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8247 s2d = scalar2(b1(1,itk),vtemp1d(1))
8249 call transpose2(AEA(1,1,2),atempd(1,1))
8250 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8251 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8255 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8256 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8258 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8259 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8260 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8270 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8271 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8273 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8274 & -0.5d0*ekont*(s2d+s12d)
8276 C Cartesian derivatives
8281 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8282 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8283 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8287 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8288 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8290 s2d = scalar2(b1(1,itk),vtemp1d(1))
8292 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8293 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8294 s8d = -(atempd(1,1)+atempd(2,2))*
8295 & scalar2(cc(1,1,itl),vtemp2(1))
8299 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8301 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8302 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8309 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8312 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8316 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8317 & - 0.5d0*(s8d+s12d)
8319 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8328 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8330 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8331 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8332 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8333 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8334 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8336 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8337 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8338 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8342 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8343 cd & 16*eel_turn6_num
8345 if (j.lt.nres-1) then
8352 if (l.lt.nres-1) then
8360 ggg1(ll)=eel_turn6*g_contij(ll,1)
8361 ggg2(ll)=eel_turn6*g_contij(ll,2)
8362 ghalf=0.5d0*ggg1(ll)
8364 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8365 & +ekont*derx_turn(ll,2,1)
8366 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8367 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8368 & +ekont*derx_turn(ll,4,1)
8369 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8370 ghalf=0.5d0*ggg2(ll)
8372 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8373 & +ekont*derx_turn(ll,2,2)
8374 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8375 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8376 & +ekont*derx_turn(ll,4,2)
8377 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8382 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8387 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8393 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8398 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8402 cd write (2,*) iii,g_corr6_loc(iii)
8405 eello_turn6=ekont*eel_turn6
8406 cd write (2,*) 'ekont',ekont
8407 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8410 crc-------------------------------------------------
8411 SUBROUTINE MATVEC2(A1,V1,V2)
8412 implicit real*8 (a-h,o-z)
8413 include 'DIMENSIONS'
8414 DIMENSION A1(2,2),V1(2),V2(2)
8418 c 3 VI=VI+A1(I,K)*V1(K)
8422 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8423 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8428 C---------------------------------------
8429 SUBROUTINE MATMAT2(A1,A2,A3)
8430 implicit real*8 (a-h,o-z)
8431 include 'DIMENSIONS'
8432 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8433 c DIMENSION AI3(2,2)
8437 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8443 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8444 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8445 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8446 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8454 c-------------------------------------------------------------------------
8455 double precision function scalar2(u,v)
8457 double precision u(2),v(2)
8460 scalar2=u(1)*v(1)+u(2)*v(2)
8464 C-----------------------------------------------------------------------------
8466 subroutine transpose2(a,at)
8468 double precision a(2,2),at(2,2)
8475 c--------------------------------------------------------------------------
8476 subroutine transpose(n,a,at)
8479 double precision a(n,n),at(n,n)
8487 C---------------------------------------------------------------------------
8488 subroutine prodmat3(a1,a2,kk,transp,prod)
8491 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8493 crc double precision auxmat(2,2),prod_(2,2)
8496 crc call transpose2(kk(1,1),auxmat(1,1))
8497 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8498 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8500 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8501 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8502 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8503 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8504 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8505 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8506 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8507 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8510 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8511 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8513 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8514 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8515 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8516 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8517 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8518 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8519 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8520 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8523 c call transpose2(a2(1,1),a2t(1,1))
8526 crc print *,((prod_(i,j),i=1,2),j=1,2)
8527 crc print *,((prod(i,j),i=1,2),j=1,2)
8531 C-----------------------------------------------------------------------------
8532 double precision function scalar(u,v)
8534 double precision u(3),v(3)
8544 C-----------------------------------------------------------------------
8545 double precision function sscale(r)
8546 double precision r,gamm
8547 include "COMMON.SPLITELE"
8548 if(r.lt.r_cut-rlamb) then
8550 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8551 gamm=(r-(r_cut-rlamb))/rlamb
8552 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8558 C-----------------------------------------------------------------------
8559 C-----------------------------------------------------------------------
8560 double precision function sscagrad(r)
8561 double precision r,gamm
8562 include "COMMON.SPLITELE"
8563 if(r.lt.r_cut-rlamb) then
8565 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8566 gamm=(r-(r_cut-rlamb))/rlamb
8567 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8573 C-----------------------------------------------------------------------
8574 C first for shielding is setting of function of side-chains
8575 subroutine set_shield_fac2
8576 implicit real*8 (a-h,o-z)
8577 include 'DIMENSIONS'
8578 include 'COMMON.CHAIN'
8579 include 'COMMON.DERIV'
8580 include 'COMMON.IOUNITS'
8581 include 'COMMON.SHIELD'
8582 include 'COMMON.INTERACT'
8583 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8584 double precision div77_81/0.974996043d0/,
8585 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8587 C the vector between center of side_chain and peptide group
8588 double precision pep_side(3),long,side_calf(3),
8589 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8590 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8591 C the line belowe needs to be changed for FGPROC>1
8593 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8595 Cif there two consequtive dummy atoms there is no peptide group between them
8596 C the line below has to be changed for FGPROC>1
8599 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8603 C first lets set vector conecting the ithe side-chain with kth side-chain
8604 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8606 C and vector conecting the side-chain with its proper calfa
8607 side_calf(j)=c(j,k+nres)-c(j,k)
8608 C side_calf(j)=2.0d0
8609 pept_group(j)=c(j,i)-c(j,i+1)
8610 C lets have their lenght
8611 dist_pep_side=pep_side(j)**2+dist_pep_side
8612 dist_side_calf=dist_side_calf+side_calf(j)**2
8613 dist_pept_group=dist_pept_group+pept_group(j)**2
8615 dist_pep_side=dsqrt(dist_pep_side)
8616 dist_pept_group=dsqrt(dist_pept_group)
8617 dist_side_calf=dsqrt(dist_side_calf)
8619 pep_side_norm(j)=pep_side(j)/dist_pep_side
8620 side_calf_norm(j)=dist_side_calf
8622 C now sscale fraction
8623 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8624 C print *,buff_shield,"buff"
8626 if (sh_frac_dist.le.0.0) cycle
8627 C If we reach here it means that this side chain reaches the shielding sphere
8628 C Lets add him to the list for gradient
8629 ishield_list(i)=ishield_list(i)+1
8630 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8631 C this list is essential otherwise problem would be O3
8632 shield_list(ishield_list(i),i)=k
8633 C Lets have the sscale value
8634 if (sh_frac_dist.gt.1.0) then
8635 scale_fac_dist=1.0d0
8637 sh_frac_dist_grad(j)=0.0d0
8640 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8641 & *(2.0d0*sh_frac_dist-3.0d0)
8642 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8643 & /dist_pep_side/buff_shield*0.5d0
8644 C remember for the final gradient multiply sh_frac_dist_grad(j)
8645 C for side_chain by factor -2 !
8647 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8648 C sh_frac_dist_grad(j)=0.0d0
8649 C scale_fac_dist=1.0d0
8650 C print *,"jestem",scale_fac_dist,fac_help_scale,
8651 C & sh_frac_dist_grad(j)
8654 C this is what is now we have the distance scaling now volume...
8655 short=short_r_sidechain(itype(k))
8656 long=long_r_sidechain(itype(k))
8657 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8658 sinthet=short/dist_pep_side*costhet
8662 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8663 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8664 C & -short/dist_pep_side**2/costhet)
8667 costhet_grad(j)=costhet_fac*pep_side(j)
8669 C remember for the final gradient multiply costhet_grad(j)
8670 C for side_chain by factor -2 !
8671 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8672 C pep_side0pept_group is vector multiplication
8673 pep_side0pept_group=0.0d0
8675 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8677 cosalfa=(pep_side0pept_group/
8678 & (dist_pep_side*dist_side_calf))
8679 fac_alfa_sin=1.0d0-cosalfa**2
8680 fac_alfa_sin=dsqrt(fac_alfa_sin)
8681 rkprim=fac_alfa_sin*(long-short)+short
8685 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8687 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8688 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8692 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8693 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8694 &*(long-short)/fac_alfa_sin*cosalfa/
8695 &((dist_pep_side*dist_side_calf))*
8696 &((side_calf(j))-cosalfa*
8697 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8698 C cosphi_grad_long(j)=0.0d0
8699 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8700 &*(long-short)/fac_alfa_sin*cosalfa
8701 &/((dist_pep_side*dist_side_calf))*
8703 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8704 C cosphi_grad_loc(j)=0.0d0
8706 C print *,sinphi,sinthet
8707 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8710 C now the gradient...
8712 grad_shield(j,i)=grad_shield(j,i)
8713 C gradient po skalowaniu
8714 & +(sh_frac_dist_grad(j)*VofOverlap
8715 C gradient po costhet
8716 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8717 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8718 & sinphi/sinthet*costhet*costhet_grad(j)
8719 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8721 C grad_shield_side is Cbeta sidechain gradient
8722 grad_shield_side(j,ishield_list(i),i)=
8723 & (sh_frac_dist_grad(j)*-2.0d0
8725 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8726 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8727 & sinphi/sinthet*costhet*costhet_grad(j)
8728 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8731 grad_shield_loc(j,ishield_list(i),i)=
8732 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8733 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8734 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8738 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8740 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8741 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8745 C first for shielding is setting of function of side-chains
8746 subroutine set_shield_fac
8747 implicit real*8 (a-h,o-z)
8748 include 'DIMENSIONS'
8749 include 'COMMON.CHAIN'
8750 include 'COMMON.DERIV'
8751 include 'COMMON.IOUNITS'
8752 include 'COMMON.SHIELD'
8753 include 'COMMON.INTERACT'
8754 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8755 double precision div77_81/0.974996043d0/,
8756 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8758 C the vector between center of side_chain and peptide group
8759 double precision pep_side(3),long,side_calf(3),
8760 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8761 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8762 C the line belowe needs to be changed for FGPROC>1
8764 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8766 Cif there two consequtive dummy atoms there is no peptide group between them
8767 C the line below has to be changed for FGPROC>1
8770 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8774 C first lets set vector conecting the ithe side-chain with kth side-chain
8775 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8777 C and vector conecting the side-chain with its proper calfa
8778 side_calf(j)=c(j,k+nres)-c(j,k)
8779 C side_calf(j)=2.0d0
8780 pept_group(j)=c(j,i)-c(j,i+1)
8781 C lets have their lenght
8782 dist_pep_side=pep_side(j)**2+dist_pep_side
8783 dist_side_calf=dist_side_calf+side_calf(j)**2
8784 dist_pept_group=dist_pept_group+pept_group(j)**2
8786 dist_pep_side=dsqrt(dist_pep_side)
8787 dist_pept_group=dsqrt(dist_pept_group)
8788 dist_side_calf=dsqrt(dist_side_calf)
8790 pep_side_norm(j)=pep_side(j)/dist_pep_side
8791 side_calf_norm(j)=dist_side_calf
8793 C now sscale fraction
8794 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8795 C print *,buff_shield,"buff"
8797 if (sh_frac_dist.le.0.0) cycle
8798 C If we reach here it means that this side chain reaches the shielding sphere
8799 C Lets add him to the list for gradient
8800 ishield_list(i)=ishield_list(i)+1
8801 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8802 C this list is essential otherwise problem would be O3
8803 shield_list(ishield_list(i),i)=k
8804 C Lets have the sscale value
8805 if (sh_frac_dist.gt.1.0) then
8806 scale_fac_dist=1.0d0
8808 sh_frac_dist_grad(j)=0.0d0
8811 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8812 & *(2.0*sh_frac_dist-3.0d0)
8813 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8814 & /dist_pep_side/buff_shield*0.5
8815 C remember for the final gradient multiply sh_frac_dist_grad(j)
8816 C for side_chain by factor -2 !
8818 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8819 C print *,"jestem",scale_fac_dist,fac_help_scale,
8820 C & sh_frac_dist_grad(j)
8823 C if ((i.eq.3).and.(k.eq.2)) then
8824 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8828 C this is what is now we have the distance scaling now volume...
8829 short=short_r_sidechain(itype(k))
8830 long=long_r_sidechain(itype(k))
8831 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8834 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8837 costhet_grad(j)=costhet_fac*pep_side(j)
8839 C remember for the final gradient multiply costhet_grad(j)
8840 C for side_chain by factor -2 !
8841 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8842 C pep_side0pept_group is vector multiplication
8843 pep_side0pept_group=0.0
8845 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8847 cosalfa=(pep_side0pept_group/
8848 & (dist_pep_side*dist_side_calf))
8849 fac_alfa_sin=1.0-cosalfa**2
8850 fac_alfa_sin=dsqrt(fac_alfa_sin)
8851 rkprim=fac_alfa_sin*(long-short)+short
8853 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8854 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8857 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8858 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8859 &*(long-short)/fac_alfa_sin*cosalfa/
8860 &((dist_pep_side*dist_side_calf))*
8861 &((side_calf(j))-cosalfa*
8862 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8864 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8865 &*(long-short)/fac_alfa_sin*cosalfa
8866 &/((dist_pep_side*dist_side_calf))*
8868 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8871 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8874 C now the gradient...
8875 C grad_shield is gradient of Calfa for peptide groups
8876 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8878 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8879 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8881 grad_shield(j,i)=grad_shield(j,i)
8882 C gradient po skalowaniu
8883 & +(sh_frac_dist_grad(j)
8884 C gradient po costhet
8885 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8886 &-scale_fac_dist*(cosphi_grad_long(j))
8887 &/(1.0-cosphi) )*div77_81
8889 C grad_shield_side is Cbeta sidechain gradient
8890 grad_shield_side(j,ishield_list(i),i)=
8891 & (sh_frac_dist_grad(j)*-2.0d0
8892 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8893 & +scale_fac_dist*(cosphi_grad_long(j))
8894 & *2.0d0/(1.0-cosphi))
8895 & *div77_81*VofOverlap
8897 grad_shield_loc(j,ishield_list(i),i)=
8898 & scale_fac_dist*cosphi_grad_loc(j)
8899 & *2.0d0/(1.0-cosphi)
8900 & *div77_81*VofOverlap
8902 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8904 fac_shield(i)=VolumeTotal*div77_81+div4_81
8905 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8909 C--------------------------------------------------------------------------
8910 C-----------------------------------------------------------------------
8911 double precision function sscalelip(r)
8912 double precision r,gamm
8913 include "COMMON.SPLITELE"
8914 C if(r.lt.r_cut-rlamb) then
8916 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8917 C gamm=(r-(r_cut-rlamb))/rlamb
8918 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8924 C-----------------------------------------------------------------------
8925 double precision function sscagradlip(r)
8926 double precision r,gamm
8927 include "COMMON.SPLITELE"
8928 C if(r.lt.r_cut-rlamb) then
8930 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8931 C gamm=(r-(r_cut-rlamb))/rlamb
8932 sscagradlip=r*(6*r-6.0d0)
8939 C-----------------------------------------------------------------------
8940 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8941 subroutine Eliptransfer(eliptran)
8942 implicit real*8 (a-h,o-z)
8943 include 'DIMENSIONS'
8944 include 'COMMON.GEO'
8945 include 'COMMON.VAR'
8946 include 'COMMON.LOCAL'
8947 include 'COMMON.CHAIN'
8948 include 'COMMON.DERIV'
8949 include 'COMMON.INTERACT'
8950 include 'COMMON.IOUNITS'
8951 include 'COMMON.CALC'
8952 include 'COMMON.CONTROL'
8953 include 'COMMON.SPLITELE'
8954 include 'COMMON.SBRIDGE'
8955 C this is done by Adasko
8959 C--bordliptop-- buffore starts
8960 C--bufliptop--- here true lipid starts
8962 C--buflipbot--- lipid ends buffore starts
8963 C--bordlipbot--buffore ends
8965 write(iout,*) "I am in?"
8968 if (itype(i).eq.ntyp1) cycle
8970 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8971 if (positi.le.0) positi=positi+boxzsize
8973 C first for peptide groups
8974 c for each residue check if it is in lipid or lipid water border area
8975 if ((positi.gt.bordlipbot)
8976 &.and.(positi.lt.bordliptop)) then
8977 C the energy transfer exist
8978 if (positi.lt.buflipbot) then
8979 C what fraction I am in
8981 & ((positi-bordlipbot)/lipbufthick)
8982 C lipbufthick is thickenes of lipid buffore
8983 sslip=sscalelip(fracinbuf)
8984 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8985 eliptran=eliptran+sslip*pepliptran
8986 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8987 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8988 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8989 elseif (positi.gt.bufliptop) then
8990 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8991 sslip=sscalelip(fracinbuf)
8992 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8993 eliptran=eliptran+sslip*pepliptran
8994 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8995 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8996 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8997 C print *, "doing sscalefor top part"
8998 C print *,i,sslip,fracinbuf,ssgradlip
9000 eliptran=eliptran+pepliptran
9001 C print *,"I am in true lipid"
9004 C eliptran=elpitran+0.0 ! I am in water
9007 C print *, "nic nie bylo w lipidzie?"
9008 C now multiply all by the peptide group transfer factor
9009 C eliptran=eliptran*pepliptran
9010 C now the same for side chains
9013 if (itype(i).eq.ntyp1) cycle
9014 positi=(mod(c(3,i+nres),boxzsize))
9015 if (positi.le.0) positi=positi+boxzsize
9016 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9017 c for each residue check if it is in lipid or lipid water border area
9018 C respos=mod(c(3,i+nres),boxzsize)
9019 C print *,positi,bordlipbot,buflipbot
9020 if ((positi.gt.bordlipbot)
9021 & .and.(positi.lt.bordliptop)) then
9022 C the energy transfer exist
9023 if (positi.lt.buflipbot) then
9025 & ((positi-bordlipbot)/lipbufthick)
9026 C lipbufthick is thickenes of lipid buffore
9027 sslip=sscalelip(fracinbuf)
9028 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9029 eliptran=eliptran+sslip*liptranene(itype(i))
9030 gliptranx(3,i)=gliptranx(3,i)
9031 &+ssgradlip*liptranene(itype(i))
9032 gliptranc(3,i-1)= gliptranc(3,i-1)
9033 &+ssgradlip*liptranene(itype(i))
9034 C print *,"doing sccale for lower part"
9035 elseif (positi.gt.bufliptop) then
9037 &((bordliptop-positi)/lipbufthick)
9038 sslip=sscalelip(fracinbuf)
9039 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9040 eliptran=eliptran+sslip*liptranene(itype(i))
9041 gliptranx(3,i)=gliptranx(3,i)
9042 &+ssgradlip*liptranene(itype(i))
9043 gliptranc(3,i-1)= gliptranc(3,i-1)
9044 &+ssgradlip*liptranene(itype(i))
9045 C print *, "doing sscalefor top part",sslip,fracinbuf
9047 eliptran=eliptran+liptranene(itype(i))
9048 C print *,"I am in true lipid"
9050 endif ! if in lipid or buffor
9052 C eliptran=elpitran+0.0 ! I am in water
9056 C-------------------------------------------------------------------------------------