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)
104 if (TUBElog.eq.1) then
105 print *,"just before call"
107 print *,"just after call",etube
108 elseif (TUBElog.eq.2) then
109 call calctube2(Etube)
110 elseif (TUBElog.eq.3) then
115 write(iout,*), "Etube",etube
117 C 12/1/95 Multi-body terms
121 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
122 & .or. wturn6.gt.0.0d0) then
123 c print *,"calling multibody_eello"
124 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
125 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
126 c print *,ecorr,ecorr5,ecorr6,eturn6
133 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
134 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
136 write (iout,*) "ft(6)",fact(6),wliptran,eliptran
138 if (shield_mode.gt.0) then
139 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
141 & +fact(1)*wvdwpp*evdw1
142 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
143 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
144 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
145 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
146 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
147 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
148 & +wliptran*eliptran+wtube*Etube
150 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
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
158 & +wliptran*eliptran+wtube*Etube
161 if (shield_mode.gt.0) then
162 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
163 & +welec*fact(1)*(ees+evdw1)
164 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
165 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
166 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
167 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
168 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
169 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
170 & +wliptran*eliptran+wtube*Etube
172 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
173 & +welec*fact(1)*(ees+evdw1)
174 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
175 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
176 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
177 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
178 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
179 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
180 & +wliptran*eliptran+wtube*Etube
187 energia(2)=evdw2-evdw2_14
204 energia(8)=eello_turn3
205 energia(9)=eello_turn4
214 energia(20)=edihcnstr
216 energia(24)=ethetacnstr
222 if (isnan(etot).ne.0) energia(0)=1.0d+99
224 if (isnan(etot)) energia(0)=1.0d+99
229 idumm=proc_proc(etot,i)
231 call proc_proc(etot,i)
233 if(i.eq.1)energia(0)=1.0d+99
240 C Sum up the components of the Cartesian gradient.
245 if (shield_mode.eq.0) then
246 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
247 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
249 & wstrain*ghpbc(j,i)+
250 & wcorr*fact(3)*gradcorr(j,i)+
251 & wel_loc*fact(2)*gel_loc(j,i)+
252 & wturn3*fact(2)*gcorr3_turn(j,i)+
253 & wturn4*fact(3)*gcorr4_turn(j,i)+
254 & wcorr5*fact(4)*gradcorr5(j,i)+
255 & wcorr6*fact(5)*gradcorr6(j,i)+
256 & wturn6*fact(5)*gcorr6_turn(j,i)+
257 & wsccor*fact(2)*gsccorc(j,i)
258 & +wliptran*gliptranc(j,i)
259 & +wtube*gg_tube(j,i)
261 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
263 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
264 & wsccor*fact(2)*gsccorx(j,i)
265 & +wliptran*gliptranx(j,i)
266 & +wtube*gg_tube_SC(j,i)
269 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
270 & +fact(1)*wscp*gvdwc_scp(j,i)+
271 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
273 & wstrain*ghpbc(j,i)+
274 & wcorr*fact(3)*gradcorr(j,i)+
275 & wel_loc*fact(2)*gel_loc(j,i)+
276 & wturn3*fact(2)*gcorr3_turn(j,i)+
277 & wturn4*fact(3)*gcorr4_turn(j,i)+
278 & wcorr5*fact(4)*gradcorr5(j,i)+
279 & wcorr6*fact(5)*gradcorr6(j,i)+
280 & wturn6*fact(5)*gcorr6_turn(j,i)+
281 & wsccor*fact(2)*gsccorc(j,i)
282 & +wliptran*gliptranc(j,i)
283 & +welec*gshieldc(j,i)
284 & +welec*gshieldc_loc(j,i)
285 & +wcorr*gshieldc_ec(j,i)
286 & +wcorr*gshieldc_loc_ec(j,i)
287 & +wturn3*gshieldc_t3(j,i)
288 & +wturn3*gshieldc_loc_t3(j,i)
289 & +wturn4*gshieldc_t4(j,i)
290 & +wturn4*gshieldc_loc_t4(j,i)
291 & +wel_loc*gshieldc_ll(j,i)
292 & +wel_loc*gshieldc_loc_ll(j,i)
293 & +wtube*gg_tube(j,i)
295 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
296 & +fact(1)*wscp*gradx_scp(j,i)+
298 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
299 & wsccor*fact(2)*gsccorx(j,i)
300 & +wliptran*gliptranx(j,i)
301 & +welec*gshieldx(j,i)
302 & +wcorr*gshieldx_ec(j,i)
303 & +wturn3*gshieldx_t3(j,i)
304 & +wturn4*gshieldx_t4(j,i)
305 & +wel_loc*gshieldx_ll(j,i)
306 & +wtube*gg_tube_SC(j,i)
314 if (shield_mode.eq.0) then
315 gradc(j,i,icg)=wsc*gvdwc(j,i)+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 & +wtube*gg_tube(j,i)
329 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
331 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
332 & wsccor*fact(1)*gsccorx(j,i)
333 & +wliptran*gliptranx(j,i)
334 & +wtube*gg_tube_SC(j,i)
336 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
337 & fact(1)*wscp*gvdwc_scp(j,i)+
338 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
340 & wcorr*fact(3)*gradcorr(j,i)+
341 & wel_loc*fact(2)*gel_loc(j,i)+
342 & wturn3*fact(2)*gcorr3_turn(j,i)+
343 & wturn4*fact(3)*gcorr4_turn(j,i)+
344 & wcorr5*fact(4)*gradcorr5(j,i)+
345 & wcorr6*fact(5)*gradcorr6(j,i)+
346 & wturn6*fact(5)*gcorr6_turn(j,i)+
347 & wsccor*fact(2)*gsccorc(j,i)
348 & +wliptran*gliptranc(j,i)
349 & +wtube*gg_tube(j,i)
351 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
352 & fact(1)*wscp*gradx_scp(j,i)+
354 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
355 & wsccor*fact(1)*gsccorx(j,i)
356 & +wliptran*gliptranx(j,i)
357 & +wtube*gg_tube_SC(j,i)
365 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
366 & +wcorr5*fact(4)*g_corr5_loc(i)
367 & +wcorr6*fact(5)*g_corr6_loc(i)
368 & +wturn4*fact(3)*gel_loc_turn4(i)
369 & +wturn3*fact(2)*gel_loc_turn3(i)
370 & +wturn6*fact(5)*gel_loc_turn6(i)
371 & +wel_loc*fact(2)*gel_loc_loc(i)
372 c & +wsccor*fact(1)*gsccor_loc(i)
376 if (dyn_ss) call dyn_set_nss
379 C------------------------------------------------------------------------
380 subroutine enerprint(energia,fact)
381 implicit real*8 (a-h,o-z)
383 include 'sizesclu.dat'
384 include 'COMMON.IOUNITS'
385 include 'COMMON.FFIELD'
386 include 'COMMON.SBRIDGE'
387 double precision energia(0:max_ene),fact(6)
389 evdw=energia(1)+fact(6)*energia(21)
391 evdw2=energia(2)+energia(17)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
405 eello_turn6=energia(10)
412 edihcnstr=energia(20)
414 ethetacnstr=energia(24)
417 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
419 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
420 & etors_d,wtor_d*fact(2),ehpb,wstrain,
421 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
422 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
423 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
424 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etube,wtube,
426 10 format (/'Virtual-chain energies:'//
427 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
428 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
429 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
430 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
431 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
432 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
433 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
434 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
435 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
436 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
437 & ' (SS bridges & dist. cnstr.)'/
438 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
439 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
440 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
441 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
442 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
443 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
444 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
445 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
446 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
447 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
448 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
449 & 'ETUBE=',1pE16.6,' WEIGHT=',1pD16.6,' (energy with nano)'/
450 & 'ETOT= ',1pE16.6,' (total)')
452 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
453 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
454 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
455 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
456 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
457 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
458 & edihcnstr,ethetacnstr,ebr*nss,etube,wtube,etot
459 10 format (/'Virtual-chain energies:'//
460 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
461 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
462 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
463 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
464 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
465 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
466 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
467 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
468 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
469 & ' (SS bridges & dist. cnstr.)'/
470 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
471 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
472 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
473 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
474 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
475 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
476 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
477 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
478 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
479 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
480 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
481 & 'ETUBE=',1pE16.6,' WEIGHT=',1pD16.6,' (energy with nano)'/
482 & 'ETOT= ',1pE16.6,' (total)')
486 C-----------------------------------------------------------------------
487 subroutine elj(evdw,evdw_t)
489 C This subroutine calculates the interaction energy of nonbonded side chains
490 C assuming the LJ potential of interaction.
492 implicit real*8 (a-h,o-z)
494 include 'sizesclu.dat'
495 include "DIMENSIONS.COMPAR"
496 parameter (accur=1.0d-10)
499 include 'COMMON.LOCAL'
500 include 'COMMON.CHAIN'
501 include 'COMMON.DERIV'
502 include 'COMMON.INTERACT'
503 include 'COMMON.TORSION'
504 include 'COMMON.SBRIDGE'
505 include 'COMMON.NAMES'
506 include 'COMMON.IOUNITS'
507 include 'COMMON.CONTACTS'
511 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
512 c ROZNICA DODANE Z WHAM
515 c eneps_temp(j,i)=0.0d0
524 if (itypi.eq.ntyp1) cycle
525 itypi1=iabs(itype(i+1))
532 C Calculate SC interaction energy.
535 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
536 cd & 'iend=',iend(i,iint)
537 do j=istart(i,iint),iend(i,iint)
539 if (itypj.eq.ntyp1) cycle
543 C Change 12/1/95 to calculate four-body interactions
544 rij=xj*xj+yj*yj+zj*zj
546 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
547 eps0ij=eps(itypi,itypj)
552 ij=icant(itypi,itypj)
554 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
555 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
558 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
559 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
560 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
561 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
562 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
563 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
564 if (bb.gt.0.0d0) then
571 C Calculate the components of the gradient in DC and X
573 fac=-rrij*(e1+evdwij)
578 gvdwx(k,i)=gvdwx(k,i)-gg(k)
579 gvdwx(k,j)=gvdwx(k,j)+gg(k)
583 gvdwc(l,k)=gvdwc(l,k)+gg(l)
588 C 12/1/95, revised on 5/20/97
590 C Calculate the contact function. The ith column of the array JCONT will
591 C contain the numbers of atoms that make contacts with the atom I (of numbers
592 C greater than I). The arrays FACONT and GACONT will contain the values of
593 C the contact function and its derivative.
595 C Uncomment next line, if the correlation interactions include EVDW explicitly.
596 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
597 C Uncomment next line, if the correlation interactions are contact function only
598 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
600 sigij=sigma(itypi,itypj)
601 r0ij=rs0(itypi,itypj)
603 C Check whether the SC's are not too far to make a contact.
606 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
607 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
609 if (fcont.gt.0.0D0) then
610 C If the SC-SC distance if close to sigma, apply spline.
611 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
612 cAdam & fcont1,fprimcont1)
613 cAdam fcont1=1.0d0-fcont1
614 cAdam if (fcont1.gt.0.0d0) then
615 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
616 cAdam fcont=fcont*fcont1
618 C Uncomment following 4 lines to have the geometric average of the epsilon0's
619 cga eps0ij=1.0d0/dsqrt(eps0ij)
621 cga gg(k)=gg(k)*eps0ij
623 cga eps0ij=-evdwij*eps0ij
624 C Uncomment for AL's type of SC correlation interactions.
626 num_conti=num_conti+1
628 facont(num_conti,i)=fcont*eps0ij
629 fprimcont=eps0ij*fprimcont/rij
631 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
632 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
633 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
634 C Uncomment following 3 lines for Skolnick's type of SC correlation.
635 gacont(1,num_conti,i)=-fprimcont*xj
636 gacont(2,num_conti,i)=-fprimcont*yj
637 gacont(3,num_conti,i)=-fprimcont*zj
638 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
639 cd write (iout,'(2i3,3f10.5)')
640 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
646 num_cont(i)=num_conti
651 gvdwc(j,i)=expon*gvdwc(j,i)
652 gvdwx(j,i)=expon*gvdwx(j,i)
656 C******************************************************************************
660 C To save time, the factor of EXPON has been extracted from ALL components
661 C of GVDWC and GRADX. Remember to multiply them by this factor before further
664 C******************************************************************************
667 C-----------------------------------------------------------------------------
668 subroutine eljk(evdw,evdw_t)
670 C This subroutine calculates the interaction energy of nonbonded side chains
671 C assuming the LJK potential of interaction.
673 implicit real*8 (a-h,o-z)
675 include 'sizesclu.dat'
676 include "DIMENSIONS.COMPAR"
679 include 'COMMON.LOCAL'
680 include 'COMMON.CHAIN'
681 include 'COMMON.DERIV'
682 include 'COMMON.INTERACT'
683 include 'COMMON.IOUNITS'
684 include 'COMMON.NAMES'
689 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
694 if (itypi.eq.ntyp1) cycle
695 itypi1=iabs(itype(i+1))
700 C Calculate SC interaction energy.
703 do j=istart(i,iint),iend(i,iint)
705 if (itypj.eq.ntyp1) cycle
709 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
711 e_augm=augm(itypi,itypj)*fac_augm
714 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
715 fac=r_shift_inv**expon
719 ij=icant(itypi,itypj)
720 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
721 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
722 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
723 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
724 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
725 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
726 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
727 if (bb.gt.0.0d0) then
734 C Calculate the components of the gradient in DC and X
736 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
741 gvdwx(k,i)=gvdwx(k,i)-gg(k)
742 gvdwx(k,j)=gvdwx(k,j)+gg(k)
746 gvdwc(l,k)=gvdwc(l,k)+gg(l)
756 gvdwc(j,i)=expon*gvdwc(j,i)
757 gvdwx(j,i)=expon*gvdwx(j,i)
763 C-----------------------------------------------------------------------------
764 subroutine ebp(evdw,evdw_t)
766 C This subroutine calculates the interaction energy of nonbonded side chains
767 C assuming the Berne-Pechukas potential of interaction.
769 implicit real*8 (a-h,o-z)
771 include 'sizesclu.dat'
772 include "DIMENSIONS.COMPAR"
775 include 'COMMON.LOCAL'
776 include 'COMMON.CHAIN'
777 include 'COMMON.DERIV'
778 include 'COMMON.NAMES'
779 include 'COMMON.INTERACT'
780 include 'COMMON.IOUNITS'
781 include 'COMMON.CALC'
783 c double precision rrsave(maxdim)
789 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
790 c if (icall.eq.0) then
798 if (itypi.eq.ntyp1) cycle
799 itypi1=iabs(itype(i+1))
803 dxi=dc_norm(1,nres+i)
804 dyi=dc_norm(2,nres+i)
805 dzi=dc_norm(3,nres+i)
806 dsci_inv=vbld_inv(i+nres)
808 C Calculate SC interaction energy.
811 do j=istart(i,iint),iend(i,iint)
814 if (itypj.eq.ntyp1) cycle
815 dscj_inv=vbld_inv(j+nres)
816 chi1=chi(itypi,itypj)
817 chi2=chi(itypj,itypi)
824 alf12=0.5D0*(alf1+alf2)
825 C For diagnostics only!!!
838 dxj=dc_norm(1,nres+j)
839 dyj=dc_norm(2,nres+j)
840 dzj=dc_norm(3,nres+j)
841 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
842 cd if (icall.eq.0) then
848 C Calculate the angle-dependent terms of energy & contributions to derivatives.
850 C Calculate whole angle-dependent part of epsilon and contributions
852 fac=(rrij*sigsq)**expon2
855 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
856 eps2der=evdwij*eps3rt
857 eps3der=evdwij*eps2rt
858 evdwij=evdwij*eps2rt*eps3rt
859 ij=icant(itypi,itypj)
860 aux=eps1*eps2rt**2*eps3rt**2
861 if (bb.gt.0.0d0) then
868 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
870 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
871 cd & restyp(itypi),i,restyp(itypj),j,
872 cd & epsi,sigm,chi1,chi2,chip1,chip2,
873 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
874 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
877 C Calculate gradient components.
878 e1=e1*eps1*eps2rt**2*eps3rt**2
879 fac=-expon*(e1+evdwij)
882 C Calculate radial part of the gradient
886 C Calculate the angular part of the gradient and sum add the contributions
887 C to the appropriate components of the Cartesian gradient.
896 C-----------------------------------------------------------------------------
897 subroutine egb(evdw,evdw_t)
899 C This subroutine calculates the interaction energy of nonbonded side chains
900 C assuming the Gay-Berne potential of interaction.
902 implicit real*8 (a-h,o-z)
904 include 'sizesclu.dat'
905 include "DIMENSIONS.COMPAR"
908 include 'COMMON.LOCAL'
909 include 'COMMON.CHAIN'
910 include 'COMMON.DERIV'
911 include 'COMMON.NAMES'
912 include 'COMMON.INTERACT'
913 include 'COMMON.IOUNITS'
914 include 'COMMON.CALC'
915 include 'COMMON.SBRIDGE'
920 integer xshift,yshift,zshift
921 logical energy_dec /.false./
922 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
926 c if (icall.gt.0) lprn=.true.
930 if (itypi.eq.ntyp1) cycle
931 itypi1=iabs(itype(i+1))
936 if (xi.lt.0) xi=xi+boxxsize
938 if (yi.lt.0) yi=yi+boxysize
940 if (zi.lt.0) zi=zi+boxzsize
941 if ((zi.gt.bordlipbot)
942 &.and.(zi.lt.bordliptop)) then
943 C the energy transfer exist
944 if (zi.lt.buflipbot) then
945 C what fraction I am in
947 & ((zi-bordlipbot)/lipbufthick)
948 C lipbufthick is thickenes of lipid buffore
949 sslipi=sscalelip(fracinbuf)
950 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
951 elseif (zi.gt.bufliptop) then
952 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
953 sslipi=sscalelip(fracinbuf)
954 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
963 dxi=dc_norm(1,nres+i)
964 dyi=dc_norm(2,nres+i)
965 dzi=dc_norm(3,nres+i)
966 dsci_inv=vbld_inv(i+nres)
968 C Calculate SC interaction energy.
971 do j=istart(i,iint),iend(i,iint)
972 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
974 c write(iout,*) "PRZED ZWYKLE", evdwij
975 call dyn_ssbond_ene(i,j,evdwij)
976 c write(iout,*) "PO ZWYKLE", evdwij
979 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
980 & 'evdw',i,j,evdwij,' ss'
981 C triple bond artifac removal
982 do k=j+1,iend(i,iint)
983 C search over all next residues
984 if (dyn_ss_mask(k)) then
985 C check if they are cysteins
986 C write(iout,*) 'k=',k
988 c write(iout,*) "PRZED TRI", evdwij
989 evdwij_przed_tri=evdwij
990 call triple_ssbond_ene(i,j,k,evdwij)
991 c if(evdwij_przed_tri.ne.evdwij) then
992 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
995 c write(iout,*) "PO TRI", evdwij
996 C call the energy function that removes the artifical triple disulfide
997 C bond the soubroutine is located in ssMD.F
999 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1000 & 'evdw',i,j,evdwij,'tss'
1001 endif!dyn_ss_mask(k)
1005 itypj=iabs(itype(j))
1006 if (itypj.eq.ntyp1) cycle
1007 dscj_inv=vbld_inv(j+nres)
1008 sig0ij=sigma(itypi,itypj)
1009 chi1=chi(itypi,itypj)
1010 chi2=chi(itypj,itypi)
1017 alf12=0.5D0*(alf1+alf2)
1018 C For diagnostics only!!!
1032 if (xj.lt.0) xj=xj+boxxsize
1034 if (yj.lt.0) yj=yj+boxysize
1036 if (zj.lt.0) zj=zj+boxzsize
1037 if ((zj.gt.bordlipbot)
1038 &.and.(zj.lt.bordliptop)) then
1039 C the energy transfer exist
1040 if (zj.lt.buflipbot) then
1041 C what fraction I am in
1043 & ((zj-bordlipbot)/lipbufthick)
1044 C lipbufthick is thickenes of lipid buffore
1045 sslipj=sscalelip(fracinbuf)
1046 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1047 elseif (zj.gt.bufliptop) then
1048 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1049 sslipj=sscalelip(fracinbuf)
1050 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1059 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1060 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1061 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1062 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1063 C write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
1064 C & bb-bb_aq(itypi,itypj)
1065 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1073 xj=xj_safe+xshift*boxxsize
1074 yj=yj_safe+yshift*boxysize
1075 zj=zj_safe+zshift*boxzsize
1076 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1077 if(dist_temp.lt.dist_init) then
1087 if (subchap.eq.1) then
1096 dxj=dc_norm(1,nres+j)
1097 dyj=dc_norm(2,nres+j)
1098 dzj=dc_norm(3,nres+j)
1099 c write (iout,*) i,j,xj,yj,zj
1100 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1102 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1103 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1104 if (sss.le.0.0d0) cycle
1105 C Calculate angle-dependent terms of energy and contributions to their
1109 sig=sig0ij*dsqrt(sigsq)
1110 rij_shift=1.0D0/rij-sig+sig0ij
1111 C I hate to put IF's in the loops, but here don't have another choice!!!!
1112 if (rij_shift.le.0.0D0) then
1117 c---------------------------------------------------------------
1118 rij_shift=1.0D0/rij_shift
1119 fac=rij_shift**expon
1122 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1123 eps2der=evdwij*eps3rt
1124 eps3der=evdwij*eps2rt
1125 evdwij=evdwij*eps2rt*eps3rt
1127 evdw=evdw+evdwij*sss
1129 evdw_t=evdw_t+evdwij*sss
1131 ij=icant(itypi,itypj)
1132 aux=eps1*eps2rt**2*eps3rt**2
1133 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1134 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1135 c & aux*e2/eps(itypi,itypj)
1137 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1141 C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1142 C & restyp(itypi),i,restyp(itypj),j,
1143 C & epsi,sigm,chi1,chi2,chip1,chip2,
1144 C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1145 C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1147 write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
1152 C Calculate gradient components.
1153 e1=e1*eps1*eps2rt**2*eps3rt**2
1154 fac=-expon*(e1+evdwij)*rij_shift
1157 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1158 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1159 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1160 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1161 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1162 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1163 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1164 C Calculate the radial part of the gradient
1168 C Calculate angular part of the gradient.
1177 C-----------------------------------------------------------------------------
1178 subroutine egbv(evdw,evdw_t)
1180 C This subroutine calculates the interaction energy of nonbonded side chains
1181 C assuming the Gay-Berne-Vorobjev potential of interaction.
1183 implicit real*8 (a-h,o-z)
1184 include 'DIMENSIONS'
1185 include 'sizesclu.dat'
1186 include "DIMENSIONS.COMPAR"
1187 include 'COMMON.GEO'
1188 include 'COMMON.VAR'
1189 include 'COMMON.LOCAL'
1190 include 'COMMON.CHAIN'
1191 include 'COMMON.DERIV'
1192 include 'COMMON.NAMES'
1193 include 'COMMON.INTERACT'
1194 include 'COMMON.IOUNITS'
1195 include 'COMMON.CALC'
1196 common /srutu/ icall
1202 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1205 c if (icall.gt.0) lprn=.true.
1207 do i=iatsc_s,iatsc_e
1208 itypi=iabs(itype(i))
1209 if (itypi.eq.ntyp1) cycle
1210 itypi1=iabs(itype(i+1))
1214 dxi=dc_norm(1,nres+i)
1215 dyi=dc_norm(2,nres+i)
1216 dzi=dc_norm(3,nres+i)
1217 dsci_inv=vbld_inv(i+nres)
1218 C returning the ith atom to box
1220 if (xi.lt.0) xi=xi+boxxsize
1222 if (yi.lt.0) yi=yi+boxysize
1224 if (zi.lt.0) zi=zi+boxzsize
1225 if ((zi.gt.bordlipbot)
1226 &.and.(zi.lt.bordliptop)) then
1227 C the energy transfer exist
1228 if (zi.lt.buflipbot) then
1229 C what fraction I am in
1231 & ((zi-bordlipbot)/lipbufthick)
1232 C lipbufthick is thickenes of lipid buffore
1233 sslipi=sscalelip(fracinbuf)
1234 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1235 elseif (zi.gt.bufliptop) then
1236 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1237 sslipi=sscalelip(fracinbuf)
1238 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1248 C Calculate SC interaction energy.
1250 do iint=1,nint_gr(i)
1251 do j=istart(i,iint),iend(i,iint)
1253 itypj=iabs(itype(j))
1254 if (itypj.eq.ntyp1) cycle
1255 dscj_inv=vbld_inv(j+nres)
1256 sig0ij=sigma(itypi,itypj)
1257 r0ij=r0(itypi,itypj)
1258 chi1=chi(itypi,itypj)
1259 chi2=chi(itypj,itypi)
1266 alf12=0.5D0*(alf1+alf2)
1267 C For diagnostics only!!!
1280 C returning jth atom to box
1282 if (xj.lt.0) xj=xj+boxxsize
1284 if (yj.lt.0) yj=yj+boxysize
1286 if (zj.lt.0) zj=zj+boxzsize
1287 if ((zj.gt.bordlipbot)
1288 &.and.(zj.lt.bordliptop)) then
1289 C the energy transfer exist
1290 if (zj.lt.buflipbot) then
1291 C what fraction I am in
1293 & ((zj-bordlipbot)/lipbufthick)
1294 C lipbufthick is thickenes of lipid buffore
1295 sslipj=sscalelip(fracinbuf)
1296 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1297 elseif (zj.gt.bufliptop) then
1298 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1299 sslipj=sscalelip(fracinbuf)
1300 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1309 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1310 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1311 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1312 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1313 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1314 C checking the distance
1315 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1320 C finding the closest
1324 xj=xj_safe+xshift*boxxsize
1325 yj=yj_safe+yshift*boxysize
1326 zj=zj_safe+zshift*boxzsize
1327 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1328 if(dist_temp.lt.dist_init) then
1338 if (subchap.eq.1) then
1347 dxj=dc_norm(1,nres+j)
1348 dyj=dc_norm(2,nres+j)
1349 dzj=dc_norm(3,nres+j)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1352 C Calculate angle-dependent terms of energy and contributions to their
1356 sig=sig0ij*dsqrt(sigsq)
1357 rij_shift=1.0D0/rij-sig+r0ij
1358 C I hate to put IF's in the loops, but here don't have another choice!!!!
1359 if (rij_shift.le.0.0D0) then
1364 c---------------------------------------------------------------
1365 rij_shift=1.0D0/rij_shift
1366 fac=rij_shift**expon
1369 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1370 eps2der=evdwij*eps3rt
1371 eps3der=evdwij*eps2rt
1372 fac_augm=rrij**expon
1373 e_augm=augm(itypi,itypj)*fac_augm
1374 evdwij=evdwij*eps2rt*eps3rt
1375 if (bb.gt.0.0d0) then
1376 evdw=evdw+evdwij+e_augm
1378 evdw_t=evdw_t+evdwij+e_augm
1380 ij=icant(itypi,itypj)
1381 aux=eps1*eps2rt**2*eps3rt**2
1383 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1384 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1385 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1386 c & restyp(itypi),i,restyp(itypj),j,
1387 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1388 c & chi1,chi2,chip1,chip2,
1389 c & eps1,eps2rt**2,eps3rt**2,
1390 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1394 C Calculate gradient components.
1395 e1=e1*eps1*eps2rt**2*eps3rt**2
1396 fac=-expon*(e1+evdwij)*rij_shift
1398 fac=rij*fac-2*expon*rrij*e_augm
1399 C Calculate the radial part of the gradient
1403 C Calculate angular part of the gradient.
1411 C-----------------------------------------------------------------------------
1412 subroutine sc_angular
1413 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1414 C om12. Called by ebp, egb, and egbv.
1416 include 'COMMON.CALC'
1420 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1421 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1422 om12=dxi*dxj+dyi*dyj+dzi*dzj
1424 C Calculate eps1(om12) and its derivative in om12
1425 faceps1=1.0D0-om12*chiom12
1426 faceps1_inv=1.0D0/faceps1
1427 eps1=dsqrt(faceps1_inv)
1428 C Following variable is eps1*deps1/dom12
1429 eps1_om12=faceps1_inv*chiom12
1430 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1435 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1436 sigsq=1.0D0-facsig*faceps1_inv
1437 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1438 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1439 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1440 C Calculate eps2 and its derivatives in om1, om2, and om12.
1443 chipom12=chip12*om12
1444 facp=1.0D0-om12*chipom12
1446 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1447 C Following variable is the square root of eps2
1448 eps2rt=1.0D0-facp1*facp_inv
1449 C Following three variables are the derivatives of the square root of eps
1450 C in om1, om2, and om12.
1451 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1452 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1453 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1454 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1455 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1456 C Calculate whole angle-dependent part of epsilon and contributions
1457 C to its derivatives
1460 C----------------------------------------------------------------------------
1462 implicit real*8 (a-h,o-z)
1463 include 'DIMENSIONS'
1464 include 'sizesclu.dat'
1465 include 'COMMON.CHAIN'
1466 include 'COMMON.DERIV'
1467 include 'COMMON.CALC'
1468 double precision dcosom1(3),dcosom2(3)
1469 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1470 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1471 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1472 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1474 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1475 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1478 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1481 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
1482 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1483 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1484 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipi(k)
1485 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1486 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1489 C Calculate the components of the gradient in DC and X
1493 gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
1497 gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
1501 c------------------------------------------------------------------------------
1502 subroutine vec_and_deriv
1503 implicit real*8 (a-h,o-z)
1504 include 'DIMENSIONS'
1505 include 'sizesclu.dat'
1506 include 'COMMON.IOUNITS'
1507 include 'COMMON.GEO'
1508 include 'COMMON.VAR'
1509 include 'COMMON.LOCAL'
1510 include 'COMMON.CHAIN'
1511 include 'COMMON.VECTORS'
1512 include 'COMMON.DERIV'
1513 include 'COMMON.INTERACT'
1514 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1515 C Compute the local reference systems. For reference system (i), the
1516 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1517 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1519 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1520 if (i.eq.nres-1) then
1521 C Case of the last full residue
1522 C Compute the Z-axis
1523 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1524 costh=dcos(pi-theta(nres))
1525 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1530 C Compute the derivatives of uz
1532 uzder(2,1,1)=-dc_norm(3,i-1)
1533 uzder(3,1,1)= dc_norm(2,i-1)
1534 uzder(1,2,1)= dc_norm(3,i-1)
1536 uzder(3,2,1)=-dc_norm(1,i-1)
1537 uzder(1,3,1)=-dc_norm(2,i-1)
1538 uzder(2,3,1)= dc_norm(1,i-1)
1541 uzder(2,1,2)= dc_norm(3,i)
1542 uzder(3,1,2)=-dc_norm(2,i)
1543 uzder(1,2,2)=-dc_norm(3,i)
1545 uzder(3,2,2)= dc_norm(1,i)
1546 uzder(1,3,2)= dc_norm(2,i)
1547 uzder(2,3,2)=-dc_norm(1,i)
1550 C Compute the Y-axis
1553 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1556 C Compute the derivatives of uy
1559 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1560 & -dc_norm(k,i)*dc_norm(j,i-1)
1561 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1563 uyder(j,j,1)=uyder(j,j,1)-costh
1564 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1569 uygrad(l,k,j,i)=uyder(l,k,j)
1570 uzgrad(l,k,j,i)=uzder(l,k,j)
1574 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1575 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1576 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1577 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1581 C Compute the Z-axis
1582 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1583 costh=dcos(pi-theta(i+2))
1584 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1589 C Compute the derivatives of uz
1591 uzder(2,1,1)=-dc_norm(3,i+1)
1592 uzder(3,1,1)= dc_norm(2,i+1)
1593 uzder(1,2,1)= dc_norm(3,i+1)
1595 uzder(3,2,1)=-dc_norm(1,i+1)
1596 uzder(1,3,1)=-dc_norm(2,i+1)
1597 uzder(2,3,1)= dc_norm(1,i+1)
1600 uzder(2,1,2)= dc_norm(3,i)
1601 uzder(3,1,2)=-dc_norm(2,i)
1602 uzder(1,2,2)=-dc_norm(3,i)
1604 uzder(3,2,2)= dc_norm(1,i)
1605 uzder(1,3,2)= dc_norm(2,i)
1606 uzder(2,3,2)=-dc_norm(1,i)
1609 C Compute the Y-axis
1612 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1615 C Compute the derivatives of uy
1618 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1619 & -dc_norm(k,i)*dc_norm(j,i+1)
1620 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1622 uyder(j,j,1)=uyder(j,j,1)-costh
1623 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1628 uygrad(l,k,j,i)=uyder(l,k,j)
1629 uzgrad(l,k,j,i)=uzder(l,k,j)
1633 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1634 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1635 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1636 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1642 vbld_inv_temp(1)=vbld_inv(i+1)
1643 if (i.lt.nres-1) then
1644 vbld_inv_temp(2)=vbld_inv(i+2)
1646 vbld_inv_temp(2)=vbld_inv(i)
1651 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1652 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1660 C-----------------------------------------------------------------------------
1661 subroutine vec_and_deriv_test
1662 implicit real*8 (a-h,o-z)
1663 include 'DIMENSIONS'
1664 include 'sizesclu.dat'
1665 include 'COMMON.IOUNITS'
1666 include 'COMMON.GEO'
1667 include 'COMMON.VAR'
1668 include 'COMMON.LOCAL'
1669 include 'COMMON.CHAIN'
1670 include 'COMMON.VECTORS'
1671 dimension uyder(3,3,2),uzder(3,3,2)
1672 C Compute the local reference systems. For reference system (i), the
1673 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1674 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1676 if (i.eq.nres-1) then
1677 C Case of the last full residue
1678 C Compute the Z-axis
1679 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1680 costh=dcos(pi-theta(nres))
1681 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1682 c write (iout,*) 'fac',fac,
1683 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1684 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1688 C Compute the derivatives of uz
1690 uzder(2,1,1)=-dc_norm(3,i-1)
1691 uzder(3,1,1)= dc_norm(2,i-1)
1692 uzder(1,2,1)= dc_norm(3,i-1)
1694 uzder(3,2,1)=-dc_norm(1,i-1)
1695 uzder(1,3,1)=-dc_norm(2,i-1)
1696 uzder(2,3,1)= dc_norm(1,i-1)
1699 uzder(2,1,2)= dc_norm(3,i)
1700 uzder(3,1,2)=-dc_norm(2,i)
1701 uzder(1,2,2)=-dc_norm(3,i)
1703 uzder(3,2,2)= dc_norm(1,i)
1704 uzder(1,3,2)= dc_norm(2,i)
1705 uzder(2,3,2)=-dc_norm(1,i)
1707 C Compute the Y-axis
1709 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1712 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1713 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1714 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1716 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1719 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1720 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1723 c write (iout,*) 'facy',facy,
1724 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1725 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1727 uy(k,i)=facy*uy(k,i)
1729 C Compute the derivatives of uy
1732 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1733 & -dc_norm(k,i)*dc_norm(j,i-1)
1734 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1736 c uyder(j,j,1)=uyder(j,j,1)-costh
1737 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1738 uyder(j,j,1)=uyder(j,j,1)
1739 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1740 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1746 uygrad(l,k,j,i)=uyder(l,k,j)
1747 uzgrad(l,k,j,i)=uzder(l,k,j)
1751 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1752 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1753 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1754 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1757 C Compute the Z-axis
1758 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1759 costh=dcos(pi-theta(i+2))
1760 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1761 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1765 C Compute the derivatives of uz
1767 uzder(2,1,1)=-dc_norm(3,i+1)
1768 uzder(3,1,1)= dc_norm(2,i+1)
1769 uzder(1,2,1)= dc_norm(3,i+1)
1771 uzder(3,2,1)=-dc_norm(1,i+1)
1772 uzder(1,3,1)=-dc_norm(2,i+1)
1773 uzder(2,3,1)= dc_norm(1,i+1)
1776 uzder(2,1,2)= dc_norm(3,i)
1777 uzder(3,1,2)=-dc_norm(2,i)
1778 uzder(1,2,2)=-dc_norm(3,i)
1780 uzder(3,2,2)= dc_norm(1,i)
1781 uzder(1,3,2)= dc_norm(2,i)
1782 uzder(2,3,2)=-dc_norm(1,i)
1784 C Compute the Y-axis
1786 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1787 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1788 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1790 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1793 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1794 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1797 c write (iout,*) 'facy',facy,
1798 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1799 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1801 uy(k,i)=facy*uy(k,i)
1803 C Compute the derivatives of uy
1806 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1807 & -dc_norm(k,i)*dc_norm(j,i+1)
1808 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1810 c uyder(j,j,1)=uyder(j,j,1)-costh
1811 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1812 uyder(j,j,1)=uyder(j,j,1)
1813 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1814 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1820 uygrad(l,k,j,i)=uyder(l,k,j)
1821 uzgrad(l,k,j,i)=uzder(l,k,j)
1825 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1826 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1827 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1828 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1835 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1836 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1843 C-----------------------------------------------------------------------------
1844 subroutine check_vecgrad
1845 implicit real*8 (a-h,o-z)
1846 include 'DIMENSIONS'
1847 include 'sizesclu.dat'
1848 include 'COMMON.IOUNITS'
1849 include 'COMMON.GEO'
1850 include 'COMMON.VAR'
1851 include 'COMMON.LOCAL'
1852 include 'COMMON.CHAIN'
1853 include 'COMMON.VECTORS'
1854 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1855 dimension uyt(3,maxres),uzt(3,maxres)
1856 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1857 double precision delta /1.0d-7/
1860 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1861 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1862 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1863 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1864 cd & (dc_norm(if90,i),if90=1,3)
1865 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1866 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1867 cd write(iout,'(a)')
1873 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1874 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1887 cd write (iout,*) 'i=',i
1889 erij(k)=dc_norm(k,i)
1893 dc_norm(k,i)=erij(k)
1895 dc_norm(j,i)=dc_norm(j,i)+delta
1896 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1898 c dc_norm(k,i)=dc_norm(k,i)/fac
1900 c write (iout,*) (dc_norm(k,i),k=1,3)
1901 c write (iout,*) (erij(k),k=1,3)
1904 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1905 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1906 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1907 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1909 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1910 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1911 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1914 dc_norm(k,i)=erij(k)
1917 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1918 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1919 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1920 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1921 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1922 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1923 cd write (iout,'(a)')
1928 C--------------------------------------------------------------------------
1929 subroutine set_matrices
1930 implicit real*8 (a-h,o-z)
1931 include 'DIMENSIONS'
1932 include 'sizesclu.dat'
1933 include 'COMMON.IOUNITS'
1934 include 'COMMON.GEO'
1935 include 'COMMON.VAR'
1936 include 'COMMON.LOCAL'
1937 include 'COMMON.CHAIN'
1938 include 'COMMON.DERIV'
1939 include 'COMMON.INTERACT'
1940 include 'COMMON.CONTACTS'
1941 include 'COMMON.TORSION'
1942 include 'COMMON.VECTORS'
1943 include 'COMMON.FFIELD'
1944 double precision auxvec(2),auxmat(2,2)
1946 C Compute the virtual-bond-torsional-angle dependent quantities needed
1947 C to calculate the el-loc multibody terms of various order.
1950 if (i .lt. nres+1) then
1987 if (i .gt. 3 .and. i .lt. nres+1) then
1988 obrot_der(1,i-2)=-sin1
1989 obrot_der(2,i-2)= cos1
1990 Ugder(1,1,i-2)= sin1
1991 Ugder(1,2,i-2)=-cos1
1992 Ugder(2,1,i-2)=-cos1
1993 Ugder(2,2,i-2)=-sin1
1996 obrot2_der(1,i-2)=-dwasin2
1997 obrot2_der(2,i-2)= dwacos2
1998 Ug2der(1,1,i-2)= dwasin2
1999 Ug2der(1,2,i-2)=-dwacos2
2000 Ug2der(2,1,i-2)=-dwacos2
2001 Ug2der(2,2,i-2)=-dwasin2
2003 obrot_der(1,i-2)=0.0d0
2004 obrot_der(2,i-2)=0.0d0
2005 Ugder(1,1,i-2)=0.0d0
2006 Ugder(1,2,i-2)=0.0d0
2007 Ugder(2,1,i-2)=0.0d0
2008 Ugder(2,2,i-2)=0.0d0
2009 obrot2_der(1,i-2)=0.0d0
2010 obrot2_der(2,i-2)=0.0d0
2011 Ug2der(1,1,i-2)=0.0d0
2012 Ug2der(1,2,i-2)=0.0d0
2013 Ug2der(2,1,i-2)=0.0d0
2014 Ug2der(2,2,i-2)=0.0d0
2016 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2017 if (itype(i-2).le.ntyp) then
2018 iti = itortyp(itype(i-2))
2025 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2026 if (itype(i-1).le.ntyp) then
2027 iti1 = itortyp(itype(i-1))
2034 cd write (iout,*) '*******i',i,' iti1',iti
2035 cd write (iout,*) 'b1',b1(:,iti)
2036 cd write (iout,*) 'b2',b2(:,iti)
2037 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2038 c print *,"itilde1 i iti iti1",i,iti,iti1
2039 if (i .gt. iatel_s+2) then
2040 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2041 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2042 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2043 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2044 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2045 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2046 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2056 DtUg2(l,k,i-2)=0.0d0
2060 c print *,"itilde2 i iti iti1",i,iti,iti1
2061 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2062 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2063 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2064 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2065 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2066 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2067 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2068 c print *,"itilde3 i iti iti1",i,iti,iti1
2070 muder(k,i-2)=Ub2der(k,i-2)
2072 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2073 if (itype(i-1).le.ntyp) then
2074 iti1 = itortyp(itype(i-1))
2082 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2084 C Vectors and matrices dependent on a single virtual-bond dihedral.
2085 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2086 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2087 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2088 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2089 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2090 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2091 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2092 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2093 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2094 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2095 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2097 C Matrices dependent on two consecutive virtual-bond dihedrals.
2098 C The order of matrices is from left to right.
2100 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2101 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2102 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2103 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2104 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2105 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2106 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2107 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2110 cd iti = itortyp(itype(i))
2113 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2114 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2119 C--------------------------------------------------------------------------
2120 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2122 C This subroutine calculates the average interaction energy and its gradient
2123 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2124 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2125 C The potential depends both on the distance of peptide-group centers and on
2126 C the orientation of the CA-CA virtual bonds.
2128 implicit real*8 (a-h,o-z)
2129 include 'DIMENSIONS'
2130 include 'sizesclu.dat'
2131 include 'COMMON.CONTROL'
2132 include 'COMMON.IOUNITS'
2133 include 'COMMON.GEO'
2134 include 'COMMON.VAR'
2135 include 'COMMON.LOCAL'
2136 include 'COMMON.CHAIN'
2137 include 'COMMON.DERIV'
2138 include 'COMMON.INTERACT'
2139 include 'COMMON.CONTACTS'
2140 include 'COMMON.TORSION'
2141 include 'COMMON.VECTORS'
2142 include 'COMMON.FFIELD'
2143 include 'COMMON.SHIELD'
2145 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2146 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2147 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2148 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2149 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2150 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2151 double precision scal_el /0.5d0/
2153 C 13-go grudnia roku pamietnego...
2154 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2155 & 0.0d0,1.0d0,0.0d0,
2156 & 0.0d0,0.0d0,1.0d0/
2157 cd write(iout,*) 'In EELEC'
2159 cd write(iout,*) 'Type',i
2160 cd write(iout,*) 'B1',B1(:,i)
2161 cd write(iout,*) 'B2',B2(:,i)
2162 cd write(iout,*) 'CC',CC(:,:,i)
2163 cd write(iout,*) 'DD',DD(:,:,i)
2164 cd write(iout,*) 'EE',EE(:,:,i)
2166 cd call check_vecgrad
2168 if (icheckgrad.eq.1) then
2170 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2172 dc_norm(k,i)=dc(k,i)*fac
2174 c write (iout,*) 'i',i,' fac',fac
2177 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2178 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2179 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2180 cd if (wel_loc.gt.0.0d0) then
2181 if (icheckgrad.eq.1) then
2182 call vec_and_deriv_test
2189 cd write (iout,*) 'i=',i
2191 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2194 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2195 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2208 cd print '(a)','Enter EELEC'
2209 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2211 gel_loc_loc(i)=0.0d0
2214 do i=iatel_s,iatel_e
2216 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2217 C & .or. itype(i+2).eq.ntyp1) cycle
2219 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2220 C & .or. itype(i+2).eq.ntyp1
2221 C & .or. itype(i-1).eq.ntyp1
2224 if (itel(i).eq.0) goto 1215
2228 dx_normi=dc_norm(1,i)
2229 dy_normi=dc_norm(2,i)
2230 dz_normi=dc_norm(3,i)
2231 xmedi=c(1,i)+0.5d0*dxi
2232 ymedi=c(2,i)+0.5d0*dyi
2233 zmedi=c(3,i)+0.5d0*dzi
2234 xmedi=mod(xmedi,boxxsize)
2235 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2236 ymedi=mod(ymedi,boxysize)
2237 if (ymedi.lt.0) ymedi=ymedi+boxysize
2238 zmedi=mod(zmedi,boxzsize)
2239 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2241 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2242 do j=ielstart(i),ielend(i)
2244 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2245 C & .or.itype(j+2).eq.ntyp1
2248 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2249 C & .or.itype(j+2).eq.ntyp1
2250 C & .or.itype(j-1).eq.ntyp1
2253 if (itel(j).eq.0) goto 1216
2257 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2258 aaa=app(iteli,itelj)
2259 bbb=bpp(iteli,itelj)
2260 C Diagnostics only!!!
2266 ael6i=ael6(iteli,itelj)
2267 ael3i=ael3(iteli,itelj)
2271 dx_normj=dc_norm(1,j)
2272 dy_normj=dc_norm(2,j)
2273 dz_normj=dc_norm(3,j)
2278 if (xj.lt.0) xj=xj+boxxsize
2280 if (yj.lt.0) yj=yj+boxysize
2282 if (zj.lt.0) zj=zj+boxzsize
2283 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2291 xj=xj_safe+xshift*boxxsize
2292 yj=yj_safe+yshift*boxysize
2293 zj=zj_safe+zshift*boxzsize
2294 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2295 if(dist_temp.lt.dist_init) then
2305 if (isubchap.eq.1) then
2315 rij=xj*xj+yj*yj+zj*zj
2316 sss=sscale(sqrt(rij))
2317 sssgrad=sscagrad(sqrt(rij))
2323 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2324 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2325 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2326 fac=cosa-3.0D0*cosb*cosg
2328 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2329 if (j.eq.i+2) ev1=scal_el*ev1
2334 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2337 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2338 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2339 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2340 if (shield_mode.gt.0) then
2345 write(iout,*) "ees_compon",i,j,el1,el2,
2346 & fac_shield(i),fac_shield(j)
2349 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2350 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2352 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2361 evdw1=evdw1+evdwij*sss
2362 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2363 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2364 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2365 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2366 cd & xmedi,ymedi,zmedi,xj,yj,zj
2368 C Calculate contributions to the Cartesian gradient.
2371 facvdw=-6*rrmij*(ev1+evdwij)*sss
2372 facel=-3*rrmij*(el1+eesij)
2379 * Radial derivatives. First process both termini of the fragment (i,j)
2385 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2386 & (shield_mode.gt.0)) then
2388 do ilist=1,ishield_list(i)
2389 iresshield=shield_list(ilist,i)
2391 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2393 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2395 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2396 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2397 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2398 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2399 C if (iresshield.gt.i) then
2400 C do ishi=i+1,iresshield-1
2401 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2402 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2406 C do ishi=iresshield,i
2407 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2408 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2416 do ilist=1,ishield_list(j)
2417 iresshield=shield_list(ilist,j)
2419 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2421 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2423 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2424 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2429 gshieldc(k,i)=gshieldc(k,i)+
2430 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2431 gshieldc(k,j)=gshieldc(k,j)+
2432 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2433 gshieldc(k,i-1)=gshieldc(k,i-1)+
2434 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2435 gshieldc(k,j-1)=gshieldc(k,j-1)+
2436 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2443 gelc(k,i)=gelc(k,i)+ghalf
2444 gelc(k,j)=gelc(k,j)+ghalf
2447 * Loop over residues i+1 thru j-1.
2451 gelc(l,k)=gelc(l,k)+ggg(l)
2457 if (sss.gt.0.0) then
2458 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2459 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2460 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2468 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2469 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2472 * Loop over residues i+1 thru j-1.
2476 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2480 facvdw=(ev1+evdwij)*sss
2483 fac=-3*rrmij*(facvdw+facvdw+facel)
2489 * Radial derivatives. First process both termini of the fragment (i,j)
2496 gelc(k,i)=gelc(k,i)+ghalf
2497 gelc(k,j)=gelc(k,j)+ghalf
2500 * Loop over residues i+1 thru j-1.
2504 gelc(l,k)=gelc(l,k)+ggg(l)
2511 ecosa=2.0D0*fac3*fac1+fac4
2514 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2515 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2517 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2518 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2520 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2521 cd & (dcosg(k),k=1,3)
2523 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2524 & *fac_shield(i)**2*fac_shield(j)**2
2528 gelc(k,i)=gelc(k,i)+ghalf
2529 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2530 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2531 & *fac_shield(i)**2*fac_shield(j)**2
2533 gelc(k,j)=gelc(k,j)+ghalf
2534 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2535 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2536 & *fac_shield(i)**2*fac_shield(j)**2
2540 gelc(l,k)=gelc(l,k)+ggg(l)
2545 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2546 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2547 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2549 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2550 C energy of a peptide unit is assumed in the form of a second-order
2551 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2552 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2553 C are computed for EVERY pair of non-contiguous peptide groups.
2555 if (j.lt.nres-1) then
2566 muij(kkk)=mu(k,i)*mu(l,j)
2569 cd write (iout,*) 'EELEC: i',i,' j',j
2570 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2571 cd write(iout,*) 'muij',muij
2572 ury=scalar(uy(1,i),erij)
2573 urz=scalar(uz(1,i),erij)
2574 vry=scalar(uy(1,j),erij)
2575 vrz=scalar(uz(1,j),erij)
2576 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2577 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2578 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2579 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2580 C For diagnostics only
2585 fac=dsqrt(-ael6i)*r3ij
2586 cd write (2,*) 'fac=',fac
2587 C For diagnostics only
2593 cd write (iout,'(4i5,4f10.5)')
2594 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2595 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2596 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2597 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2598 cd write (iout,'(4f10.5)')
2599 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2600 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2601 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2602 cd write (iout,'(2i3,9f10.5/)') i,j,
2603 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2605 C Derivatives of the elements of A in virtual-bond vectors
2606 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2613 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2614 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2615 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2616 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2617 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2618 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2619 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2620 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2621 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2622 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2623 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2624 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2634 C Compute radial contributions to the gradient
2656 C Add the contributions coming from er
2659 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2660 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2661 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2662 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2665 C Derivatives in DC(i)
2666 ghalf1=0.5d0*agg(k,1)
2667 ghalf2=0.5d0*agg(k,2)
2668 ghalf3=0.5d0*agg(k,3)
2669 ghalf4=0.5d0*agg(k,4)
2670 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2671 & -3.0d0*uryg(k,2)*vry)+ghalf1
2672 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2673 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2674 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2675 & -3.0d0*urzg(k,2)*vry)+ghalf3
2676 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2677 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2678 C Derivatives in DC(i+1)
2679 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2680 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2681 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2682 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2683 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2684 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2685 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2686 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2687 C Derivatives in DC(j)
2688 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2689 & -3.0d0*vryg(k,2)*ury)+ghalf1
2690 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2691 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2692 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2693 & -3.0d0*vryg(k,2)*urz)+ghalf3
2694 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2695 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2696 C Derivatives in DC(j+1) or DC(nres-1)
2697 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2698 & -3.0d0*vryg(k,3)*ury)
2699 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2700 & -3.0d0*vrzg(k,3)*ury)
2701 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2702 & -3.0d0*vryg(k,3)*urz)
2703 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2704 & -3.0d0*vrzg(k,3)*urz)
2709 C Derivatives in DC(i+1)
2710 cd aggi1(k,1)=agg(k,1)
2711 cd aggi1(k,2)=agg(k,2)
2712 cd aggi1(k,3)=agg(k,3)
2713 cd aggi1(k,4)=agg(k,4)
2714 C Derivatives in DC(j)
2719 C Derivatives in DC(j+1)
2724 if (j.eq.nres-1 .and. i.lt.j-2) then
2726 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2727 cd aggj1(k,l)=agg(k,l)
2733 C Check the loc-el terms by numerical integration
2743 aggi(k,l)=-aggi(k,l)
2744 aggi1(k,l)=-aggi1(k,l)
2745 aggj(k,l)=-aggj(k,l)
2746 aggj1(k,l)=-aggj1(k,l)
2749 if (j.lt.nres-1) then
2755 aggi(k,l)=-aggi(k,l)
2756 aggi1(k,l)=-aggi1(k,l)
2757 aggj(k,l)=-aggj(k,l)
2758 aggj1(k,l)=-aggj1(k,l)
2769 aggi(k,l)=-aggi(k,l)
2770 aggi1(k,l)=-aggi1(k,l)
2771 aggj(k,l)=-aggj(k,l)
2772 aggj1(k,l)=-aggj1(k,l)
2778 IF (wel_loc.gt.0.0d0) THEN
2779 C Contribution to the local-electrostatic energy coming from the i-j pair
2780 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2782 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2783 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2784 if (shield_mode.eq.0) then
2791 eel_loc_ij=eel_loc_ij
2792 & *fac_shield(i)*fac_shield(j)
2793 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2795 eel_loc=eel_loc+eel_loc_ij
2796 C Partial derivatives in virtual-bond dihedral angles gamma
2798 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2799 & (shield_mode.gt.0)) then
2802 do ilist=1,ishield_list(i)
2803 iresshield=shield_list(ilist,i)
2805 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2808 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2810 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2811 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2815 do ilist=1,ishield_list(j)
2816 iresshield=shield_list(ilist,j)
2818 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2821 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2823 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2824 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2830 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2831 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2832 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2833 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2834 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2835 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2836 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2837 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2841 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2842 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2843 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2844 & *fac_shield(i)*fac_shield(j)
2845 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2846 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2847 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2848 & *fac_shield(i)*fac_shield(j)
2850 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2851 cd write(iout,*) 'agg ',agg
2852 cd write(iout,*) 'aggi ',aggi
2853 cd write(iout,*) 'aggi1',aggi1
2854 cd write(iout,*) 'aggj ',aggj
2855 cd write(iout,*) 'aggj1',aggj1
2857 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2859 ggg(l)=(agg(l,1)*muij(1)+
2860 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2861 & *fac_shield(i)*fac_shield(j)
2862 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2867 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2870 C Remaining derivatives of eello
2872 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2873 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2874 & *fac_shield(i)*fac_shield(j)
2875 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2877 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2878 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2879 & *fac_shield(i)*fac_shield(j)
2880 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2882 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2883 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2884 & *fac_shield(i)*fac_shield(j)
2885 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2887 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2888 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2889 & *fac_shield(i)*fac_shield(j)
2890 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2895 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2896 C Contributions from turns
2901 call eturn34(i,j,eello_turn3,eello_turn4)
2903 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2904 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2906 C Calculate the contact function. The ith column of the array JCONT will
2907 C contain the numbers of atoms that make contacts with the atom I (of numbers
2908 C greater than I). The arrays FACONT and GACONT will contain the values of
2909 C the contact function and its derivative.
2910 c r0ij=1.02D0*rpp(iteli,itelj)
2911 c r0ij=1.11D0*rpp(iteli,itelj)
2912 r0ij=2.20D0*rpp(iteli,itelj)
2913 c r0ij=1.55D0*rpp(iteli,itelj)
2914 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2915 if (fcont.gt.0.0D0) then
2916 num_conti=num_conti+1
2917 if (num_conti.gt.maxconts) then
2918 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2919 & ' will skip next contacts for this conf.'
2921 jcont_hb(num_conti,i)=j
2922 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2923 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2924 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2926 d_cont(num_conti,i)=rij
2927 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2928 C --- Electrostatic-interaction matrix ---
2929 a_chuj(1,1,num_conti,i)=a22
2930 a_chuj(1,2,num_conti,i)=a23
2931 a_chuj(2,1,num_conti,i)=a32
2932 a_chuj(2,2,num_conti,i)=a33
2933 C --- Gradient of rij
2935 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2938 c a_chuj(1,1,num_conti,i)=-0.61d0
2939 c a_chuj(1,2,num_conti,i)= 0.4d0
2940 c a_chuj(2,1,num_conti,i)= 0.65d0
2941 c a_chuj(2,2,num_conti,i)= 0.50d0
2942 c else if (i.eq.2) then
2943 c a_chuj(1,1,num_conti,i)= 0.0d0
2944 c a_chuj(1,2,num_conti,i)= 0.0d0
2945 c a_chuj(2,1,num_conti,i)= 0.0d0
2946 c a_chuj(2,2,num_conti,i)= 0.0d0
2948 C --- and its gradients
2949 cd write (iout,*) 'i',i,' j',j
2951 cd write (iout,*) 'iii 1 kkk',kkk
2952 cd write (iout,*) agg(kkk,:)
2955 cd write (iout,*) 'iii 2 kkk',kkk
2956 cd write (iout,*) aggi(kkk,:)
2959 cd write (iout,*) 'iii 3 kkk',kkk
2960 cd write (iout,*) aggi1(kkk,:)
2963 cd write (iout,*) 'iii 4 kkk',kkk
2964 cd write (iout,*) aggj(kkk,:)
2967 cd write (iout,*) 'iii 5 kkk',kkk
2968 cd write (iout,*) aggj1(kkk,:)
2975 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2976 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2977 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2978 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2979 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2981 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2987 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2988 C Calculate contact energies
2990 wij=cosa-3.0D0*cosb*cosg
2993 c fac3=dsqrt(-ael6i)/r0ij**3
2994 fac3=dsqrt(-ael6i)*r3ij
2995 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2996 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2997 if (shield_mode.eq.0) then
3001 ees0plist(num_conti,i)=j
3002 C fac_shield(i)=0.4d0
3003 C fac_shield(j)=0.6d0
3006 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3007 & *fac_shield(i)*fac_shield(j)
3009 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3010 & *fac_shield(i)*fac_shield(j)
3012 C Diagnostics. Comment out or remove after debugging!
3013 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3014 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3015 c ees0m(num_conti,i)=0.0D0
3017 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3018 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3019 facont_hb(num_conti,i)=fcont
3021 C Angular derivatives of the contact function
3022 ees0pij1=fac3/ees0pij
3023 ees0mij1=fac3/ees0mij
3024 fac3p=-3.0D0*fac3*rrmij
3025 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3026 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3028 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3029 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3030 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3031 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3032 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3033 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3034 ecosap=ecosa1+ecosa2
3035 ecosbp=ecosb1+ecosb2
3036 ecosgp=ecosg1+ecosg2
3037 ecosam=ecosa1-ecosa2
3038 ecosbm=ecosb1-ecosb2
3039 ecosgm=ecosg1-ecosg2
3048 fprimcont=fprimcont/rij
3049 cd facont_hb(num_conti,i)=1.0D0
3050 C Following line is for diagnostics.
3053 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3054 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3057 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3058 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3060 gggp(1)=gggp(1)+ees0pijp*xj
3061 gggp(2)=gggp(2)+ees0pijp*yj
3062 gggp(3)=gggp(3)+ees0pijp*zj
3063 gggm(1)=gggm(1)+ees0mijp*xj
3064 gggm(2)=gggm(2)+ees0mijp*yj
3065 gggm(3)=gggm(3)+ees0mijp*zj
3066 C Derivatives due to the contact function
3067 gacont_hbr(1,num_conti,i)=fprimcont*xj
3068 gacont_hbr(2,num_conti,i)=fprimcont*yj
3069 gacont_hbr(3,num_conti,i)=fprimcont*zj
3071 ghalfp=0.5D0*gggp(k)
3072 ghalfm=0.5D0*gggm(k)
3073 gacontp_hb1(k,num_conti,i)=ghalfp
3074 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3075 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3076 & *fac_shield(i)*fac_shield(j)
3078 gacontp_hb2(k,num_conti,i)=ghalfp
3079 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3080 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3081 & *fac_shield(i)*fac_shield(j)
3083 gacontp_hb3(k,num_conti,i)=gggp(k)
3084 & *fac_shield(i)*fac_shield(j)
3086 gacontm_hb1(k,num_conti,i)=ghalfm
3087 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3088 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3089 & *fac_shield(i)*fac_shield(j)
3091 gacontm_hb2(k,num_conti,i)=ghalfm
3092 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3093 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3094 & *fac_shield(i)*fac_shield(j)
3096 gacontm_hb3(k,num_conti,i)=gggm(k)
3097 & *fac_shield(i)*fac_shield(j)
3101 C Diagnostics. Comment out or remove after debugging!
3103 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3104 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3105 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3106 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3107 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3108 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3111 endif ! num_conti.le.maxconts
3116 num_cont_hb(i)=num_conti
3120 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3121 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3123 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3124 ccc eel_loc=eel_loc+eello_turn3
3127 C-----------------------------------------------------------------------------
3128 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3129 C Third- and fourth-order contributions from turns
3130 implicit real*8 (a-h,o-z)
3131 include 'DIMENSIONS'
3132 include 'sizesclu.dat'
3133 include 'COMMON.IOUNITS'
3134 include 'COMMON.GEO'
3135 include 'COMMON.VAR'
3136 include 'COMMON.LOCAL'
3137 include 'COMMON.CHAIN'
3138 include 'COMMON.DERIV'
3139 include 'COMMON.INTERACT'
3140 include 'COMMON.CONTACTS'
3141 include 'COMMON.TORSION'
3142 include 'COMMON.VECTORS'
3143 include 'COMMON.FFIELD'
3144 include 'COMMON.SHIELD'
3145 include 'COMMON.CONTROL'
3148 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3149 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3150 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3151 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3152 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3153 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3155 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3156 C changes suggested by Ana to avoid out of bounds
3157 C & .or.((i+5).gt.nres)
3158 C & .or.((i-1).le.0)
3159 C end of changes suggested by Ana
3160 & .or. itype(i+2).eq.ntyp1
3161 & .or. itype(i+3).eq.ntyp1
3162 C & .or. itype(i+5).eq.ntyp1
3163 C & .or. itype(i).eq.ntyp1
3164 C & .or. itype(i-1).eq.ntyp1
3167 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3169 C Third-order contributions
3176 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3177 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3178 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3179 call transpose2(auxmat(1,1),auxmat1(1,1))
3180 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3181 if (shield_mode.eq.0) then
3188 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3189 & *fac_shield(i)*fac_shield(j)
3190 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3192 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3193 & *fac_shield(i)*fac_shield(j)
3194 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3196 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3197 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3198 cd & ' eello_turn3_num',4*eello_turn3_num
3200 C Derivatives in shield mode
3201 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3202 & (shield_mode.gt.0)) then
3205 do ilist=1,ishield_list(i)
3206 iresshield=shield_list(ilist,i)
3208 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3210 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3212 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3213 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3217 do ilist=1,ishield_list(j)
3218 iresshield=shield_list(ilist,j)
3220 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3222 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3224 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3225 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3232 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3233 & grad_shield(k,i)*eello_t3/fac_shield(i)
3234 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3235 & grad_shield(k,j)*eello_t3/fac_shield(j)
3236 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3237 & grad_shield(k,i)*eello_t3/fac_shield(i)
3238 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3239 & grad_shield(k,j)*eello_t3/fac_shield(j)
3243 C Derivatives in gamma(i)
3244 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3245 call transpose2(auxmat2(1,1),pizda(1,1))
3246 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3247 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3248 & *fac_shield(i)*fac_shield(j)
3250 C Derivatives in gamma(i+1)
3251 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3252 call transpose2(auxmat2(1,1),pizda(1,1))
3253 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3254 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3255 & +0.5d0*(pizda(1,1)+pizda(2,2))
3256 & *fac_shield(i)*fac_shield(j)
3258 C Cartesian derivatives
3260 a_temp(1,1)=aggi(l,1)
3261 a_temp(1,2)=aggi(l,2)
3262 a_temp(2,1)=aggi(l,3)
3263 a_temp(2,2)=aggi(l,4)
3264 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3265 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3266 & +0.5d0*(pizda(1,1)+pizda(2,2))
3267 & *fac_shield(i)*fac_shield(j)
3268 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3270 a_temp(1,1)=aggi1(l,1)
3271 a_temp(1,2)=aggi1(l,2)
3272 a_temp(2,1)=aggi1(l,3)
3273 a_temp(2,2)=aggi1(l,4)
3274 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3275 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3276 & +0.5d0*(pizda(1,1)+pizda(2,2))
3277 & *fac_shield(i)*fac_shield(j)
3278 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3280 a_temp(1,1)=aggj(l,1)
3281 a_temp(1,2)=aggj(l,2)
3282 a_temp(2,1)=aggj(l,3)
3283 a_temp(2,2)=aggj(l,4)
3284 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3285 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3286 & +0.5d0*(pizda(1,1)+pizda(2,2))
3287 & *fac_shield(i)*fac_shield(j)
3288 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3290 a_temp(1,1)=aggj1(l,1)
3291 a_temp(1,2)=aggj1(l,2)
3292 a_temp(2,1)=aggj1(l,3)
3293 a_temp(2,2)=aggj1(l,4)
3294 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3295 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3296 & +0.5d0*(pizda(1,1)+pizda(2,2))
3297 & *fac_shield(i)*fac_shield(j)
3298 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3303 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3304 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3305 C changes suggested by Ana to avoid out of bounds
3306 C & .or.((i+5).gt.nres)
3307 C & .or.((i-1).le.0)
3308 C end of changes suggested by Ana
3309 & .or. itype(i+3).eq.ntyp1
3310 & .or. itype(i+4).eq.ntyp1
3311 C & .or. itype(i+5).eq.ntyp1
3312 & .or. itype(i).eq.ntyp1
3313 C & .or. itype(i-1).eq.ntyp1
3316 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3318 C Fourth-order contributions
3326 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3327 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3328 iti1=itortyp(itype(i+1))
3329 iti2=itortyp(itype(i+2))
3330 iti3=itortyp(itype(i+3))
3331 call transpose2(EUg(1,1,i+1),e1t(1,1))
3332 call transpose2(Eug(1,1,i+2),e2t(1,1))
3333 call transpose2(Eug(1,1,i+3),e3t(1,1))
3334 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3335 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3336 s1=scalar2(b1(1,iti2),auxvec(1))
3337 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3338 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3339 s2=scalar2(b1(1,iti1),auxvec(1))
3340 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3341 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3342 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3343 if (shield_mode.eq.0) then
3350 eello_turn4=eello_turn4-(s1+s2+s3)
3351 & *fac_shield(i)*fac_shield(j)
3352 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3354 eello_t4=-(s1+s2+s3)
3355 & *fac_shield(i)*fac_shield(j)
3356 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3358 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3359 cd & ' eello_turn4_num',8*eello_turn4_num
3360 C Derivatives in gamma(i)
3362 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3363 & (shield_mode.gt.0)) then
3366 do ilist=1,ishield_list(i)
3367 iresshield=shield_list(ilist,i)
3369 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3371 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3373 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3374 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3378 do ilist=1,ishield_list(j)
3379 iresshield=shield_list(ilist,j)
3381 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3383 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3385 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3386 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3393 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3394 & grad_shield(k,i)*eello_t4/fac_shield(i)
3395 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3396 & grad_shield(k,j)*eello_t4/fac_shield(j)
3397 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3398 & grad_shield(k,i)*eello_t4/fac_shield(i)
3399 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3400 & grad_shield(k,j)*eello_t4/fac_shield(j)
3404 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3405 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3406 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3407 s1=scalar2(b1(1,iti2),auxvec(1))
3408 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3409 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3410 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3411 & *fac_shield(i)*fac_shield(j)
3412 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3414 C Derivatives in gamma(i+1)
3415 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3416 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3417 s2=scalar2(b1(1,iti1),auxvec(1))
3418 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3419 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3420 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3421 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3422 & *fac_shield(i)*fac_shield(j)
3423 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3425 C Derivatives in gamma(i+2)
3426 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3427 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3428 s1=scalar2(b1(1,iti2),auxvec(1))
3429 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3430 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3431 s2=scalar2(b1(1,iti1),auxvec(1))
3432 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3433 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3434 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3435 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3436 & *fac_shield(i)*fac_shield(j)
3437 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3439 C Cartesian derivatives
3440 C Derivatives of this turn contributions in DC(i+2)
3441 if (j.lt.nres-1) then
3443 a_temp(1,1)=agg(l,1)
3444 a_temp(1,2)=agg(l,2)
3445 a_temp(2,1)=agg(l,3)
3446 a_temp(2,2)=agg(l,4)
3447 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3448 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3449 s1=scalar2(b1(1,iti2),auxvec(1))
3450 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3451 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3452 s2=scalar2(b1(1,iti1),auxvec(1))
3453 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3454 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3455 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3457 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3458 & *fac_shield(i)*fac_shield(j)
3459 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3463 C Remaining derivatives of this turn contribution
3465 a_temp(1,1)=aggi(l,1)
3466 a_temp(1,2)=aggi(l,2)
3467 a_temp(2,1)=aggi(l,3)
3468 a_temp(2,2)=aggi(l,4)
3469 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3470 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3471 s1=scalar2(b1(1,iti2),auxvec(1))
3472 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3473 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3474 s2=scalar2(b1(1,iti1),auxvec(1))
3475 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3476 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3477 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3478 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3479 & *fac_shield(i)*fac_shield(j)
3480 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3482 a_temp(1,1)=aggi1(l,1)
3483 a_temp(1,2)=aggi1(l,2)
3484 a_temp(2,1)=aggi1(l,3)
3485 a_temp(2,2)=aggi1(l,4)
3486 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3487 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3488 s1=scalar2(b1(1,iti2),auxvec(1))
3489 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3490 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3491 s2=scalar2(b1(1,iti1),auxvec(1))
3492 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3493 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3494 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3495 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3496 & *fac_shield(i)*fac_shield(j)
3497 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3499 a_temp(1,1)=aggj(l,1)
3500 a_temp(1,2)=aggj(l,2)
3501 a_temp(2,1)=aggj(l,3)
3502 a_temp(2,2)=aggj(l,4)
3503 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3504 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3505 s1=scalar2(b1(1,iti2),auxvec(1))
3506 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3507 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3508 s2=scalar2(b1(1,iti1),auxvec(1))
3509 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3510 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3511 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3512 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3513 & *fac_shield(i)*fac_shield(j)
3514 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3516 a_temp(1,1)=aggj1(l,1)
3517 a_temp(1,2)=aggj1(l,2)
3518 a_temp(2,1)=aggj1(l,3)
3519 a_temp(2,2)=aggj1(l,4)
3520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3522 s1=scalar2(b1(1,iti2),auxvec(1))
3523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3525 s2=scalar2(b1(1,iti1),auxvec(1))
3526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3529 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3530 & *fac_shield(i)*fac_shield(j)
3531 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3539 C-----------------------------------------------------------------------------
3540 subroutine vecpr(u,v,w)
3541 implicit real*8(a-h,o-z)
3542 dimension u(3),v(3),w(3)
3543 w(1)=u(2)*v(3)-u(3)*v(2)
3544 w(2)=-u(1)*v(3)+u(3)*v(1)
3545 w(3)=u(1)*v(2)-u(2)*v(1)
3548 C-----------------------------------------------------------------------------
3549 subroutine unormderiv(u,ugrad,unorm,ungrad)
3550 C This subroutine computes the derivatives of a normalized vector u, given
3551 C the derivatives computed without normalization conditions, ugrad. Returns
3554 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3555 double precision vec(3)
3556 double precision scalar
3558 c write (2,*) 'ugrad',ugrad
3561 vec(i)=scalar(ugrad(1,i),u(1))
3563 c write (2,*) 'vec',vec
3566 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3569 c write (2,*) 'ungrad',ungrad
3572 C-----------------------------------------------------------------------------
3573 subroutine escp(evdw2,evdw2_14)
3575 C This subroutine calculates the excluded-volume interaction energy between
3576 C peptide-group centers and side chains and its gradient in virtual-bond and
3577 C side-chain vectors.
3579 implicit real*8 (a-h,o-z)
3580 include 'DIMENSIONS'
3581 include 'sizesclu.dat'
3582 include 'COMMON.GEO'
3583 include 'COMMON.VAR'
3584 include 'COMMON.LOCAL'
3585 include 'COMMON.CHAIN'
3586 include 'COMMON.DERIV'
3587 include 'COMMON.INTERACT'
3588 include 'COMMON.FFIELD'
3589 include 'COMMON.IOUNITS'
3593 cd print '(a)','Enter ESCP'
3594 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3595 c & ' scal14',scal14
3596 do i=iatscp_s,iatscp_e
3597 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3599 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3600 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3601 if (iteli.eq.0) goto 1225
3602 xi=0.5D0*(c(1,i)+c(1,i+1))
3603 yi=0.5D0*(c(2,i)+c(2,i+1))
3604 zi=0.5D0*(c(3,i)+c(3,i+1))
3605 C Returning the ith atom to box
3607 if (xi.lt.0) xi=xi+boxxsize
3609 if (yi.lt.0) yi=yi+boxysize
3611 if (zi.lt.0) zi=zi+boxzsize
3613 do iint=1,nscp_gr(i)
3615 do j=iscpstart(i,iint),iscpend(i,iint)
3616 itypj=iabs(itype(j))
3617 if (itypj.eq.ntyp1) cycle
3618 C Uncomment following three lines for SC-p interactions
3622 C Uncomment following three lines for Ca-p interactions
3626 C returning the jth atom to box
3628 if (xj.lt.0) xj=xj+boxxsize
3630 if (yj.lt.0) yj=yj+boxysize
3632 if (zj.lt.0) zj=zj+boxzsize
3633 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3638 C Finding the closest jth atom
3642 xj=xj_safe+xshift*boxxsize
3643 yj=yj_safe+yshift*boxysize
3644 zj=zj_safe+zshift*boxzsize
3645 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3646 if(dist_temp.lt.dist_init) then
3656 if (subchap.eq.1) then
3666 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3667 C sss is scaling function for smoothing the cutoff gradient otherwise
3668 C the gradient would not be continuouse
3669 sss=sscale(1.0d0/(dsqrt(rrij)))
3670 if (sss.le.0.0d0) cycle
3671 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3673 e1=fac*fac*aad(itypj,iteli)
3674 e2=fac*bad(itypj,iteli)
3675 if (iabs(j-i) .le. 2) then
3678 evdw2_14=evdw2_14+(e1+e2)*sss
3681 c write (iout,*) i,j,evdwij
3682 evdw2=evdw2+evdwij*sss
3685 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3687 fac=-(evdwij+e1)*rrij*sss
3688 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3693 cd write (iout,*) 'j<i'
3694 C Uncomment following three lines for SC-p interactions
3696 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3699 cd write (iout,*) 'j>i'
3702 C Uncomment following line for SC-p interactions
3703 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3707 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3711 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3712 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3715 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3725 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3726 gradx_scp(j,i)=expon*gradx_scp(j,i)
3729 C******************************************************************************
3733 C To save time the factor EXPON has been extracted from ALL components
3734 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3737 C******************************************************************************
3740 C--------------------------------------------------------------------------
3741 subroutine edis(ehpb)
3743 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3745 implicit real*8 (a-h,o-z)
3746 include 'DIMENSIONS'
3747 include 'sizesclu.dat'
3748 include 'COMMON.SBRIDGE'
3749 include 'COMMON.CHAIN'
3750 include 'COMMON.DERIV'
3751 include 'COMMON.VAR'
3752 include 'COMMON.INTERACT'
3753 include 'COMMON.CONTROL'
3756 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3757 cd print *,'link_start=',link_start,' link_end=',link_end
3758 if (link_end.eq.0) return
3759 do i=link_start,link_end
3760 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3761 C CA-CA distance used in regularization of structure.
3764 C iii and jjj point to the residues for which the distance is assigned.
3765 if (ii.gt.nres) then
3772 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3773 C distance and angle dependent SS bond potential.
3774 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3775 C & iabs(itype(jjj)).eq.1) then
3776 C call ssbond_ene(iii,jjj,eij)
3779 if (.not.dyn_ss .and. i.le.nss) then
3780 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3781 & iabs(itype(jjj)).eq.1) then
3782 call ssbond_ene(iii,jjj,eij)
3785 else if (ii.gt.nres .and. jj.gt.nres) then
3786 c Restraints from contact prediction
3788 if (constr_dist.eq.11) then
3789 C ehpb=ehpb+fordepth(i)**4.0d0
3790 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3791 ehpb=ehpb+fordepth(i)**4.0d0
3792 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3793 fac=fordepth(i)**4.0d0
3794 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3795 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3796 C & ehpb,fordepth(i),dd
3798 C write(iout,*) ehpb,"atu?"
3800 C fac=fordepth(i)**4.0d0
3801 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3802 else !constr_dist.eq.11
3803 if (dhpb1(i).gt.0.0d0) then
3804 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3805 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3806 c write (iout,*) "beta nmr",
3807 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3808 else !dhpb(i).gt.0.00
3810 C Calculate the distance between the two points and its difference from the
3814 C Get the force constant corresponding to this distance.
3816 C Calculate the contribution to energy.
3817 ehpb=ehpb+waga*rdis*rdis
3819 C Evaluate gradient.
3824 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3825 cd & ' waga=',waga,' fac=',fac
3827 ggg(j)=fac*(c(j,jj)-c(j,ii))
3829 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3830 C If this is a SC-SC distance, we need to calculate the contributions to the
3831 C Cartesian gradient in the SC vectors (ghpbx).
3834 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3835 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3839 C write(iout,*) "before"
3841 C write(iout,*) "after",dd
3842 if (constr_dist.eq.11) then
3843 ehpb=ehpb+fordepth(i)**4.0d0
3844 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3845 fac=fordepth(i)**4.0d0
3846 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3847 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3848 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3849 C print *,ehpb,"tu?"
3850 C write(iout,*) ehpb,"btu?",
3851 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3852 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3853 C & ehpb,fordepth(i),dd
3855 if (dhpb1(i).gt.0.0d0) then
3856 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3857 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3858 c write (iout,*) "alph nmr",
3859 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3862 C Get the force constant corresponding to this distance.
3864 C Calculate the contribution to energy.
3865 ehpb=ehpb+waga*rdis*rdis
3866 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3868 C Evaluate gradient.
3874 ggg(j)=fac*(c(j,jj)-c(j,ii))
3876 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3877 C If this is a SC-SC distance, we need to calculate the contributions to the
3878 C Cartesian gradient in the SC vectors (ghpbx).
3881 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3882 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3887 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3892 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3895 C--------------------------------------------------------------------------
3896 subroutine ssbond_ene(i,j,eij)
3898 C Calculate the distance and angle dependent SS-bond potential energy
3899 C using a free-energy function derived based on RHF/6-31G** ab initio
3900 C calculations of diethyl disulfide.
3902 C A. Liwo and U. Kozlowska, 11/24/03
3904 implicit real*8 (a-h,o-z)
3905 include 'DIMENSIONS'
3906 include 'sizesclu.dat'
3907 include 'COMMON.SBRIDGE'
3908 include 'COMMON.CHAIN'
3909 include 'COMMON.DERIV'
3910 include 'COMMON.LOCAL'
3911 include 'COMMON.INTERACT'
3912 include 'COMMON.VAR'
3913 include 'COMMON.IOUNITS'
3914 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3915 itypi=iabs(itype(i))
3919 dxi=dc_norm(1,nres+i)
3920 dyi=dc_norm(2,nres+i)
3921 dzi=dc_norm(3,nres+i)
3922 dsci_inv=dsc_inv(itypi)
3923 itypj=iabs(itype(j))
3924 dscj_inv=dsc_inv(itypj)
3928 dxj=dc_norm(1,nres+j)
3929 dyj=dc_norm(2,nres+j)
3930 dzj=dc_norm(3,nres+j)
3931 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3936 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3937 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3938 om12=dxi*dxj+dyi*dyj+dzi*dzj
3940 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3941 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3947 deltat12=om2-om1+2.0d0
3949 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3950 & +akct*deltad*deltat12
3951 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3952 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3953 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3954 c & " deltat12",deltat12," eij",eij
3955 ed=2*akcm*deltad+akct*deltat12
3957 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3958 eom1=-2*akth*deltat1-pom1-om2*pom2
3959 eom2= 2*akth*deltat2+pom1-om1*pom2
3962 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3965 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3966 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3967 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3968 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3971 C Calculate the components of the gradient in DC and X
3975 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3980 C--------------------------------------------------------------------------
3981 subroutine ebond(estr)
3983 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3985 implicit real*8 (a-h,o-z)
3986 include 'DIMENSIONS'
3987 include 'sizesclu.dat'
3988 include 'COMMON.LOCAL'
3989 include 'COMMON.GEO'
3990 include 'COMMON.INTERACT'
3991 include 'COMMON.DERIV'
3992 include 'COMMON.VAR'
3993 include 'COMMON.CHAIN'
3994 include 'COMMON.IOUNITS'
3995 include 'COMMON.NAMES'
3996 include 'COMMON.FFIELD'
3997 include 'COMMON.CONTROL'
3998 logical energy_dec /.false./
3999 double precision u(3),ud(3)
4003 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4004 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4006 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4007 C & *dc(j,i-1)/vbld(i)
4009 C if (energy_dec) write(iout,*)
4010 C & "estr1",i,vbld(i),distchainmax,
4011 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4013 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4014 diff = vbld(i)-vbldpDUM
4016 diff = vbld(i)-vbldp0
4017 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4021 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4024 C write (iout,'(a7,i5,4f7.3)')
4025 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4027 estr=0.5d0*AKP*estr+estr1
4029 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4033 if (iti.ne.10 .and. iti.ne.ntyp1) then
4036 diff=vbld(i+nres)-vbldsc0(1,iti)
4037 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4038 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4039 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4041 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4045 diff=vbld(i+nres)-vbldsc0(j,iti)
4046 ud(j)=aksc(j,iti)*diff
4047 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4061 uprod2=uprod2*u(k)*u(k)
4065 usumsqder=usumsqder+ud(j)*uprod2
4067 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4068 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4069 estr=estr+uprod/usum
4071 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4079 C--------------------------------------------------------------------------
4080 subroutine ebend(etheta,ethetacnstr)
4082 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4083 C angles gamma and its derivatives in consecutive thetas and gammas.
4085 implicit real*8 (a-h,o-z)
4086 include 'DIMENSIONS'
4087 include 'sizesclu.dat'
4088 include 'COMMON.LOCAL'
4089 include 'COMMON.GEO'
4090 include 'COMMON.INTERACT'
4091 include 'COMMON.DERIV'
4092 include 'COMMON.VAR'
4093 include 'COMMON.CHAIN'
4094 include 'COMMON.IOUNITS'
4095 include 'COMMON.NAMES'
4096 include 'COMMON.FFIELD'
4097 include 'COMMON.TORCNSTR'
4098 common /calcthet/ term1,term2,termm,diffak,ratak,
4099 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4100 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4101 double precision y(2),z(2)
4103 c time11=dexp(-2*time)
4106 c write (iout,*) "nres",nres
4107 c write (*,'(a,i2)') 'EBEND ICG=',icg
4108 c write (iout,*) ithet_start,ithet_end
4109 do i=ithet_start,ithet_end
4111 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4112 & .or.itype(i).eq.ntyp1) cycle
4113 C Zero the energy function and its derivative at 0 or pi.
4114 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4116 ichir1=isign(1,itype(i-2))
4117 ichir2=isign(1,itype(i))
4118 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4119 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4120 if (itype(i-1).eq.10) then
4121 itype1=isign(10,itype(i-2))
4122 ichir11=isign(1,itype(i-2))
4123 ichir12=isign(1,itype(i-2))
4124 itype2=isign(10,itype(i))
4125 ichir21=isign(1,itype(i))
4126 ichir22=isign(1,itype(i))
4132 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4136 c call proc_proc(phii,icrc)
4137 if (icrc.eq.1) phii=150.0
4148 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4152 c call proc_proc(phii1,icrc)
4153 if (icrc.eq.1) phii1=150.0
4165 C Calculate the "mean" value of theta from the part of the distribution
4166 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4167 C In following comments this theta will be referred to as t_c.
4168 thet_pred_mean=0.0d0
4170 athetk=athet(k,it,ichir1,ichir2)
4171 bthetk=bthet(k,it,ichir1,ichir2)
4173 athetk=athet(k,itype1,ichir11,ichir12)
4174 bthetk=bthet(k,itype2,ichir21,ichir22)
4176 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4178 c write (iout,*) "thet_pred_mean",thet_pred_mean
4179 dthett=thet_pred_mean*ssd
4180 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4181 c write (iout,*) "thet_pred_mean",thet_pred_mean
4182 C Derivatives of the "mean" values in gamma1 and gamma2.
4183 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4184 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4185 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4186 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4188 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4189 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4190 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4191 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4193 if (theta(i).gt.pi-delta) then
4194 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4196 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4197 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4198 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4200 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4202 else if (theta(i).lt.delta) then
4203 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4204 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4205 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4207 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4208 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4211 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4214 etheta=etheta+ethetai
4215 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4216 c & rad2deg*phii,rad2deg*phii1,ethetai
4217 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4218 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4219 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4222 C Ufff.... We've done all this!!!
4225 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4226 do i=1,ntheta_constr
4227 itheta=itheta_constr(i)
4228 thetiii=theta(itheta)
4229 difi=pinorm(thetiii-theta_constr0(i))
4230 if (difi.gt.theta_drange(i)) then
4231 difi=difi-theta_drange(i)
4232 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4233 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4234 & +for_thet_constr(i)*difi**3
4235 else if (difi.lt.-drange(i)) then
4237 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4238 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4239 & +for_thet_constr(i)*difi**3
4243 C if (energy_dec) then
4244 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4245 C & i,itheta,rad2deg*thetiii,
4246 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4247 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4248 C & gloc(itheta+nphi-2,icg)
4253 C---------------------------------------------------------------------------
4254 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4256 implicit real*8 (a-h,o-z)
4257 include 'DIMENSIONS'
4258 include 'COMMON.LOCAL'
4259 include 'COMMON.IOUNITS'
4260 common /calcthet/ term1,term2,termm,diffak,ratak,
4261 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4262 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4263 C Calculate the contributions to both Gaussian lobes.
4264 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4265 C The "polynomial part" of the "standard deviation" of this part of
4269 sig=sig*thet_pred_mean+polthet(j,it)
4271 C Derivative of the "interior part" of the "standard deviation of the"
4272 C gamma-dependent Gaussian lobe in t_c.
4273 sigtc=3*polthet(3,it)
4275 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4278 C Set the parameters of both Gaussian lobes of the distribution.
4279 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4280 fac=sig*sig+sigc0(it)
4283 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4284 sigsqtc=-4.0D0*sigcsq*sigtc
4285 c print *,i,sig,sigtc,sigsqtc
4286 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4287 sigtc=-sigtc/(fac*fac)
4288 C Following variable is sigma(t_c)**(-2)
4289 sigcsq=sigcsq*sigcsq
4291 sig0inv=1.0D0/sig0i**2
4292 delthec=thetai-thet_pred_mean
4293 delthe0=thetai-theta0i
4294 term1=-0.5D0*sigcsq*delthec*delthec
4295 term2=-0.5D0*sig0inv*delthe0*delthe0
4296 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4297 C NaNs in taking the logarithm. We extract the largest exponent which is added
4298 C to the energy (this being the log of the distribution) at the end of energy
4299 C term evaluation for this virtual-bond angle.
4300 if (term1.gt.term2) then
4302 term2=dexp(term2-termm)
4306 term1=dexp(term1-termm)
4309 C The ratio between the gamma-independent and gamma-dependent lobes of
4310 C the distribution is a Gaussian function of thet_pred_mean too.
4311 diffak=gthet(2,it)-thet_pred_mean
4312 ratak=diffak/gthet(3,it)**2
4313 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4314 C Let's differentiate it in thet_pred_mean NOW.
4316 C Now put together the distribution terms to make complete distribution.
4317 termexp=term1+ak*term2
4318 termpre=sigc+ak*sig0i
4319 C Contribution of the bending energy from this theta is just the -log of
4320 C the sum of the contributions from the two lobes and the pre-exponential
4321 C factor. Simple enough, isn't it?
4322 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4323 C NOW the derivatives!!!
4324 C 6/6/97 Take into account the deformation.
4325 E_theta=(delthec*sigcsq*term1
4326 & +ak*delthe0*sig0inv*term2)/termexp
4327 E_tc=((sigtc+aktc*sig0i)/termpre
4328 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4329 & aktc*term2)/termexp)
4332 c-----------------------------------------------------------------------------
4333 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4334 implicit real*8 (a-h,o-z)
4335 include 'DIMENSIONS'
4336 include 'COMMON.LOCAL'
4337 include 'COMMON.IOUNITS'
4338 common /calcthet/ term1,term2,termm,diffak,ratak,
4339 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4340 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4341 delthec=thetai-thet_pred_mean
4342 delthe0=thetai-theta0i
4343 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4344 t3 = thetai-thet_pred_mean
4348 t14 = t12+t6*sigsqtc
4350 t21 = thetai-theta0i
4356 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4357 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4358 & *(-t12*t9-ak*sig0inv*t27)
4362 C--------------------------------------------------------------------------
4363 subroutine ebend(etheta,ethetacnstr)
4365 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4366 C angles gamma and its derivatives in consecutive thetas and gammas.
4367 C ab initio-derived potentials from
4368 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4370 implicit real*8 (a-h,o-z)
4371 include 'DIMENSIONS'
4372 include 'sizesclu.dat'
4373 include 'COMMON.LOCAL'
4374 include 'COMMON.GEO'
4375 include 'COMMON.INTERACT'
4376 include 'COMMON.DERIV'
4377 include 'COMMON.VAR'
4378 include 'COMMON.CHAIN'
4379 include 'COMMON.IOUNITS'
4380 include 'COMMON.NAMES'
4381 include 'COMMON.FFIELD'
4382 include 'COMMON.CONTROL'
4383 include 'COMMON.TORCNSTR'
4384 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4385 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4386 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4387 & sinph1ph2(maxdouble,maxdouble)
4388 logical lprn /.false./, lprn1 /.false./
4390 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4391 do i=ithet_start,ithet_end
4393 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4394 & .or.itype(i).eq.ntyp1) cycle
4395 c if (itype(i-1).eq.ntyp1) cycle
4396 if (iabs(itype(i+1)).eq.20) iblock=2
4397 if (iabs(itype(i+1)).ne.20) iblock=1
4401 theti2=0.5d0*theta(i)
4402 ityp2=ithetyp((itype(i-1)))
4404 coskt(k)=dcos(k*theti2)
4405 sinkt(k)=dsin(k*theti2)
4415 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4418 if (phii.ne.phii) phii=150.0
4422 ityp1=ithetyp((itype(i-2)))
4424 cosph1(k)=dcos(k*phii)
4425 sinph1(k)=dsin(k*phii)
4431 ityp1=ithetyp((itype(i-2)))
4437 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4440 if (phii1.ne.phii1) phii1=150.0
4445 ityp3=ithetyp((itype(i)))
4447 cosph2(k)=dcos(k*phii1)
4448 sinph2(k)=dsin(k*phii1)
4453 ityp3=ithetyp((itype(i)))
4459 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4460 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4462 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4465 ccl=cosph1(l)*cosph2(k-l)
4466 ssl=sinph1(l)*sinph2(k-l)
4467 scl=sinph1(l)*cosph2(k-l)
4468 csl=cosph1(l)*sinph2(k-l)
4469 cosph1ph2(l,k)=ccl-ssl
4470 cosph1ph2(k,l)=ccl+ssl
4471 sinph1ph2(l,k)=scl+csl
4472 sinph1ph2(k,l)=scl-csl
4476 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4477 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4478 write (iout,*) "coskt and sinkt"
4480 write (iout,*) k,coskt(k),sinkt(k)
4484 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4485 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4488 & write (iout,*) "k",k," aathet",
4489 & aathet(k,ityp1,ityp2,ityp3,iblock),
4490 & " ethetai",ethetai
4493 write (iout,*) "cosph and sinph"
4495 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4497 write (iout,*) "cosph1ph2 and sinph2ph2"
4500 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4501 & sinph1ph2(l,k),sinph1ph2(k,l)
4504 write(iout,*) "ethetai",ethetai
4508 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4509 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4510 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4511 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4512 ethetai=ethetai+sinkt(m)*aux
4513 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4514 dephii=dephii+k*sinkt(m)*(
4515 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4516 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4517 dephii1=dephii1+k*sinkt(m)*(
4518 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4519 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4521 & write (iout,*) "m",m," k",k," bbthet",
4522 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4523 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4524 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4525 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4529 & write(iout,*) "ethetai",ethetai
4533 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4534 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4535 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4536 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4537 ethetai=ethetai+sinkt(m)*aux
4538 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4539 dephii=dephii+l*sinkt(m)*(
4540 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4541 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4542 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4543 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4544 dephii1=dephii1+(k-l)*sinkt(m)*(
4545 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4546 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4547 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4548 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4550 write (iout,*) "m",m," k",k," l",l," ffthet",
4551 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4552 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4553 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4554 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4555 & " ethetai",ethetai
4556 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4557 & cosph1ph2(k,l)*sinkt(m),
4558 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4564 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4565 & i,theta(i)*rad2deg,phii*rad2deg,
4566 & phii1*rad2deg,ethetai
4567 etheta=etheta+ethetai
4568 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4569 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4570 c gloc(nphi+i-2,icg)=wang*dethetai
4571 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4575 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4576 do i=1,ntheta_constr
4577 itheta=itheta_constr(i)
4578 thetiii=theta(itheta)
4579 difi=pinorm(thetiii-theta_constr0(i))
4580 if (difi.gt.theta_drange(i)) then
4581 difi=difi-theta_drange(i)
4582 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4583 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4584 & +for_thet_constr(i)*difi**3
4585 else if (difi.lt.-drange(i)) then
4587 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4588 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4589 & +for_thet_constr(i)*difi**3
4593 C if (energy_dec) then
4594 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4595 C & i,itheta,rad2deg*thetiii,
4596 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4597 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4598 C & gloc(itheta+nphi-2,icg)
4605 c-----------------------------------------------------------------------------
4606 subroutine esc(escloc)
4607 C Calculate the local energy of a side chain and its derivatives in the
4608 C corresponding virtual-bond valence angles THETA and the spherical angles
4610 implicit real*8 (a-h,o-z)
4611 include 'DIMENSIONS'
4612 include 'sizesclu.dat'
4613 include 'COMMON.GEO'
4614 include 'COMMON.LOCAL'
4615 include 'COMMON.VAR'
4616 include 'COMMON.INTERACT'
4617 include 'COMMON.DERIV'
4618 include 'COMMON.CHAIN'
4619 include 'COMMON.IOUNITS'
4620 include 'COMMON.NAMES'
4621 include 'COMMON.FFIELD'
4622 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4623 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4624 common /sccalc/ time11,time12,time112,theti,it,nlobit
4627 c write (iout,'(a)') 'ESC'
4628 do i=loc_start,loc_end
4630 if (it.eq.ntyp1) cycle
4631 if (it.eq.10) goto 1
4632 nlobit=nlob(iabs(it))
4633 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4634 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4635 theti=theta(i+1)-pipol
4639 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4641 if (x(2).gt.pi-delta) then
4645 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4647 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4648 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4650 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4651 & ddersc0(1),dersc(1))
4652 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4653 & ddersc0(3),dersc(3))
4655 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4657 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4658 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4659 & dersc0(2),esclocbi,dersc02)
4660 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4662 call splinthet(x(2),0.5d0*delta,ss,ssd)
4667 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4669 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4670 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4672 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4674 c write (iout,*) escloci
4675 else if (x(2).lt.delta) then
4679 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4681 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4682 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4684 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4685 & ddersc0(1),dersc(1))
4686 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4687 & ddersc0(3),dersc(3))
4689 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4691 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4692 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4693 & dersc0(2),esclocbi,dersc02)
4694 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4699 call splinthet(x(2),0.5d0*delta,ss,ssd)
4701 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4703 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4704 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4706 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4707 c write (iout,*) escloci
4709 call enesc(x,escloci,dersc,ddummy,.false.)
4712 escloc=escloc+escloci
4713 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4715 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4717 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4718 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4723 C---------------------------------------------------------------------------
4724 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4725 implicit real*8 (a-h,o-z)
4726 include 'DIMENSIONS'
4727 include 'COMMON.GEO'
4728 include 'COMMON.LOCAL'
4729 include 'COMMON.IOUNITS'
4730 common /sccalc/ time11,time12,time112,theti,it,nlobit
4731 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4732 double precision contr(maxlob,-1:1)
4734 c write (iout,*) 'it=',it,' nlobit=',nlobit
4738 if (mixed) ddersc(j)=0.0d0
4742 C Because of periodicity of the dependence of the SC energy in omega we have
4743 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4744 C To avoid underflows, first compute & store the exponents.
4752 z(k)=x(k)-censc(k,j,it)
4757 Axk=Axk+gaussc(l,k,j,it)*z(l)
4763 expfac=expfac+Ax(k,j,iii)*z(k)
4771 C As in the case of ebend, we want to avoid underflows in exponentiation and
4772 C subsequent NaNs and INFs in energy calculation.
4773 C Find the largest exponent
4777 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4781 cd print *,'it=',it,' emin=',emin
4783 C Compute the contribution to SC energy and derivatives
4787 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4788 cd print *,'j=',j,' expfac=',expfac
4789 escloc_i=escloc_i+expfac
4791 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4795 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4796 & +gaussc(k,2,j,it))*expfac
4803 dersc(1)=dersc(1)/cos(theti)**2
4804 ddersc(1)=ddersc(1)/cos(theti)**2
4807 escloci=-(dlog(escloc_i)-emin)
4809 dersc(j)=dersc(j)/escloc_i
4813 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4818 C------------------------------------------------------------------------------
4819 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4820 implicit real*8 (a-h,o-z)
4821 include 'DIMENSIONS'
4822 include 'COMMON.GEO'
4823 include 'COMMON.LOCAL'
4824 include 'COMMON.IOUNITS'
4825 common /sccalc/ time11,time12,time112,theti,it,nlobit
4826 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4827 double precision contr(maxlob)
4838 z(k)=x(k)-censc(k,j,it)
4844 Axk=Axk+gaussc(l,k,j,it)*z(l)
4850 expfac=expfac+Ax(k,j)*z(k)
4855 C As in the case of ebend, we want to avoid underflows in exponentiation and
4856 C subsequent NaNs and INFs in energy calculation.
4857 C Find the largest exponent
4860 if (emin.gt.contr(j)) emin=contr(j)
4864 C Compute the contribution to SC energy and derivatives
4868 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4869 escloc_i=escloc_i+expfac
4871 dersc(k)=dersc(k)+Ax(k,j)*expfac
4873 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4874 & +gaussc(1,2,j,it))*expfac
4878 dersc(1)=dersc(1)/cos(theti)**2
4879 dersc12=dersc12/cos(theti)**2
4880 escloci=-(dlog(escloc_i)-emin)
4882 dersc(j)=dersc(j)/escloc_i
4884 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4888 c----------------------------------------------------------------------------------
4889 subroutine esc(escloc)
4890 C Calculate the local energy of a side chain and its derivatives in the
4891 C corresponding virtual-bond valence angles THETA and the spherical angles
4892 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4893 C added by Urszula Kozlowska. 07/11/2007
4895 implicit real*8 (a-h,o-z)
4896 include 'DIMENSIONS'
4897 include 'sizesclu.dat'
4898 include 'COMMON.GEO'
4899 include 'COMMON.LOCAL'
4900 include 'COMMON.VAR'
4901 include 'COMMON.SCROT'
4902 include 'COMMON.INTERACT'
4903 include 'COMMON.DERIV'
4904 include 'COMMON.CHAIN'
4905 include 'COMMON.IOUNITS'
4906 include 'COMMON.NAMES'
4907 include 'COMMON.FFIELD'
4908 include 'COMMON.CONTROL'
4909 include 'COMMON.VECTORS'
4910 double precision x_prime(3),y_prime(3),z_prime(3)
4911 & , sumene,dsc_i,dp2_i,x(65),
4912 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4913 & de_dxx,de_dyy,de_dzz,de_dt
4914 double precision s1_t,s1_6_t,s2_t,s2_6_t
4916 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4917 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4918 & dt_dCi(3),dt_dCi1(3)
4919 common /sccalc/ time11,time12,time112,theti,it,nlobit
4922 do i=loc_start,loc_end
4923 if (itype(i).eq.ntyp1) cycle
4924 costtab(i+1) =dcos(theta(i+1))
4925 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4926 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4927 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4928 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4929 cosfac=dsqrt(cosfac2)
4930 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4931 sinfac=dsqrt(sinfac2)
4933 if (it.eq.10) goto 1
4935 C Compute the axes of tghe local cartesian coordinates system; store in
4936 c x_prime, y_prime and z_prime
4943 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4944 C & dc_norm(3,i+nres)
4946 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4947 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4950 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4953 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4954 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4955 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4956 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4957 c & " xy",scalar(x_prime(1),y_prime(1)),
4958 c & " xz",scalar(x_prime(1),z_prime(1)),
4959 c & " yy",scalar(y_prime(1),y_prime(1)),
4960 c & " yz",scalar(y_prime(1),z_prime(1)),
4961 c & " zz",scalar(z_prime(1),z_prime(1))
4963 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4964 C to local coordinate system. Store in xx, yy, zz.
4970 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4971 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4972 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4979 C Compute the energy of the ith side cbain
4981 c write (2,*) "xx",xx," yy",yy," zz",zz
4984 x(j) = sc_parmin(j,it)
4987 Cc diagnostics - remove later
4989 yy1 = dsin(alph(2))*dcos(omeg(2))
4990 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4991 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4992 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4993 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4995 C," --- ", xx_w,yy_w,zz_w
4998 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4999 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5001 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5002 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5004 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5005 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5006 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5007 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5008 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5010 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5011 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5012 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5013 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5014 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5016 dsc_i = 0.743d0+x(61)
5018 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5019 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5020 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5021 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5022 s1=(1+x(63))/(0.1d0 + dscp1)
5023 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5024 s2=(1+x(65))/(0.1d0 + dscp2)
5025 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5026 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5027 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5028 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5030 c & dscp1,dscp2,sumene
5031 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5032 escloc = escloc + sumene
5033 c write (2,*) "escloc",escloc
5034 if (.not. calc_grad) goto 1
5037 C This section to check the numerical derivatives of the energy of ith side
5038 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5039 C #define DEBUG in the code to turn it on.
5041 write (2,*) "sumene =",sumene
5045 write (2,*) xx,yy,zz
5046 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5047 de_dxx_num=(sumenep-sumene)/aincr
5049 write (2,*) "xx+ sumene from enesc=",sumenep
5052 write (2,*) xx,yy,zz
5053 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5054 de_dyy_num=(sumenep-sumene)/aincr
5056 write (2,*) "yy+ sumene from enesc=",sumenep
5059 write (2,*) xx,yy,zz
5060 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5061 de_dzz_num=(sumenep-sumene)/aincr
5063 write (2,*) "zz+ sumene from enesc=",sumenep
5064 costsave=cost2tab(i+1)
5065 sintsave=sint2tab(i+1)
5066 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5067 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5068 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5069 de_dt_num=(sumenep-sumene)/aincr
5070 write (2,*) " t+ sumene from enesc=",sumenep
5071 cost2tab(i+1)=costsave
5072 sint2tab(i+1)=sintsave
5073 C End of diagnostics section.
5076 C Compute the gradient of esc
5078 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5079 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5080 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5081 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5082 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5083 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5084 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5085 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5086 pom1=(sumene3*sint2tab(i+1)+sumene1)
5087 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5088 pom2=(sumene4*cost2tab(i+1)+sumene2)
5089 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5090 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5091 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5092 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5094 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5095 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5096 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5098 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5099 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5100 & +(pom1+pom2)*pom_dx
5102 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5105 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5106 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5107 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5109 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5110 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5111 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5112 & +x(59)*zz**2 +x(60)*xx*zz
5113 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5114 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5115 & +(pom1-pom2)*pom_dy
5117 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5120 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5121 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5122 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5123 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5124 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5125 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5126 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5127 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5129 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5132 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5133 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5134 & +pom1*pom_dt1+pom2*pom_dt2
5136 write(2,*), "de_dt = ", de_dt,de_dt_num
5140 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5141 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5142 cosfac2xx=cosfac2*xx
5143 sinfac2yy=sinfac2*yy
5145 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5147 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5149 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5150 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5151 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5152 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5153 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5154 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5155 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5156 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5157 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5158 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5162 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5163 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5164 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5165 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5168 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5169 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5170 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5172 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5173 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5177 dXX_Ctab(k,i)=dXX_Ci(k)
5178 dXX_C1tab(k,i)=dXX_Ci1(k)
5179 dYY_Ctab(k,i)=dYY_Ci(k)
5180 dYY_C1tab(k,i)=dYY_Ci1(k)
5181 dZZ_Ctab(k,i)=dZZ_Ci(k)
5182 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5183 dXX_XYZtab(k,i)=dXX_XYZ(k)
5184 dYY_XYZtab(k,i)=dYY_XYZ(k)
5185 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5189 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5190 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5191 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5192 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5193 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5195 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5196 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5197 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5198 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5199 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5200 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5201 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5202 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5204 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5205 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5207 C to check gradient call subroutine check_grad
5214 c------------------------------------------------------------------------------
5215 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5217 C This procedure calculates two-body contact function g(rij) and its derivative:
5220 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5223 C where x=(rij-r0ij)/delta
5225 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5228 double precision rij,r0ij,eps0ij,fcont,fprimcont
5229 double precision x,x2,x4,delta
5233 if (x.lt.-1.0D0) then
5236 else if (x.le.1.0D0) then
5239 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5240 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5247 c------------------------------------------------------------------------------
5248 subroutine splinthet(theti,delta,ss,ssder)
5249 implicit real*8 (a-h,o-z)
5250 include 'DIMENSIONS'
5251 include 'sizesclu.dat'
5252 include 'COMMON.VAR'
5253 include 'COMMON.GEO'
5256 if (theti.gt.pipol) then
5257 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5259 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5264 c------------------------------------------------------------------------------
5265 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5267 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5268 double precision ksi,ksi2,ksi3,a1,a2,a3
5269 a1=fprim0*delta/(f1-f0)
5275 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5276 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5279 c------------------------------------------------------------------------------
5280 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5282 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5283 double precision ksi,ksi2,ksi3,a1,a2,a3
5288 a2=3*(f1x-f0x)-2*fprim0x*delta
5289 a3=fprim0x*delta-2*(f1x-f0x)
5290 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5293 C-----------------------------------------------------------------------------
5295 C-----------------------------------------------------------------------------
5296 subroutine etor(etors,edihcnstr,fact)
5297 implicit real*8 (a-h,o-z)
5298 include 'DIMENSIONS'
5299 include 'sizesclu.dat'
5300 include 'COMMON.VAR'
5301 include 'COMMON.GEO'
5302 include 'COMMON.LOCAL'
5303 include 'COMMON.TORSION'
5304 include 'COMMON.INTERACT'
5305 include 'COMMON.DERIV'
5306 include 'COMMON.CHAIN'
5307 include 'COMMON.NAMES'
5308 include 'COMMON.IOUNITS'
5309 include 'COMMON.FFIELD'
5310 include 'COMMON.TORCNSTR'
5312 C Set lprn=.true. for debugging
5316 do i=iphi_start,iphi_end
5317 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5318 & .or. itype(i).eq.ntyp1) cycle
5319 itori=itortyp(itype(i-2))
5320 itori1=itortyp(itype(i-1))
5323 C Proline-Proline pair is a special case...
5324 if (itori.eq.3 .and. itori1.eq.3) then
5325 if (phii.gt.-dwapi3) then
5327 fac=1.0D0/(1.0D0-cosphi)
5328 etorsi=v1(1,3,3)*fac
5329 etorsi=etorsi+etorsi
5330 etors=etors+etorsi-v1(1,3,3)
5331 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5334 v1ij=v1(j+1,itori,itori1)
5335 v2ij=v2(j+1,itori,itori1)
5338 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5339 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5343 v1ij=v1(j,itori,itori1)
5344 v2ij=v2(j,itori,itori1)
5347 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5348 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5352 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5353 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5354 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5355 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5356 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5358 ! 6/20/98 - dihedral angle constraints
5361 itori=idih_constr(i)
5364 if (difi.gt.drange(i)) then
5366 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5367 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5368 else if (difi.lt.-drange(i)) then
5370 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5371 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5373 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5374 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5376 ! write (iout,*) 'edihcnstr',edihcnstr
5379 c------------------------------------------------------------------------------
5381 subroutine etor(etors,edihcnstr,fact)
5382 implicit real*8 (a-h,o-z)
5383 include 'DIMENSIONS'
5384 include 'sizesclu.dat'
5385 include 'COMMON.VAR'
5386 include 'COMMON.GEO'
5387 include 'COMMON.LOCAL'
5388 include 'COMMON.TORSION'
5389 include 'COMMON.INTERACT'
5390 include 'COMMON.DERIV'
5391 include 'COMMON.CHAIN'
5392 include 'COMMON.NAMES'
5393 include 'COMMON.IOUNITS'
5394 include 'COMMON.FFIELD'
5395 include 'COMMON.TORCNSTR'
5397 C Set lprn=.true. for debugging
5401 do i=iphi_start,iphi_end
5403 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5404 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5405 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5406 if (iabs(itype(i)).eq.20) then
5411 itori=itortyp(itype(i-2))
5412 itori1=itortyp(itype(i-1))
5415 C Regular cosine and sine terms
5416 do j=1,nterm(itori,itori1,iblock)
5417 v1ij=v1(j,itori,itori1,iblock)
5418 v2ij=v2(j,itori,itori1,iblock)
5421 etors=etors+v1ij*cosphi+v2ij*sinphi
5422 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5426 C E = SUM ----------------------------------- - v1
5427 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5429 cosphi=dcos(0.5d0*phii)
5430 sinphi=dsin(0.5d0*phii)
5431 do j=1,nlor(itori,itori1,iblock)
5432 vl1ij=vlor1(j,itori,itori1)
5433 vl2ij=vlor2(j,itori,itori1)
5434 vl3ij=vlor3(j,itori,itori1)
5435 pom=vl2ij*cosphi+vl3ij*sinphi
5436 pom1=1.0d0/(pom*pom+1.0d0)
5437 etors=etors+vl1ij*pom1
5439 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5441 C Subtract the constant term
5442 etors=etors-v0(itori,itori1,iblock)
5444 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5445 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5446 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5447 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5448 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5451 ! 6/20/98 - dihedral angle constraints
5454 itori=idih_constr(i)
5456 difi=pinorm(phii-phi0(i))
5458 if (difi.gt.drange(i)) then
5460 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5461 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5462 edihi=0.25d0*ftors(i)*difi**4
5463 else if (difi.lt.-drange(i)) then
5465 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5466 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5467 edihi=0.25d0*ftors(i)*difi**4
5471 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5473 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5474 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5476 ! write (iout,*) 'edihcnstr',edihcnstr
5479 c----------------------------------------------------------------------------
5480 subroutine etor_d(etors_d,fact2)
5481 C 6/23/01 Compute double torsional energy
5482 implicit real*8 (a-h,o-z)
5483 include 'DIMENSIONS'
5484 include 'sizesclu.dat'
5485 include 'COMMON.VAR'
5486 include 'COMMON.GEO'
5487 include 'COMMON.LOCAL'
5488 include 'COMMON.TORSION'
5489 include 'COMMON.INTERACT'
5490 include 'COMMON.DERIV'
5491 include 'COMMON.CHAIN'
5492 include 'COMMON.NAMES'
5493 include 'COMMON.IOUNITS'
5494 include 'COMMON.FFIELD'
5495 include 'COMMON.TORCNSTR'
5497 C Set lprn=.true. for debugging
5501 do i=iphi_start,iphi_end-1
5503 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5504 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5505 & (itype(i+1).eq.ntyp1)) cycle
5506 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5508 itori=itortyp(itype(i-2))
5509 itori1=itortyp(itype(i-1))
5510 itori2=itortyp(itype(i))
5516 if (iabs(itype(i+1)).eq.20) iblock=2
5517 C Regular cosine and sine terms
5518 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5519 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5520 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5521 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5522 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5523 cosphi1=dcos(j*phii)
5524 sinphi1=dsin(j*phii)
5525 cosphi2=dcos(j*phii1)
5526 sinphi2=dsin(j*phii1)
5527 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5528 & v2cij*cosphi2+v2sij*sinphi2
5529 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5530 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5532 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5534 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5535 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5536 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5537 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5538 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5539 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5540 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5541 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5542 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5543 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5544 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5545 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5546 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5547 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5550 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5551 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5557 c------------------------------------------------------------------------------
5558 subroutine eback_sc_corr(esccor)
5559 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5560 c conformational states; temporarily implemented as differences
5561 c between UNRES torsional potentials (dependent on three types of
5562 c residues) and the torsional potentials dependent on all 20 types
5563 c of residues computed from AM1 energy surfaces of terminally-blocked
5564 c amino-acid residues.
5565 implicit real*8 (a-h,o-z)
5566 include 'DIMENSIONS'
5567 include 'sizesclu.dat'
5568 include 'COMMON.VAR'
5569 include 'COMMON.GEO'
5570 include 'COMMON.LOCAL'
5571 include 'COMMON.TORSION'
5572 include 'COMMON.SCCOR'
5573 include 'COMMON.INTERACT'
5574 include 'COMMON.DERIV'
5575 include 'COMMON.CHAIN'
5576 include 'COMMON.NAMES'
5577 include 'COMMON.IOUNITS'
5578 include 'COMMON.FFIELD'
5579 include 'COMMON.CONTROL'
5581 C Set lprn=.true. for debugging
5584 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5586 do i=itau_start,itau_end
5587 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5589 isccori=isccortyp(itype(i-2))
5590 isccori1=isccortyp(itype(i-1))
5592 do intertyp=1,3 !intertyp
5593 cc Added 09 May 2012 (Adasko)
5594 cc Intertyp means interaction type of backbone mainchain correlation:
5595 c 1 = SC...Ca...Ca...Ca
5596 c 2 = Ca...Ca...Ca...SC
5597 c 3 = SC...Ca...Ca...SCi
5599 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5600 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5601 & (itype(i-1).eq.ntyp1)))
5602 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5603 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5604 & .or.(itype(i).eq.ntyp1)))
5605 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5606 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5607 & (itype(i-3).eq.ntyp1)))) cycle
5608 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5609 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5611 do j=1,nterm_sccor(isccori,isccori1)
5612 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5613 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5614 cosphi=dcos(j*tauangle(intertyp,i))
5615 sinphi=dsin(j*tauangle(intertyp,i))
5616 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5617 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5619 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5620 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
5622 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5623 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5624 & (v1sccor(j,1,itori,itori1),j=1,6),
5625 & (v2sccor(j,1,itori,itori1),j=1,6)
5626 gsccor_loc(i-3)=gloci
5631 c------------------------------------------------------------------------------
5632 subroutine multibody(ecorr)
5633 C This subroutine calculates multi-body contributions to energy following
5634 C the idea of Skolnick et al. If side chains I and J make a contact and
5635 C at the same time side chains I+1 and J+1 make a contact, an extra
5636 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5637 implicit real*8 (a-h,o-z)
5638 include 'DIMENSIONS'
5639 include 'COMMON.IOUNITS'
5640 include 'COMMON.DERIV'
5641 include 'COMMON.INTERACT'
5642 include 'COMMON.CONTACTS'
5643 double precision gx(3),gx1(3)
5646 C Set lprn=.true. for debugging
5650 write (iout,'(a)') 'Contact function values:'
5652 write (iout,'(i2,20(1x,i2,f10.5))')
5653 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5668 num_conti=num_cont(i)
5669 num_conti1=num_cont(i1)
5674 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5675 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5676 cd & ' ishift=',ishift
5677 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5678 C The system gains extra energy.
5679 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5680 endif ! j1==j+-ishift
5689 c------------------------------------------------------------------------------
5690 double precision function esccorr(i,j,k,l,jj,kk)
5691 implicit real*8 (a-h,o-z)
5692 include 'DIMENSIONS'
5693 include 'COMMON.IOUNITS'
5694 include 'COMMON.DERIV'
5695 include 'COMMON.INTERACT'
5696 include 'COMMON.CONTACTS'
5697 double precision gx(3),gx1(3)
5702 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5703 C Calculate the multi-body contribution to energy.
5704 C Calculate multi-body contributions to the gradient.
5705 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5706 cd & k,l,(gacont(m,kk,k),m=1,3)
5708 gx(m) =ekl*gacont(m,jj,i)
5709 gx1(m)=eij*gacont(m,kk,k)
5710 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5711 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5712 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5713 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5717 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5722 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5728 c------------------------------------------------------------------------------
5730 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5731 implicit real*8 (a-h,o-z)
5732 include 'DIMENSIONS'
5733 integer dimen1,dimen2,atom,indx
5734 double precision buffer(dimen1,dimen2)
5735 double precision zapas
5736 common /contacts_hb/ zapas(3,20,maxres,7),
5737 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5738 & num_cont_hb(maxres),jcont_hb(20,maxres)
5739 num_kont=num_cont_hb(atom)
5743 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5746 buffer(i,indx+22)=facont_hb(i,atom)
5747 buffer(i,indx+23)=ees0p(i,atom)
5748 buffer(i,indx+24)=ees0m(i,atom)
5749 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5751 buffer(1,indx+26)=dfloat(num_kont)
5754 c------------------------------------------------------------------------------
5755 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5756 implicit real*8 (a-h,o-z)
5757 include 'DIMENSIONS'
5758 integer dimen1,dimen2,atom,indx
5759 double precision buffer(dimen1,dimen2)
5760 double precision zapas
5761 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5762 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5763 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5764 num_kont=buffer(1,indx+26)
5765 num_kont_old=num_cont_hb(atom)
5766 num_cont_hb(atom)=num_kont+num_kont_old
5771 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5774 facont_hb(ii,atom)=buffer(i,indx+22)
5775 ees0p(ii,atom)=buffer(i,indx+23)
5776 ees0m(ii,atom)=buffer(i,indx+24)
5777 jcont_hb(ii,atom)=buffer(i,indx+25)
5781 c------------------------------------------------------------------------------
5783 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5784 C This subroutine calculates multi-body contributions to hydrogen-bonding
5785 implicit real*8 (a-h,o-z)
5786 include 'DIMENSIONS'
5787 include 'sizesclu.dat'
5788 include 'COMMON.IOUNITS'
5790 include 'COMMON.INFO'
5792 include 'COMMON.FFIELD'
5793 include 'COMMON.DERIV'
5794 include 'COMMON.INTERACT'
5795 include 'COMMON.CONTACTS'
5797 parameter (max_cont=maxconts)
5798 parameter (max_dim=2*(8*3+2))
5799 parameter (msglen1=max_cont*max_dim*4)
5800 parameter (msglen2=2*msglen1)
5801 integer source,CorrelType,CorrelID,Error
5802 double precision buffer(max_cont,max_dim)
5804 double precision gx(3),gx1(3)
5807 C Set lprn=.true. for debugging
5812 if (fgProcs.le.1) goto 30
5814 write (iout,'(a)') 'Contact function values:'
5816 write (iout,'(2i3,50(1x,i2,f5.2))')
5817 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5818 & j=1,num_cont_hb(i))
5821 C Caution! Following code assumes that electrostatic interactions concerning
5822 C a given atom are split among at most two processors!
5832 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5835 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5836 if (MyRank.gt.0) then
5837 C Send correlation contributions to the preceding processor
5839 nn=num_cont_hb(iatel_s)
5840 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5841 cd write (iout,*) 'The BUFFER array:'
5843 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5845 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5847 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5848 C Clear the contacts of the atom passed to the neighboring processor
5849 nn=num_cont_hb(iatel_s+1)
5851 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5853 num_cont_hb(iatel_s)=0
5855 cd write (iout,*) 'Processor ',MyID,MyRank,
5856 cd & ' is sending correlation contribution to processor',MyID-1,
5857 cd & ' msglen=',msglen
5858 cd write (*,*) 'Processor ',MyID,MyRank,
5859 cd & ' is sending correlation contribution to processor',MyID-1,
5860 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5861 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5862 cd write (iout,*) 'Processor ',MyID,
5863 cd & ' has sent correlation contribution to processor',MyID-1,
5864 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5865 cd write (*,*) 'Processor ',MyID,
5866 cd & ' has sent correlation contribution to processor',MyID-1,
5867 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5869 endif ! (MyRank.gt.0)
5873 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5874 if (MyRank.lt.fgProcs-1) then
5875 C Receive correlation contributions from the next processor
5877 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5878 cd write (iout,*) 'Processor',MyID,
5879 cd & ' is receiving correlation contribution from processor',MyID+1,
5880 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5881 cd write (*,*) 'Processor',MyID,
5882 cd & ' is receiving correlation contribution from processor',MyID+1,
5883 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5885 do while (nbytes.le.0)
5886 call mp_probe(MyID+1,CorrelType,nbytes)
5888 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5889 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5890 cd write (iout,*) 'Processor',MyID,
5891 cd & ' has received correlation contribution from processor',MyID+1,
5892 cd & ' msglen=',msglen,' nbytes=',nbytes
5893 cd write (iout,*) 'The received BUFFER array:'
5895 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5897 if (msglen.eq.msglen1) then
5898 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5899 else if (msglen.eq.msglen2) then
5900 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5901 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5904 & 'ERROR!!!! message length changed while processing correlations.'
5906 & 'ERROR!!!! message length changed while processing correlations.'
5907 call mp_stopall(Error)
5908 endif ! msglen.eq.msglen1
5909 endif ! MyRank.lt.fgProcs-1
5916 write (iout,'(a)') 'Contact function values:'
5918 write (iout,'(2i3,50(1x,i2,f5.2))')
5919 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5920 & j=1,num_cont_hb(i))
5924 C Remove the loop below after debugging !!!
5931 C Calculate the local-electrostatic correlation terms
5932 do i=iatel_s,iatel_e+1
5934 num_conti=num_cont_hb(i)
5935 num_conti1=num_cont_hb(i+1)
5940 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5941 c & ' jj=',jj,' kk=',kk
5942 if (j1.eq.j+1 .or. j1.eq.j-1) then
5943 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5944 C The system gains extra energy.
5945 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5947 else if (j1.eq.j) then
5948 C Contacts I-J and I-(J+1) occur simultaneously.
5949 C The system loses extra energy.
5950 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5955 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5956 c & ' jj=',jj,' kk=',kk
5958 C Contacts I-J and (I+1)-J occur simultaneously.
5959 C The system loses extra energy.
5960 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5967 c------------------------------------------------------------------------------
5968 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5970 C This subroutine calculates multi-body contributions to hydrogen-bonding
5971 implicit real*8 (a-h,o-z)
5972 include 'DIMENSIONS'
5973 include 'sizesclu.dat'
5974 include 'COMMON.IOUNITS'
5976 include 'COMMON.INFO'
5978 include 'COMMON.FFIELD'
5979 include 'COMMON.DERIV'
5980 include 'COMMON.INTERACT'
5981 include 'COMMON.CONTACTS'
5983 parameter (max_cont=maxconts)
5984 parameter (max_dim=2*(8*3+2))
5985 parameter (msglen1=max_cont*max_dim*4)
5986 parameter (msglen2=2*msglen1)
5987 integer source,CorrelType,CorrelID,Error
5988 double precision buffer(max_cont,max_dim)
5990 double precision gx(3),gx1(3)
5993 C Set lprn=.true. for debugging
5999 if (fgProcs.le.1) goto 30
6001 write (iout,'(a)') 'Contact function values:'
6003 write (iout,'(2i3,50(1x,i2,f5.2))')
6004 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6005 & j=1,num_cont_hb(i))
6008 C Caution! Following code assumes that electrostatic interactions concerning
6009 C a given atom are split among at most two processors!
6019 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6022 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6023 if (MyRank.gt.0) then
6024 C Send correlation contributions to the preceding processor
6026 nn=num_cont_hb(iatel_s)
6027 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6028 cd write (iout,*) 'The BUFFER array:'
6030 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6032 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6034 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6035 C Clear the contacts of the atom passed to the neighboring processor
6036 nn=num_cont_hb(iatel_s+1)
6038 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6040 num_cont_hb(iatel_s)=0
6042 cd write (iout,*) 'Processor ',MyID,MyRank,
6043 cd & ' is sending correlation contribution to processor',MyID-1,
6044 cd & ' msglen=',msglen
6045 cd write (*,*) 'Processor ',MyID,MyRank,
6046 cd & ' is sending correlation contribution to processor',MyID-1,
6047 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6048 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6049 cd write (iout,*) 'Processor ',MyID,
6050 cd & ' has sent correlation contribution to processor',MyID-1,
6051 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6052 cd write (*,*) 'Processor ',MyID,
6053 cd & ' has sent correlation contribution to processor',MyID-1,
6054 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6056 endif ! (MyRank.gt.0)
6060 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6061 if (MyRank.lt.fgProcs-1) then
6062 C Receive correlation contributions from the next processor
6064 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6065 cd write (iout,*) 'Processor',MyID,
6066 cd & ' is receiving correlation contribution from processor',MyID+1,
6067 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6068 cd write (*,*) 'Processor',MyID,
6069 cd & ' is receiving correlation contribution from processor',MyID+1,
6070 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6072 do while (nbytes.le.0)
6073 call mp_probe(MyID+1,CorrelType,nbytes)
6075 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6076 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6077 cd write (iout,*) 'Processor',MyID,
6078 cd & ' has received correlation contribution from processor',MyID+1,
6079 cd & ' msglen=',msglen,' nbytes=',nbytes
6080 cd write (iout,*) 'The received BUFFER array:'
6082 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6084 if (msglen.eq.msglen1) then
6085 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6086 else if (msglen.eq.msglen2) then
6087 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6088 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6091 & 'ERROR!!!! message length changed while processing correlations.'
6093 & 'ERROR!!!! message length changed while processing correlations.'
6094 call mp_stopall(Error)
6095 endif ! msglen.eq.msglen1
6096 endif ! MyRank.lt.fgProcs-1
6103 write (iout,'(a)') 'Contact function values:'
6105 write (iout,'(2i3,50(1x,i2,f5.2))')
6106 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6107 & j=1,num_cont_hb(i))
6113 C Remove the loop below after debugging !!!
6120 C Calculate the dipole-dipole interaction energies
6121 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6122 do i=iatel_s,iatel_e+1
6123 num_conti=num_cont_hb(i)
6130 C Calculate the local-electrostatic correlation terms
6131 do i=iatel_s,iatel_e+1
6133 num_conti=num_cont_hb(i)
6134 num_conti1=num_cont_hb(i+1)
6139 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6140 c & ' jj=',jj,' kk=',kk
6141 if (j1.eq.j+1 .or. j1.eq.j-1) then
6142 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6143 C The system gains extra energy.
6145 sqd1=dsqrt(d_cont(jj,i))
6146 sqd2=dsqrt(d_cont(kk,i1))
6147 sred_geom = sqd1*sqd2
6148 IF (sred_geom.lt.cutoff_corr) THEN
6149 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6151 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6152 c & ' jj=',jj,' kk=',kk
6153 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6154 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6156 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6157 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6160 cd write (iout,*) 'sred_geom=',sred_geom,
6161 cd & ' ekont=',ekont,' fprim=',fprimcont
6162 call calc_eello(i,j,i+1,j1,jj,kk)
6163 if (wcorr4.gt.0.0d0)
6164 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6165 if (wcorr5.gt.0.0d0)
6166 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6167 c print *,"wcorr5",ecorr5
6168 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6169 cd write(2,*)'ijkl',i,j,i+1,j1
6170 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6171 & .or. wturn6.eq.0.0d0))then
6172 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6173 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6174 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6175 cd & 'ecorr6=',ecorr6
6176 cd write (iout,'(4e15.5)') sred_geom,
6177 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6178 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6179 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6180 else if (wturn6.gt.0.0d0
6181 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6182 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6183 eturn6=eturn6+eello_turn6(i,jj,kk)
6184 cd write (2,*) 'multibody_eello:eturn6',eturn6
6188 else if (j1.eq.j) then
6189 C Contacts I-J and I-(J+1) occur simultaneously.
6190 C The system loses extra energy.
6191 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6196 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6197 c & ' jj=',jj,' kk=',kk
6199 C Contacts I-J and (I+1)-J occur simultaneously.
6200 C The system loses extra energy.
6201 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6208 c------------------------------------------------------------------------------
6209 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6210 implicit real*8 (a-h,o-z)
6211 include 'DIMENSIONS'
6212 include 'COMMON.IOUNITS'
6213 include 'COMMON.DERIV'
6214 include 'COMMON.INTERACT'
6215 include 'COMMON.CONTACTS'
6216 include 'COMMON.SHIELD'
6218 double precision gx(3),gx1(3)
6228 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6229 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6230 C Following 4 lines for diagnostics.
6235 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6237 c write (iout,*)'Contacts have occurred for peptide groups',
6238 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6239 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6240 C Calculate the multi-body contribution to energy.
6241 ecorr=ecorr+ekont*ees
6243 C Calculate multi-body contributions to the gradient.
6245 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6246 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6247 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6248 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6249 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6250 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6251 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6252 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6253 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6254 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6255 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6256 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6257 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6258 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6262 gradcorr(ll,m)=gradcorr(ll,m)+
6263 & ees*ekl*gacont_hbr(ll,jj,i)-
6264 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6265 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6270 gradcorr(ll,m)=gradcorr(ll,m)+
6271 & ees*eij*gacont_hbr(ll,kk,k)-
6272 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6273 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6276 if (shield_mode.gt.0) then
6279 C print *,i,j,fac_shield(i),fac_shield(j),
6280 C &fac_shield(k),fac_shield(l)
6281 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6282 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6283 do ilist=1,ishield_list(i)
6284 iresshield=shield_list(ilist,i)
6286 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6288 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6290 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6291 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6295 do ilist=1,ishield_list(j)
6296 iresshield=shield_list(ilist,j)
6298 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6300 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6302 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6303 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6307 do ilist=1,ishield_list(k)
6308 iresshield=shield_list(ilist,k)
6310 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6312 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6314 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6315 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6319 do ilist=1,ishield_list(l)
6320 iresshield=shield_list(ilist,l)
6322 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6324 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6326 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6327 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6331 C print *,gshieldx(m,iresshield)
6333 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6334 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6335 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6336 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6337 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6338 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6339 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6340 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6342 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6343 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6344 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6345 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6346 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6347 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6348 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6349 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6358 C---------------------------------------------------------------------------
6359 subroutine dipole(i,j,jj)
6360 implicit real*8 (a-h,o-z)
6361 include 'DIMENSIONS'
6362 include 'sizesclu.dat'
6363 include 'COMMON.IOUNITS'
6364 include 'COMMON.CHAIN'
6365 include 'COMMON.FFIELD'
6366 include 'COMMON.DERIV'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.CONTACTS'
6369 include 'COMMON.TORSION'
6370 include 'COMMON.VAR'
6371 include 'COMMON.GEO'
6372 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6374 iti1 = itortyp(itype(i+1))
6375 if (j.lt.nres-1) then
6376 if (itype(j).le.ntyp) then
6377 itj1 = itortyp(itype(j+1))
6385 dipi(iii,1)=Ub2(iii,i)
6386 dipderi(iii)=Ub2der(iii,i)
6387 dipi(iii,2)=b1(iii,iti1)
6388 dipj(iii,1)=Ub2(iii,j)
6389 dipderj(iii)=Ub2der(iii,j)
6390 dipj(iii,2)=b1(iii,itj1)
6394 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6397 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6400 if (.not.calc_grad) return
6405 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6409 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6414 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6415 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6417 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6419 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6421 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6425 C---------------------------------------------------------------------------
6426 subroutine calc_eello(i,j,k,l,jj,kk)
6428 C This subroutine computes matrices and vectors needed to calculate
6429 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6431 implicit real*8 (a-h,o-z)
6432 include 'DIMENSIONS'
6433 include 'sizesclu.dat'
6434 include 'COMMON.IOUNITS'
6435 include 'COMMON.CHAIN'
6436 include 'COMMON.DERIV'
6437 include 'COMMON.INTERACT'
6438 include 'COMMON.CONTACTS'
6439 include 'COMMON.TORSION'
6440 include 'COMMON.VAR'
6441 include 'COMMON.GEO'
6442 include 'COMMON.FFIELD'
6443 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6444 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6447 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6448 cd & ' jj=',jj,' kk=',kk
6449 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6452 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6453 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6456 call transpose2(aa1(1,1),aa1t(1,1))
6457 call transpose2(aa2(1,1),aa2t(1,1))
6460 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6461 & aa1tder(1,1,lll,kkk))
6462 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6463 & aa2tder(1,1,lll,kkk))
6467 C parallel orientation of the two CA-CA-CA frames.
6469 if (i.gt.1 .and. itype(i).le.ntyp) then
6470 iti=itortyp(itype(i))
6474 itk1=itortyp(itype(k+1))
6475 itj=itortyp(itype(j))
6476 c if (l.lt.nres-1) then
6477 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6478 itl1=itortyp(itype(l+1))
6482 C A1 kernel(j+1) A2T
6484 cd write (iout,'(3f10.5,5x,3f10.5)')
6485 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6487 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6488 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6489 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6490 C Following matrices are needed only for 6-th order cumulants
6491 IF (wcorr6.gt.0.0d0) THEN
6492 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6493 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6494 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6495 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6496 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6497 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6498 & ADtEAderx(1,1,1,1,1,1))
6500 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6501 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6502 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6503 & ADtEA1derx(1,1,1,1,1,1))
6505 C End 6-th order cumulants
6508 cd write (2,*) 'In calc_eello6'
6510 cd write (2,*) 'iii=',iii
6512 cd write (2,*) 'kkk=',kkk
6514 cd write (2,'(3(2f10.5),5x)')
6515 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6520 call transpose2(EUgder(1,1,k),auxmat(1,1))
6521 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6522 call transpose2(EUg(1,1,k),auxmat(1,1))
6523 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6524 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6528 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6529 & EAEAderx(1,1,lll,kkk,iii,1))
6533 C A1T kernel(i+1) A2
6534 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6535 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6536 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6537 C Following matrices are needed only for 6-th order cumulants
6538 IF (wcorr6.gt.0.0d0) THEN
6539 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6540 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6541 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6542 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6543 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6544 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6545 & ADtEAderx(1,1,1,1,1,2))
6546 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6547 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6548 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6549 & ADtEA1derx(1,1,1,1,1,2))
6551 C End 6-th order cumulants
6552 call transpose2(EUgder(1,1,l),auxmat(1,1))
6553 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6554 call transpose2(EUg(1,1,l),auxmat(1,1))
6555 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6556 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6560 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6561 & EAEAderx(1,1,lll,kkk,iii,2))
6566 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6567 C They are needed only when the fifth- or the sixth-order cumulants are
6569 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6570 call transpose2(AEA(1,1,1),auxmat(1,1))
6571 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6572 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6573 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6574 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6575 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6576 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6577 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6578 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6579 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6580 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6581 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6582 call transpose2(AEA(1,1,2),auxmat(1,1))
6583 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6584 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6585 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6586 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6587 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6588 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6589 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6590 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6591 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6592 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6593 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6594 C Calculate the Cartesian derivatives of the vectors.
6598 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6599 call matvec2(auxmat(1,1),b1(1,iti),
6600 & AEAb1derx(1,lll,kkk,iii,1,1))
6601 call matvec2(auxmat(1,1),Ub2(1,i),
6602 & AEAb2derx(1,lll,kkk,iii,1,1))
6603 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6604 & AEAb1derx(1,lll,kkk,iii,2,1))
6605 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6606 & AEAb2derx(1,lll,kkk,iii,2,1))
6607 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6608 call matvec2(auxmat(1,1),b1(1,itj),
6609 & AEAb1derx(1,lll,kkk,iii,1,2))
6610 call matvec2(auxmat(1,1),Ub2(1,j),
6611 & AEAb2derx(1,lll,kkk,iii,1,2))
6612 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6613 & AEAb1derx(1,lll,kkk,iii,2,2))
6614 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6615 & AEAb2derx(1,lll,kkk,iii,2,2))
6622 C Antiparallel orientation of the two CA-CA-CA frames.
6624 if (i.gt.1 .and. itype(i).le.ntyp) then
6625 iti=itortyp(itype(i))
6629 itk1=itortyp(itype(k+1))
6630 itl=itortyp(itype(l))
6631 itj=itortyp(itype(j))
6632 c if (j.lt.nres-1) then
6633 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6634 itj1=itortyp(itype(j+1))
6638 C A2 kernel(j-1)T A1T
6639 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6640 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6641 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6642 C Following matrices are needed only for 6-th order cumulants
6643 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6644 & j.eq.i+4 .and. l.eq.i+3)) THEN
6645 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6646 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6647 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6648 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6649 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6650 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6651 & ADtEAderx(1,1,1,1,1,1))
6652 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6653 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6654 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6655 & ADtEA1derx(1,1,1,1,1,1))
6657 C End 6-th order cumulants
6658 call transpose2(EUgder(1,1,k),auxmat(1,1))
6659 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6660 call transpose2(EUg(1,1,k),auxmat(1,1))
6661 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6662 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6666 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6667 & EAEAderx(1,1,lll,kkk,iii,1))
6671 C A2T kernel(i+1)T A1
6672 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6673 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6674 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6675 C Following matrices are needed only for 6-th order cumulants
6676 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6677 & j.eq.i+4 .and. l.eq.i+3)) THEN
6678 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6679 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6680 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6681 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6682 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6683 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6684 & ADtEAderx(1,1,1,1,1,2))
6685 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6686 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6687 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6688 & ADtEA1derx(1,1,1,1,1,2))
6690 C End 6-th order cumulants
6691 call transpose2(EUgder(1,1,j),auxmat(1,1))
6692 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6693 call transpose2(EUg(1,1,j),auxmat(1,1))
6694 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6695 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6699 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6700 & EAEAderx(1,1,lll,kkk,iii,2))
6705 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6706 C They are needed only when the fifth- or the sixth-order cumulants are
6708 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6709 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6710 call transpose2(AEA(1,1,1),auxmat(1,1))
6711 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6712 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6713 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6714 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6715 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6716 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6717 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6718 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6719 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6720 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6721 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6722 call transpose2(AEA(1,1,2),auxmat(1,1))
6723 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6724 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6725 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6726 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6727 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6728 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6729 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6730 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6731 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6732 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6733 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6734 C Calculate the Cartesian derivatives of the vectors.
6738 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6739 call matvec2(auxmat(1,1),b1(1,iti),
6740 & AEAb1derx(1,lll,kkk,iii,1,1))
6741 call matvec2(auxmat(1,1),Ub2(1,i),
6742 & AEAb2derx(1,lll,kkk,iii,1,1))
6743 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6744 & AEAb1derx(1,lll,kkk,iii,2,1))
6745 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6746 & AEAb2derx(1,lll,kkk,iii,2,1))
6747 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6748 call matvec2(auxmat(1,1),b1(1,itl),
6749 & AEAb1derx(1,lll,kkk,iii,1,2))
6750 call matvec2(auxmat(1,1),Ub2(1,l),
6751 & AEAb2derx(1,lll,kkk,iii,1,2))
6752 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6753 & AEAb1derx(1,lll,kkk,iii,2,2))
6754 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6755 & AEAb2derx(1,lll,kkk,iii,2,2))
6764 C---------------------------------------------------------------------------
6765 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6766 & KK,KKderg,AKA,AKAderg,AKAderx)
6770 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6771 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6772 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6777 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6779 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6782 cd if (lprn) write (2,*) 'In kernel'
6784 cd if (lprn) write (2,*) 'kkk=',kkk
6786 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6787 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6789 cd write (2,*) 'lll=',lll
6790 cd write (2,*) 'iii=1'
6792 cd write (2,'(3(2f10.5),5x)')
6793 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6796 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6797 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6799 cd write (2,*) 'lll=',lll
6800 cd write (2,*) 'iii=2'
6802 cd write (2,'(3(2f10.5),5x)')
6803 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6810 C---------------------------------------------------------------------------
6811 double precision function eello4(i,j,k,l,jj,kk)
6812 implicit real*8 (a-h,o-z)
6813 include 'DIMENSIONS'
6814 include 'sizesclu.dat'
6815 include 'COMMON.IOUNITS'
6816 include 'COMMON.CHAIN'
6817 include 'COMMON.DERIV'
6818 include 'COMMON.INTERACT'
6819 include 'COMMON.CONTACTS'
6820 include 'COMMON.TORSION'
6821 include 'COMMON.VAR'
6822 include 'COMMON.GEO'
6823 double precision pizda(2,2),ggg1(3),ggg2(3)
6824 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6828 cd print *,'eello4:',i,j,k,l,jj,kk
6829 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6830 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6831 cold eij=facont_hb(jj,i)
6832 cold ekl=facont_hb(kk,k)
6834 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6836 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6837 gcorr_loc(k-1)=gcorr_loc(k-1)
6838 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6840 gcorr_loc(l-1)=gcorr_loc(l-1)
6841 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6843 gcorr_loc(j-1)=gcorr_loc(j-1)
6844 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6849 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6850 & -EAEAderx(2,2,lll,kkk,iii,1)
6851 cd derx(lll,kkk,iii)=0.0d0
6855 cd gcorr_loc(l-1)=0.0d0
6856 cd gcorr_loc(j-1)=0.0d0
6857 cd gcorr_loc(k-1)=0.0d0
6859 cd write (iout,*)'Contacts have occurred for peptide groups',
6860 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6861 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6862 if (j.lt.nres-1) then
6869 if (l.lt.nres-1) then
6877 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6878 ggg1(ll)=eel4*g_contij(ll,1)
6879 ggg2(ll)=eel4*g_contij(ll,2)
6880 ghalf=0.5d0*ggg1(ll)
6882 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6883 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6884 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6885 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6886 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6887 ghalf=0.5d0*ggg2(ll)
6889 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6890 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6891 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6892 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6897 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6898 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6903 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6904 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6910 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6915 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6919 cd write (2,*) iii,gcorr_loc(iii)
6923 cd write (2,*) 'ekont',ekont
6924 cd write (iout,*) 'eello4',ekont*eel4
6927 C---------------------------------------------------------------------------
6928 double precision function eello5(i,j,k,l,jj,kk)
6929 implicit real*8 (a-h,o-z)
6930 include 'DIMENSIONS'
6931 include 'sizesclu.dat'
6932 include 'COMMON.IOUNITS'
6933 include 'COMMON.CHAIN'
6934 include 'COMMON.DERIV'
6935 include 'COMMON.INTERACT'
6936 include 'COMMON.CONTACTS'
6937 include 'COMMON.TORSION'
6938 include 'COMMON.VAR'
6939 include 'COMMON.GEO'
6940 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6941 double precision ggg1(3),ggg2(3)
6942 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6947 C /l\ / \ \ / \ / \ / C
6948 C / \ / \ \ / \ / \ / C
6949 C j| o |l1 | o | o| o | | o |o C
6950 C \ |/k\| |/ \| / |/ \| |/ \| C
6951 C \i/ \ / \ / / \ / \ C
6953 C (I) (II) (III) (IV) C
6955 C eello5_1 eello5_2 eello5_3 eello5_4 C
6957 C Antiparallel chains C
6960 C /j\ / \ \ / \ / \ / C
6961 C / \ / \ \ / \ / \ / C
6962 C j1| o |l | o | o| o | | o |o C
6963 C \ |/k\| |/ \| / |/ \| |/ \| C
6964 C \i/ \ / \ / / \ / \ C
6966 C (I) (II) (III) (IV) C
6968 C eello5_1 eello5_2 eello5_3 eello5_4 C
6970 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6972 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6973 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6978 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6980 itk=itortyp(itype(k))
6981 itl=itortyp(itype(l))
6982 itj=itortyp(itype(j))
6987 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6988 cd & eel5_3_num,eel5_4_num)
6992 derx(lll,kkk,iii)=0.0d0
6996 cd eij=facont_hb(jj,i)
6997 cd ekl=facont_hb(kk,k)
6999 cd write (iout,*)'Contacts have occurred for peptide groups',
7000 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7002 C Contribution from the graph I.
7003 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7004 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7005 call transpose2(EUg(1,1,k),auxmat(1,1))
7006 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7007 vv(1)=pizda(1,1)-pizda(2,2)
7008 vv(2)=pizda(1,2)+pizda(2,1)
7009 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7010 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7012 C Explicit gradient in virtual-dihedral angles.
7013 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7014 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7015 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7016 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7017 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7018 vv(1)=pizda(1,1)-pizda(2,2)
7019 vv(2)=pizda(1,2)+pizda(2,1)
7020 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7021 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7022 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7023 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7024 vv(1)=pizda(1,1)-pizda(2,2)
7025 vv(2)=pizda(1,2)+pizda(2,1)
7027 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7028 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7029 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7031 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7032 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7033 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7035 C Cartesian gradient
7039 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7041 vv(1)=pizda(1,1)-pizda(2,2)
7042 vv(2)=pizda(1,2)+pizda(2,1)
7043 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7044 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7045 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7052 C Contribution from graph II
7053 call transpose2(EE(1,1,itk),auxmat(1,1))
7054 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7055 vv(1)=pizda(1,1)+pizda(2,2)
7056 vv(2)=pizda(2,1)-pizda(1,2)
7057 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7058 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7060 C Explicit gradient in virtual-dihedral angles.
7061 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7062 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7063 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7064 vv(1)=pizda(1,1)+pizda(2,2)
7065 vv(2)=pizda(2,1)-pizda(1,2)
7067 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7068 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7069 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7071 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7072 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7073 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7075 C Cartesian gradient
7079 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7081 vv(1)=pizda(1,1)+pizda(2,2)
7082 vv(2)=pizda(2,1)-pizda(1,2)
7083 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7084 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7085 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7094 C Parallel orientation
7095 C Contribution from graph III
7096 call transpose2(EUg(1,1,l),auxmat(1,1))
7097 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7098 vv(1)=pizda(1,1)-pizda(2,2)
7099 vv(2)=pizda(1,2)+pizda(2,1)
7100 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7101 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7103 C Explicit gradient in virtual-dihedral angles.
7104 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7105 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7106 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7107 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7108 vv(1)=pizda(1,1)-pizda(2,2)
7109 vv(2)=pizda(1,2)+pizda(2,1)
7110 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7111 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7112 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7113 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7114 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7115 vv(1)=pizda(1,1)-pizda(2,2)
7116 vv(2)=pizda(1,2)+pizda(2,1)
7117 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7118 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7119 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7120 C Cartesian gradient
7124 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7126 vv(1)=pizda(1,1)-pizda(2,2)
7127 vv(2)=pizda(1,2)+pizda(2,1)
7128 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7129 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7130 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7136 C Contribution from graph IV
7138 call transpose2(EE(1,1,itl),auxmat(1,1))
7139 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7140 vv(1)=pizda(1,1)+pizda(2,2)
7141 vv(2)=pizda(2,1)-pizda(1,2)
7142 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7143 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7145 C Explicit gradient in virtual-dihedral angles.
7146 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7147 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7148 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7149 vv(1)=pizda(1,1)+pizda(2,2)
7150 vv(2)=pizda(2,1)-pizda(1,2)
7151 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7152 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7153 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7154 C Cartesian gradient
7158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7160 vv(1)=pizda(1,1)+pizda(2,2)
7161 vv(2)=pizda(2,1)-pizda(1,2)
7162 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7163 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7164 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7170 C Antiparallel orientation
7171 C Contribution from graph III
7173 call transpose2(EUg(1,1,j),auxmat(1,1))
7174 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7175 vv(1)=pizda(1,1)-pizda(2,2)
7176 vv(2)=pizda(1,2)+pizda(2,1)
7177 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7178 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7180 C Explicit gradient in virtual-dihedral angles.
7181 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7182 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7183 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7184 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7185 vv(1)=pizda(1,1)-pizda(2,2)
7186 vv(2)=pizda(1,2)+pizda(2,1)
7187 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7188 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7189 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7190 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7191 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7192 vv(1)=pizda(1,1)-pizda(2,2)
7193 vv(2)=pizda(1,2)+pizda(2,1)
7194 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7195 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7196 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7197 C Cartesian gradient
7201 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7203 vv(1)=pizda(1,1)-pizda(2,2)
7204 vv(2)=pizda(1,2)+pizda(2,1)
7205 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7206 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7207 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7213 C Contribution from graph IV
7215 call transpose2(EE(1,1,itj),auxmat(1,1))
7216 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7217 vv(1)=pizda(1,1)+pizda(2,2)
7218 vv(2)=pizda(2,1)-pizda(1,2)
7219 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7220 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7222 C Explicit gradient in virtual-dihedral angles.
7223 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7224 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7225 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7226 vv(1)=pizda(1,1)+pizda(2,2)
7227 vv(2)=pizda(2,1)-pizda(1,2)
7228 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7229 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7230 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7231 C Cartesian gradient
7235 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7237 vv(1)=pizda(1,1)+pizda(2,2)
7238 vv(2)=pizda(2,1)-pizda(1,2)
7239 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7240 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7241 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7248 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7249 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7250 cd write (2,*) 'ijkl',i,j,k,l
7251 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7252 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7254 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7255 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7256 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7257 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7259 if (j.lt.nres-1) then
7266 if (l.lt.nres-1) then
7276 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7278 ggg1(ll)=eel5*g_contij(ll,1)
7279 ggg2(ll)=eel5*g_contij(ll,2)
7280 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7281 ghalf=0.5d0*ggg1(ll)
7283 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7284 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7285 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7286 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7287 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7288 ghalf=0.5d0*ggg2(ll)
7290 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7291 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7292 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7293 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7298 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7299 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7304 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7305 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7311 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7316 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7320 cd write (2,*) iii,g_corr5_loc(iii)
7324 cd write (2,*) 'ekont',ekont
7325 cd write (iout,*) 'eello5',ekont*eel5
7328 c--------------------------------------------------------------------------
7329 double precision function eello6(i,j,k,l,jj,kk)
7330 implicit real*8 (a-h,o-z)
7331 include 'DIMENSIONS'
7332 include 'sizesclu.dat'
7333 include 'COMMON.IOUNITS'
7334 include 'COMMON.CHAIN'
7335 include 'COMMON.DERIV'
7336 include 'COMMON.INTERACT'
7337 include 'COMMON.CONTACTS'
7338 include 'COMMON.TORSION'
7339 include 'COMMON.VAR'
7340 include 'COMMON.GEO'
7341 include 'COMMON.FFIELD'
7342 double precision ggg1(3),ggg2(3)
7343 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7348 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7356 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7357 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7361 derx(lll,kkk,iii)=0.0d0
7365 cd eij=facont_hb(jj,i)
7366 cd ekl=facont_hb(kk,k)
7372 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7373 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7374 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7375 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7376 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7377 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7379 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7380 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7381 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7382 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7383 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7384 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7388 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7390 C If turn contributions are considered, they will be handled separately.
7391 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7392 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7393 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7394 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7395 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7396 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7397 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7400 if (j.lt.nres-1) then
7407 if (l.lt.nres-1) then
7415 ggg1(ll)=eel6*g_contij(ll,1)
7416 ggg2(ll)=eel6*g_contij(ll,2)
7417 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7418 ghalf=0.5d0*ggg1(ll)
7420 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7421 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7422 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7423 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7424 ghalf=0.5d0*ggg2(ll)
7425 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7427 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7428 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7429 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7430 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7435 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7436 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7441 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7442 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7448 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7453 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7457 cd write (2,*) iii,g_corr6_loc(iii)
7461 cd write (2,*) 'ekont',ekont
7462 cd write (iout,*) 'eello6',ekont*eel6
7465 c--------------------------------------------------------------------------
7466 double precision function eello6_graph1(i,j,k,l,imat,swap)
7467 implicit real*8 (a-h,o-z)
7468 include 'DIMENSIONS'
7469 include 'sizesclu.dat'
7470 include 'COMMON.IOUNITS'
7471 include 'COMMON.CHAIN'
7472 include 'COMMON.DERIV'
7473 include 'COMMON.INTERACT'
7474 include 'COMMON.CONTACTS'
7475 include 'COMMON.TORSION'
7476 include 'COMMON.VAR'
7477 include 'COMMON.GEO'
7478 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7482 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7484 C Parallel Antiparallel C
7490 C \ j|/k\| / \ |/k\|l / C
7495 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7496 itk=itortyp(itype(k))
7497 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7498 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7499 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7500 call transpose2(EUgC(1,1,k),auxmat(1,1))
7501 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7502 vv1(1)=pizda1(1,1)-pizda1(2,2)
7503 vv1(2)=pizda1(1,2)+pizda1(2,1)
7504 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7505 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7506 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7507 s5=scalar2(vv(1),Dtobr2(1,i))
7508 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7509 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7510 if (.not. calc_grad) return
7511 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7512 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7513 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7514 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7515 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7516 & +scalar2(vv(1),Dtobr2der(1,i)))
7517 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7518 vv1(1)=pizda1(1,1)-pizda1(2,2)
7519 vv1(2)=pizda1(1,2)+pizda1(2,1)
7520 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7521 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7523 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7524 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7525 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7526 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7527 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7529 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7530 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7531 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7532 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7533 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7535 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7536 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7537 vv1(1)=pizda1(1,1)-pizda1(2,2)
7538 vv1(2)=pizda1(1,2)+pizda1(2,1)
7539 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7540 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7541 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7542 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7551 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7552 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7553 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7554 call transpose2(EUgC(1,1,k),auxmat(1,1))
7555 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7557 vv1(1)=pizda1(1,1)-pizda1(2,2)
7558 vv1(2)=pizda1(1,2)+pizda1(2,1)
7559 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7560 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7561 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7562 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7563 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7564 s5=scalar2(vv(1),Dtobr2(1,i))
7565 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7571 c----------------------------------------------------------------------------
7572 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7573 implicit real*8 (a-h,o-z)
7574 include 'DIMENSIONS'
7575 include 'sizesclu.dat'
7576 include 'COMMON.IOUNITS'
7577 include 'COMMON.CHAIN'
7578 include 'COMMON.DERIV'
7579 include 'COMMON.INTERACT'
7580 include 'COMMON.CONTACTS'
7581 include 'COMMON.TORSION'
7582 include 'COMMON.VAR'
7583 include 'COMMON.GEO'
7585 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7586 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7589 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7591 C Parallel Antiparallel C
7597 C \ j|/k\| \ |/k\|l C
7602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7603 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7604 C AL 7/4/01 s1 would occur in the sixth-order moment,
7605 C but not in a cluster cumulant
7607 s1=dip(1,jj,i)*dip(1,kk,k)
7609 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7610 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7611 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7612 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7613 call transpose2(EUg(1,1,k),auxmat(1,1))
7614 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)-pizda(2,2)
7616 vv(2)=pizda(1,2)+pizda(2,1)
7617 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7618 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7620 eello6_graph2=-(s1+s2+s3+s4)
7622 eello6_graph2=-(s2+s3+s4)
7625 if (.not. calc_grad) return
7626 C Derivatives in gamma(i-1)
7629 s1=dipderg(1,jj,i)*dip(1,kk,k)
7631 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7632 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7633 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7634 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7636 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7638 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7640 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7642 C Derivatives in gamma(k-1)
7644 s1=dip(1,jj,i)*dipderg(1,kk,k)
7646 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7647 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7648 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7649 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7650 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7651 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)-pizda(2,2)
7653 vv(2)=pizda(1,2)+pizda(2,1)
7654 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7656 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7658 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7660 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7661 C Derivatives in gamma(j-1) or gamma(l-1)
7664 s1=dipderg(3,jj,i)*dip(1,kk,k)
7666 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7667 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7668 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7669 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7670 vv(1)=pizda(1,1)-pizda(2,2)
7671 vv(2)=pizda(1,2)+pizda(2,1)
7672 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7675 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7677 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7680 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7681 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7683 C Derivatives in gamma(l-1) or gamma(j-1)
7686 s1=dip(1,jj,i)*dipderg(3,kk,k)
7688 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7689 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7690 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7691 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7692 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7693 vv(1)=pizda(1,1)-pizda(2,2)
7694 vv(2)=pizda(1,2)+pizda(2,1)
7695 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7698 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7700 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7703 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7704 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7706 C Cartesian derivatives.
7708 write (2,*) 'In eello6_graph2'
7710 write (2,*) 'iii=',iii
7712 write (2,*) 'kkk=',kkk
7714 write (2,'(3(2f10.5),5x)')
7715 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7725 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7727 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7730 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7732 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7733 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7735 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7736 call transpose2(EUg(1,1,k),auxmat(1,1))
7737 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7739 vv(1)=pizda(1,1)-pizda(2,2)
7740 vv(2)=pizda(1,2)+pizda(2,1)
7741 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7742 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7744 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7746 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7749 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7758 c----------------------------------------------------------------------------
7759 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7760 implicit real*8 (a-h,o-z)
7761 include 'DIMENSIONS'
7762 include 'sizesclu.dat'
7763 include 'COMMON.IOUNITS'
7764 include 'COMMON.CHAIN'
7765 include 'COMMON.DERIV'
7766 include 'COMMON.INTERACT'
7767 include 'COMMON.CONTACTS'
7768 include 'COMMON.TORSION'
7769 include 'COMMON.VAR'
7770 include 'COMMON.GEO'
7771 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7773 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7775 C Parallel Antiparallel C
7781 C j|/k\| / |/k\|l / C
7786 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7788 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7789 C energy moment and not to the cluster cumulant.
7790 iti=itortyp(itype(i))
7791 c if (j.lt.nres-1) then
7792 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7793 itj1=itortyp(itype(j+1))
7797 itk=itortyp(itype(k))
7798 itk1=itortyp(itype(k+1))
7799 c if (l.lt.nres-1) then
7800 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7801 itl1=itortyp(itype(l+1))
7806 s1=dip(4,jj,i)*dip(4,kk,k)
7808 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7809 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7810 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7811 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7812 call transpose2(EE(1,1,itk),auxmat(1,1))
7813 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7814 vv(1)=pizda(1,1)+pizda(2,2)
7815 vv(2)=pizda(2,1)-pizda(1,2)
7816 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7817 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7819 eello6_graph3=-(s1+s2+s3+s4)
7821 eello6_graph3=-(s2+s3+s4)
7824 if (.not. calc_grad) return
7825 C Derivatives in gamma(k-1)
7826 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7827 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7828 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7829 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7830 C Derivatives in gamma(l-1)
7831 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7832 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7833 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7834 vv(1)=pizda(1,1)+pizda(2,2)
7835 vv(2)=pizda(2,1)-pizda(1,2)
7836 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7837 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7838 C Cartesian derivatives.
7844 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7846 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7849 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7851 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7852 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7854 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7855 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7857 vv(1)=pizda(1,1)+pizda(2,2)
7858 vv(2)=pizda(2,1)-pizda(1,2)
7859 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7861 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7863 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7866 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7868 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7870 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7876 c----------------------------------------------------------------------------
7877 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7878 implicit real*8 (a-h,o-z)
7879 include 'DIMENSIONS'
7880 include 'sizesclu.dat'
7881 include 'COMMON.IOUNITS'
7882 include 'COMMON.CHAIN'
7883 include 'COMMON.DERIV'
7884 include 'COMMON.INTERACT'
7885 include 'COMMON.CONTACTS'
7886 include 'COMMON.TORSION'
7887 include 'COMMON.VAR'
7888 include 'COMMON.GEO'
7889 include 'COMMON.FFIELD'
7890 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7891 & auxvec1(2),auxmat1(2,2)
7893 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7895 C Parallel Antiparallel C
7901 C \ j|/k\| \ |/k\|l C
7906 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7908 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7909 C energy moment and not to the cluster cumulant.
7910 cd write (2,*) 'eello_graph4: wturn6',wturn6
7911 iti=itortyp(itype(i))
7912 itj=itortyp(itype(j))
7913 c if (j.lt.nres-1) then
7914 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7915 itj1=itortyp(itype(j+1))
7919 itk=itortyp(itype(k))
7920 c if (k.lt.nres-1) then
7921 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7922 itk1=itortyp(itype(k+1))
7926 itl=itortyp(itype(l))
7927 if (l.lt.nres-1) then
7928 itl1=itortyp(itype(l+1))
7932 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7933 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7934 cd & ' itl',itl,' itl1',itl1
7937 s1=dip(3,jj,i)*dip(3,kk,k)
7939 s1=dip(2,jj,j)*dip(2,kk,l)
7942 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7943 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7945 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7946 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7948 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7949 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7951 call transpose2(EUg(1,1,k),auxmat(1,1))
7952 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7953 vv(1)=pizda(1,1)-pizda(2,2)
7954 vv(2)=pizda(2,1)+pizda(1,2)
7955 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7956 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7958 eello6_graph4=-(s1+s2+s3+s4)
7960 eello6_graph4=-(s2+s3+s4)
7962 if (.not. calc_grad) return
7963 C Derivatives in gamma(i-1)
7967 s1=dipderg(2,jj,i)*dip(3,kk,k)
7969 s1=dipderg(4,jj,j)*dip(2,kk,l)
7972 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7974 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7975 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7977 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7978 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7980 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7981 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7982 cd write (2,*) 'turn6 derivatives'
7984 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7986 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7990 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7992 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7996 C Derivatives in gamma(k-1)
7999 s1=dip(3,jj,i)*dipderg(2,kk,k)
8001 s1=dip(2,jj,j)*dipderg(4,kk,l)
8004 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8005 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8007 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8008 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8010 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8011 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8013 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8014 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8015 vv(1)=pizda(1,1)-pizda(2,2)
8016 vv(2)=pizda(2,1)+pizda(1,2)
8017 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8018 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8020 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8022 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8026 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8028 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8031 C Derivatives in gamma(j-1) or gamma(l-1)
8032 if (l.eq.j+1 .and. l.gt.1) then
8033 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8034 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8035 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8036 vv(1)=pizda(1,1)-pizda(2,2)
8037 vv(2)=pizda(2,1)+pizda(1,2)
8038 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8039 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8040 else if (j.gt.1) then
8041 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8042 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8043 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8044 vv(1)=pizda(1,1)-pizda(2,2)
8045 vv(2)=pizda(2,1)+pizda(1,2)
8046 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8047 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8048 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8050 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8053 C Cartesian derivatives.
8060 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8062 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8066 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8068 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8072 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8074 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8076 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8077 & b1(1,itj1),auxvec(1))
8078 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8080 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8081 & b1(1,itl1),auxvec(1))
8082 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8084 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8086 vv(1)=pizda(1,1)-pizda(2,2)
8087 vv(2)=pizda(2,1)+pizda(1,2)
8088 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8090 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8092 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8095 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8098 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8101 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8103 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8105 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8109 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8111 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8114 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8116 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8124 c----------------------------------------------------------------------------
8125 double precision function eello_turn6(i,jj,kk)
8126 implicit real*8 (a-h,o-z)
8127 include 'DIMENSIONS'
8128 include 'sizesclu.dat'
8129 include 'COMMON.IOUNITS'
8130 include 'COMMON.CHAIN'
8131 include 'COMMON.DERIV'
8132 include 'COMMON.INTERACT'
8133 include 'COMMON.CONTACTS'
8134 include 'COMMON.TORSION'
8135 include 'COMMON.VAR'
8136 include 'COMMON.GEO'
8137 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8138 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8140 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8141 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8142 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8143 C the respective energy moment and not to the cluster cumulant.
8148 iti=itortyp(itype(i))
8149 itk=itortyp(itype(k))
8150 itk1=itortyp(itype(k+1))
8151 itl=itortyp(itype(l))
8152 itj=itortyp(itype(j))
8153 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8154 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8155 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8160 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8162 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8166 derx_turn(lll,kkk,iii)=0.0d0
8173 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8175 cd write (2,*) 'eello6_5',eello6_5
8177 call transpose2(AEA(1,1,1),auxmat(1,1))
8178 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8179 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8180 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8184 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8185 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8186 s2 = scalar2(b1(1,itk),vtemp1(1))
8188 call transpose2(AEA(1,1,2),atemp(1,1))
8189 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8190 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8191 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8195 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8196 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8197 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8199 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8200 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8201 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8202 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8203 ss13 = scalar2(b1(1,itk),vtemp4(1))
8204 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8208 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8214 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8216 C Derivatives in gamma(i+2)
8218 call transpose2(AEA(1,1,1),auxmatd(1,1))
8219 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8220 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8221 call transpose2(AEAderg(1,1,2),atempd(1,1))
8222 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8223 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8227 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8228 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8229 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8235 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8236 C Derivatives in gamma(i+3)
8238 call transpose2(AEA(1,1,1),auxmatd(1,1))
8239 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8240 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8241 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8245 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8246 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8247 s2d = scalar2(b1(1,itk),vtemp1d(1))
8249 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8250 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8252 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8254 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8255 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8256 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8266 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8267 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8269 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8270 & -0.5d0*ekont*(s2d+s12d)
8272 C Derivatives in gamma(i+4)
8273 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8274 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8275 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8277 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8278 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8279 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8289 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8291 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8293 C Derivatives in gamma(i+5)
8295 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8296 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8297 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8301 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8302 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8303 s2d = scalar2(b1(1,itk),vtemp1d(1))
8305 call transpose2(AEA(1,1,2),atempd(1,1))
8306 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8307 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8311 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8312 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8314 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8315 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8316 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8326 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8327 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8329 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8330 & -0.5d0*ekont*(s2d+s12d)
8332 C Cartesian derivatives
8337 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8338 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8339 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8343 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8344 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8346 s2d = scalar2(b1(1,itk),vtemp1d(1))
8348 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8349 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8350 s8d = -(atempd(1,1)+atempd(2,2))*
8351 & scalar2(cc(1,1,itl),vtemp2(1))
8355 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8357 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8358 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8365 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8368 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8372 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8373 & - 0.5d0*(s8d+s12d)
8375 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8384 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8386 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8387 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8388 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8389 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8390 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8392 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8393 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8394 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8398 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8399 cd & 16*eel_turn6_num
8401 if (j.lt.nres-1) then
8408 if (l.lt.nres-1) then
8416 ggg1(ll)=eel_turn6*g_contij(ll,1)
8417 ggg2(ll)=eel_turn6*g_contij(ll,2)
8418 ghalf=0.5d0*ggg1(ll)
8420 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8421 & +ekont*derx_turn(ll,2,1)
8422 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8423 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8424 & +ekont*derx_turn(ll,4,1)
8425 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8426 ghalf=0.5d0*ggg2(ll)
8428 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8429 & +ekont*derx_turn(ll,2,2)
8430 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8431 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8432 & +ekont*derx_turn(ll,4,2)
8433 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8438 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8443 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8449 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8454 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8458 cd write (2,*) iii,g_corr6_loc(iii)
8461 eello_turn6=ekont*eel_turn6
8462 cd write (2,*) 'ekont',ekont
8463 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8466 crc-------------------------------------------------
8467 SUBROUTINE MATVEC2(A1,V1,V2)
8468 implicit real*8 (a-h,o-z)
8469 include 'DIMENSIONS'
8470 DIMENSION A1(2,2),V1(2),V2(2)
8474 c 3 VI=VI+A1(I,K)*V1(K)
8478 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8479 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8484 C---------------------------------------
8485 SUBROUTINE MATMAT2(A1,A2,A3)
8486 implicit real*8 (a-h,o-z)
8487 include 'DIMENSIONS'
8488 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8489 c DIMENSION AI3(2,2)
8493 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8499 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8500 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8501 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8502 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8510 c-------------------------------------------------------------------------
8511 double precision function scalar2(u,v)
8513 double precision u(2),v(2)
8516 scalar2=u(1)*v(1)+u(2)*v(2)
8520 C-----------------------------------------------------------------------------
8522 subroutine transpose2(a,at)
8524 double precision a(2,2),at(2,2)
8531 c--------------------------------------------------------------------------
8532 subroutine transpose(n,a,at)
8535 double precision a(n,n),at(n,n)
8543 C---------------------------------------------------------------------------
8544 subroutine prodmat3(a1,a2,kk,transp,prod)
8547 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8549 crc double precision auxmat(2,2),prod_(2,2)
8552 crc call transpose2(kk(1,1),auxmat(1,1))
8553 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8554 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8556 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8557 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8558 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8559 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8560 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8561 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8562 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8563 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8566 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8567 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8569 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8570 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8571 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8572 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8573 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8574 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8575 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8576 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8579 c call transpose2(a2(1,1),a2t(1,1))
8582 crc print *,((prod_(i,j),i=1,2),j=1,2)
8583 crc print *,((prod(i,j),i=1,2),j=1,2)
8587 C-----------------------------------------------------------------------------
8588 double precision function scalar(u,v)
8590 double precision u(3),v(3)
8600 C-----------------------------------------------------------------------
8601 double precision function sscale(r)
8602 double precision r,gamm
8603 include "COMMON.SPLITELE"
8604 if(r.lt.r_cut-rlamb) then
8606 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8607 gamm=(r-(r_cut-rlamb))/rlamb
8608 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8614 C-----------------------------------------------------------------------
8615 C-----------------------------------------------------------------------
8616 double precision function sscagrad(r)
8617 double precision r,gamm
8618 include "COMMON.SPLITELE"
8619 if(r.lt.r_cut-rlamb) then
8621 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8622 gamm=(r-(r_cut-rlamb))/rlamb
8623 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8629 C-----------------------------------------------------------------------
8630 C first for shielding is setting of function of side-chains
8631 subroutine set_shield_fac2
8632 implicit real*8 (a-h,o-z)
8633 include 'DIMENSIONS'
8634 include 'COMMON.CHAIN'
8635 include 'COMMON.DERIV'
8636 include 'COMMON.IOUNITS'
8637 include 'COMMON.SHIELD'
8638 include 'COMMON.INTERACT'
8639 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8640 double precision div77_81/0.974996043d0/,
8641 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8643 C the vector between center of side_chain and peptide group
8644 double precision pep_side(3),long,side_calf(3),
8645 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8646 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8647 C the line belowe needs to be changed for FGPROC>1
8649 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8651 Cif there two consequtive dummy atoms there is no peptide group between them
8652 C the line below has to be changed for FGPROC>1
8655 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8659 C first lets set vector conecting the ithe side-chain with kth side-chain
8660 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8662 C and vector conecting the side-chain with its proper calfa
8663 side_calf(j)=c(j,k+nres)-c(j,k)
8664 C side_calf(j)=2.0d0
8665 pept_group(j)=c(j,i)-c(j,i+1)
8666 C lets have their lenght
8667 dist_pep_side=pep_side(j)**2+dist_pep_side
8668 dist_side_calf=dist_side_calf+side_calf(j)**2
8669 dist_pept_group=dist_pept_group+pept_group(j)**2
8671 dist_pep_side=dsqrt(dist_pep_side)
8672 dist_pept_group=dsqrt(dist_pept_group)
8673 dist_side_calf=dsqrt(dist_side_calf)
8675 pep_side_norm(j)=pep_side(j)/dist_pep_side
8676 side_calf_norm(j)=dist_side_calf
8678 C now sscale fraction
8679 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8680 C print *,buff_shield,"buff"
8682 if (sh_frac_dist.le.0.0) cycle
8683 C If we reach here it means that this side chain reaches the shielding sphere
8684 C Lets add him to the list for gradient
8685 ishield_list(i)=ishield_list(i)+1
8686 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8687 C this list is essential otherwise problem would be O3
8688 shield_list(ishield_list(i),i)=k
8689 C Lets have the sscale value
8690 if (sh_frac_dist.gt.1.0) then
8691 scale_fac_dist=1.0d0
8693 sh_frac_dist_grad(j)=0.0d0
8696 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8697 & *(2.0d0*sh_frac_dist-3.0d0)
8698 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8699 & /dist_pep_side/buff_shield*0.5d0
8700 C remember for the final gradient multiply sh_frac_dist_grad(j)
8701 C for side_chain by factor -2 !
8703 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8704 C sh_frac_dist_grad(j)=0.0d0
8705 C scale_fac_dist=1.0d0
8706 C print *,"jestem",scale_fac_dist,fac_help_scale,
8707 C & sh_frac_dist_grad(j)
8710 C this is what is now we have the distance scaling now volume...
8711 short=short_r_sidechain(itype(k))
8712 long=long_r_sidechain(itype(k))
8713 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8714 sinthet=short/dist_pep_side*costhet
8718 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8719 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8720 C & -short/dist_pep_side**2/costhet)
8723 costhet_grad(j)=costhet_fac*pep_side(j)
8725 C remember for the final gradient multiply costhet_grad(j)
8726 C for side_chain by factor -2 !
8727 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8728 C pep_side0pept_group is vector multiplication
8729 pep_side0pept_group=0.0d0
8731 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8733 cosalfa=(pep_side0pept_group/
8734 & (dist_pep_side*dist_side_calf))
8735 fac_alfa_sin=1.0d0-cosalfa**2
8736 fac_alfa_sin=dsqrt(fac_alfa_sin)
8737 rkprim=fac_alfa_sin*(long-short)+short
8741 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8743 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8744 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8748 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8749 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8750 &*(long-short)/fac_alfa_sin*cosalfa/
8751 &((dist_pep_side*dist_side_calf))*
8752 &((side_calf(j))-cosalfa*
8753 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8754 C cosphi_grad_long(j)=0.0d0
8755 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8756 &*(long-short)/fac_alfa_sin*cosalfa
8757 &/((dist_pep_side*dist_side_calf))*
8759 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8760 C cosphi_grad_loc(j)=0.0d0
8762 C print *,sinphi,sinthet
8763 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8766 C now the gradient...
8768 grad_shield(j,i)=grad_shield(j,i)
8769 C gradient po skalowaniu
8770 & +(sh_frac_dist_grad(j)*VofOverlap
8771 C gradient po costhet
8772 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8773 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8774 & sinphi/sinthet*costhet*costhet_grad(j)
8775 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8777 C grad_shield_side is Cbeta sidechain gradient
8778 grad_shield_side(j,ishield_list(i),i)=
8779 & (sh_frac_dist_grad(j)*-2.0d0
8781 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8782 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8783 & sinphi/sinthet*costhet*costhet_grad(j)
8784 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8787 grad_shield_loc(j,ishield_list(i),i)=
8788 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8789 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8790 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8794 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8796 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8797 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8801 C first for shielding is setting of function of side-chains
8802 subroutine set_shield_fac
8803 implicit real*8 (a-h,o-z)
8804 include 'DIMENSIONS'
8805 include 'COMMON.CHAIN'
8806 include 'COMMON.DERIV'
8807 include 'COMMON.IOUNITS'
8808 include 'COMMON.SHIELD'
8809 include 'COMMON.INTERACT'
8810 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8811 double precision div77_81/0.974996043d0/,
8812 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8814 C the vector between center of side_chain and peptide group
8815 double precision pep_side(3),long,side_calf(3),
8816 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8817 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8818 C the line belowe needs to be changed for FGPROC>1
8820 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8822 Cif there two consequtive dummy atoms there is no peptide group between them
8823 C the line below has to be changed for FGPROC>1
8826 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8830 C first lets set vector conecting the ithe side-chain with kth side-chain
8831 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8833 C and vector conecting the side-chain with its proper calfa
8834 side_calf(j)=c(j,k+nres)-c(j,k)
8835 C side_calf(j)=2.0d0
8836 pept_group(j)=c(j,i)-c(j,i+1)
8837 C lets have their lenght
8838 dist_pep_side=pep_side(j)**2+dist_pep_side
8839 dist_side_calf=dist_side_calf+side_calf(j)**2
8840 dist_pept_group=dist_pept_group+pept_group(j)**2
8842 dist_pep_side=dsqrt(dist_pep_side)
8843 dist_pept_group=dsqrt(dist_pept_group)
8844 dist_side_calf=dsqrt(dist_side_calf)
8846 pep_side_norm(j)=pep_side(j)/dist_pep_side
8847 side_calf_norm(j)=dist_side_calf
8849 C now sscale fraction
8850 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8851 C print *,buff_shield,"buff"
8853 if (sh_frac_dist.le.0.0) cycle
8854 C If we reach here it means that this side chain reaches the shielding sphere
8855 C Lets add him to the list for gradient
8856 ishield_list(i)=ishield_list(i)+1
8857 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8858 C this list is essential otherwise problem would be O3
8859 shield_list(ishield_list(i),i)=k
8860 C Lets have the sscale value
8861 if (sh_frac_dist.gt.1.0) then
8862 scale_fac_dist=1.0d0
8864 sh_frac_dist_grad(j)=0.0d0
8867 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8868 & *(2.0*sh_frac_dist-3.0d0)
8869 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8870 & /dist_pep_side/buff_shield*0.5
8871 C remember for the final gradient multiply sh_frac_dist_grad(j)
8872 C for side_chain by factor -2 !
8874 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8875 C print *,"jestem",scale_fac_dist,fac_help_scale,
8876 C & sh_frac_dist_grad(j)
8879 C if ((i.eq.3).and.(k.eq.2)) then
8880 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8884 C this is what is now we have the distance scaling now volume...
8885 short=short_r_sidechain(itype(k))
8886 long=long_r_sidechain(itype(k))
8887 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8890 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8893 costhet_grad(j)=costhet_fac*pep_side(j)
8895 C remember for the final gradient multiply costhet_grad(j)
8896 C for side_chain by factor -2 !
8897 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8898 C pep_side0pept_group is vector multiplication
8899 pep_side0pept_group=0.0
8901 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8903 cosalfa=(pep_side0pept_group/
8904 & (dist_pep_side*dist_side_calf))
8905 fac_alfa_sin=1.0-cosalfa**2
8906 fac_alfa_sin=dsqrt(fac_alfa_sin)
8907 rkprim=fac_alfa_sin*(long-short)+short
8909 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8910 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8913 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8914 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8915 &*(long-short)/fac_alfa_sin*cosalfa/
8916 &((dist_pep_side*dist_side_calf))*
8917 &((side_calf(j))-cosalfa*
8918 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8920 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8921 &*(long-short)/fac_alfa_sin*cosalfa
8922 &/((dist_pep_side*dist_side_calf))*
8924 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8927 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8930 C now the gradient...
8931 C grad_shield is gradient of Calfa for peptide groups
8932 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8934 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8935 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8937 grad_shield(j,i)=grad_shield(j,i)
8938 C gradient po skalowaniu
8939 & +(sh_frac_dist_grad(j)
8940 C gradient po costhet
8941 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8942 &-scale_fac_dist*(cosphi_grad_long(j))
8943 &/(1.0-cosphi) )*div77_81
8945 C grad_shield_side is Cbeta sidechain gradient
8946 grad_shield_side(j,ishield_list(i),i)=
8947 & (sh_frac_dist_grad(j)*-2.0d0
8948 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8949 & +scale_fac_dist*(cosphi_grad_long(j))
8950 & *2.0d0/(1.0-cosphi))
8951 & *div77_81*VofOverlap
8953 grad_shield_loc(j,ishield_list(i),i)=
8954 & scale_fac_dist*cosphi_grad_loc(j)
8955 & *2.0d0/(1.0-cosphi)
8956 & *div77_81*VofOverlap
8958 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8960 fac_shield(i)=VolumeTotal*div77_81+div4_81
8961 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8965 C--------------------------------------------------------------------------
8966 C-----------------------------------------------------------------------
8967 double precision function sscalelip(r)
8968 double precision r,gamm
8969 include "COMMON.SPLITELE"
8970 C if(r.lt.r_cut-rlamb) then
8972 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8973 C gamm=(r-(r_cut-rlamb))/rlamb
8974 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8980 C-----------------------------------------------------------------------
8981 double precision function sscagradlip(r)
8982 double precision r,gamm
8983 include "COMMON.SPLITELE"
8984 C if(r.lt.r_cut-rlamb) then
8986 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8987 C gamm=(r-(r_cut-rlamb))/rlamb
8988 sscagradlip=r*(6*r-6.0d0)
8995 C-----------------------------------------------------------------------
8996 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8997 subroutine Eliptransfer(eliptran)
8998 implicit real*8 (a-h,o-z)
8999 include 'DIMENSIONS'
9000 include 'COMMON.GEO'
9001 include 'COMMON.VAR'
9002 include 'COMMON.LOCAL'
9003 include 'COMMON.CHAIN'
9004 include 'COMMON.DERIV'
9005 include 'COMMON.INTERACT'
9006 include 'COMMON.IOUNITS'
9007 include 'COMMON.CALC'
9008 include 'COMMON.CONTROL'
9009 include 'COMMON.SPLITELE'
9010 include 'COMMON.SBRIDGE'
9011 C this is done by Adasko
9015 C--bordliptop-- buffore starts
9016 C--bufliptop--- here true lipid starts
9018 C--buflipbot--- lipid ends buffore starts
9019 C--bordlipbot--buffore ends
9021 write(iout,*) "I am in?"
9024 if (itype(i).eq.ntyp1) cycle
9026 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9027 if (positi.le.0) positi=positi+boxzsize
9029 C first for peptide groups
9030 c for each residue check if it is in lipid or lipid water border area
9031 if ((positi.gt.bordlipbot)
9032 &.and.(positi.lt.bordliptop)) then
9033 C the energy transfer exist
9034 if (positi.lt.buflipbot) then
9035 C what fraction I am in
9037 & ((positi-bordlipbot)/lipbufthick)
9038 C lipbufthick is thickenes of lipid buffore
9039 sslip=sscalelip(fracinbuf)
9040 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9041 eliptran=eliptran+sslip*pepliptran
9042 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9043 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9044 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9045 elseif (positi.gt.bufliptop) then
9046 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9047 sslip=sscalelip(fracinbuf)
9048 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9049 eliptran=eliptran+sslip*pepliptran
9050 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9051 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9052 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9053 C print *, "doing sscalefor top part"
9054 C print *,i,sslip,fracinbuf,ssgradlip
9056 eliptran=eliptran+pepliptran
9057 C print *,"I am in true lipid"
9060 C eliptran=elpitran+0.0 ! I am in water
9063 C print *, "nic nie bylo w lipidzie?"
9064 C now multiply all by the peptide group transfer factor
9065 C eliptran=eliptran*pepliptran
9066 C now the same for side chains
9069 if (itype(i).eq.ntyp1) cycle
9070 positi=(mod(c(3,i+nres),boxzsize))
9071 if (positi.le.0) positi=positi+boxzsize
9072 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9073 c for each residue check if it is in lipid or lipid water border area
9074 C respos=mod(c(3,i+nres),boxzsize)
9075 C print *,positi,bordlipbot,buflipbot
9076 if ((positi.gt.bordlipbot)
9077 & .and.(positi.lt.bordliptop)) then
9078 C the energy transfer exist
9079 if (positi.lt.buflipbot) then
9081 & ((positi-bordlipbot)/lipbufthick)
9082 C lipbufthick is thickenes of lipid buffore
9083 sslip=sscalelip(fracinbuf)
9084 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9085 eliptran=eliptran+sslip*liptranene(itype(i))
9086 gliptranx(3,i)=gliptranx(3,i)
9087 &+ssgradlip*liptranene(itype(i))
9088 gliptranc(3,i-1)= gliptranc(3,i-1)
9089 &+ssgradlip*liptranene(itype(i))
9090 C print *,"doing sccale for lower part"
9091 elseif (positi.gt.bufliptop) then
9093 &((bordliptop-positi)/lipbufthick)
9094 sslip=sscalelip(fracinbuf)
9095 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9096 eliptran=eliptran+sslip*liptranene(itype(i))
9097 gliptranx(3,i)=gliptranx(3,i)
9098 &+ssgradlip*liptranene(itype(i))
9099 gliptranc(3,i-1)= gliptranc(3,i-1)
9100 &+ssgradlip*liptranene(itype(i))
9101 C print *, "doing sscalefor top part",sslip,fracinbuf
9103 eliptran=eliptran+liptranene(itype(i))
9104 C print *,"I am in true lipid"
9106 endif ! if in lipid or buffor
9108 C eliptran=elpitran+0.0 ! I am in water
9112 C-------------------------------------------------------------------------------------
9113 C-----------------------------------------------------------------------
9114 C-----------------------------------------------------------
9115 C This subroutine is to mimic the histone like structure but as well can be
9116 C utilizet to nanostructures (infinit) small modification has to be used to
9117 C make it finite (z gradient at the ends has to be changes as well as the x,y
9118 C gradient has to be modified at the ends
9119 C The energy function is Kihara potential
9120 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9121 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9122 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9123 C simple Kihara potential
9124 subroutine calctube(Etube)
9125 implicit real*8 (a-h,o-z)
9126 include 'DIMENSIONS'
9127 include 'COMMON.GEO'
9128 include 'COMMON.VAR'
9129 include 'COMMON.LOCAL'
9130 include 'COMMON.CHAIN'
9131 include 'COMMON.DERIV'
9132 include 'COMMON.INTERACT'
9133 include 'COMMON.IOUNITS'
9134 include 'COMMON.CALC'
9135 include 'COMMON.CONTROL'
9136 include 'COMMON.SPLITELE'
9137 include 'COMMON.SBRIDGE'
9138 double precision tub_r,vectube(3),enetube(maxres*2)
9140 do i=itube_start,itube_end
9142 enetube(i+nres)=0.0d0
9144 C first we calculate the distance from tube center
9145 C first sugare-phosphate group for NARES this would be peptide group
9147 do i=itube_start,itube_end
9148 C lets ommit dummy atoms for now
9149 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9150 C now calculate distance from center of tube and direction vectors
9154 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9155 vectube(1)=vectube(1)+boxxsize*j
9156 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9157 vectube(2)=vectube(2)+boxysize*j
9159 xminact=abs(vectube(1)-tubecenter(1))
9160 yminact=abs(vectube(2)-tubecenter(2))
9161 if (xmin.gt.xminact) then
9165 if (ymin.gt.yminact) then
9172 vectube(1)=vectube(1)-tubecenter(1)
9173 vectube(2)=vectube(2)-tubecenter(2)
9175 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9176 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9178 C as the tube is infinity we do not calculate the Z-vector use of Z
9181 C now calculte the distance
9182 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9183 C now normalize vector
9184 vectube(1)=vectube(1)/tub_r
9185 vectube(2)=vectube(2)/tub_r
9186 C calculte rdiffrence between r and r0
9190 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9191 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9192 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9193 C print *,rdiff,rdiff6,pep_aa_tube
9194 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9195 C now we calculate gradient
9196 fac=(-12.0d0*pep_aa_tube/rdiff6-
9197 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9198 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9201 C now direction of gg_tube vector
9203 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9204 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9207 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9208 C print *,gg_tube(1,0),"TU"
9211 do i=itube_start,itube_end
9212 C Lets not jump over memory as we use many times iti
9214 C lets ommit dummy atoms for now
9216 C in UNRES uncomment the line below as GLY has no side-chain...
9222 vectube(1)=mod((c(1,i+nres)),boxxsize)
9223 vectube(1)=vectube(1)+boxxsize*j
9224 vectube(2)=mod((c(2,i+nres)),boxysize)
9225 vectube(2)=vectube(2)+boxysize*j
9227 xminact=abs(vectube(1)-tubecenter(1))
9228 yminact=abs(vectube(2)-tubecenter(2))
9229 if (xmin.gt.xminact) then
9233 if (ymin.gt.yminact) then
9240 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9242 vectube(1)=vectube(1)-tubecenter(1)
9243 vectube(2)=vectube(2)-tubecenter(2)
9245 C as the tube is infinity we do not calculate the Z-vector use of Z
9248 C now calculte the distance
9249 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9250 C now normalize vector
9251 vectube(1)=vectube(1)/tub_r
9252 vectube(2)=vectube(2)/tub_r
9254 C calculte rdiffrence between r and r0
9258 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9259 sc_aa_tube=sc_aa_tube_par(iti)
9260 sc_bb_tube=sc_bb_tube_par(iti)
9261 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9262 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9263 C now we calculate gradient
9264 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9265 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9266 C now direction of gg_tube vector
9268 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9269 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9272 do i=itube_start,itube_end
9273 Etube=Etube+enetube(i)+enetube(i+nres)
9275 C print *,"ETUBE", etube
9278 C TO DO 1) add to total energy
9279 C 2) add to gradient summation
9280 C 3) add reading parameters (AND of course oppening of PARAM file)
9281 C 4) add reading the center of tube
9283 C 6) add to zerograd
9285 C-----------------------------------------------------------------------
9286 C-----------------------------------------------------------
9287 C This subroutine is to mimic the histone like structure but as well can be
9288 C utilizet to nanostructures (infinit) small modification has to be used to
9289 C make it finite (z gradient at the ends has to be changes as well as the x,y
9290 C gradient has to be modified at the ends
9291 C The energy function is Kihara potential
9292 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9293 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9294 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9295 C simple Kihara potential
9296 subroutine calctube2(Etube)
9297 implicit real*8 (a-h,o-z)
9298 include 'DIMENSIONS'
9299 include 'COMMON.GEO'
9300 include 'COMMON.VAR'
9301 include 'COMMON.LOCAL'
9302 include 'COMMON.CHAIN'
9303 include 'COMMON.DERIV'
9304 include 'COMMON.INTERACT'
9305 include 'COMMON.IOUNITS'
9306 include 'COMMON.CALC'
9307 include 'COMMON.CONTROL'
9308 include 'COMMON.SPLITELE'
9309 include 'COMMON.SBRIDGE'
9310 double precision tub_r,vectube(3),enetube(maxres*2)
9312 do i=itube_start,itube_end
9314 enetube(i+nres)=0.0d0
9316 C first we calculate the distance from tube center
9317 C first sugare-phosphate group for NARES this would be peptide group
9319 do i=itube_start,itube_end
9320 C lets ommit dummy atoms for now
9322 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9323 C now calculate distance from center of tube and direction vectors
9324 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9325 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9326 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9327 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9331 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9332 vectube(1)=vectube(1)+boxxsize*j
9333 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9334 vectube(2)=vectube(2)+boxysize*j
9336 xminact=abs(vectube(1)-tubecenter(1))
9337 yminact=abs(vectube(2)-tubecenter(2))
9338 if (xmin.gt.xminact) then
9342 if (ymin.gt.yminact) then
9349 vectube(1)=vectube(1)-tubecenter(1)
9350 vectube(2)=vectube(2)-tubecenter(2)
9352 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9353 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9355 C as the tube is infinity we do not calculate the Z-vector use of Z
9358 C now calculte the distance
9359 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9360 C now normalize vector
9361 vectube(1)=vectube(1)/tub_r
9362 vectube(2)=vectube(2)/tub_r
9363 C calculte rdiffrence between r and r0
9367 C THIS FRAGMENT MAKES TUBE FINITE
9368 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9369 if (positi.le.0) positi=positi+boxzsize
9370 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9371 c for each residue check if it is in lipid or lipid water border area
9372 C respos=mod(c(3,i+nres),boxzsize)
9373 print *,positi,bordtubebot,buftubebot,bordtubetop
9374 if ((positi.gt.bordtubebot)
9375 & .and.(positi.lt.bordtubetop)) then
9376 C the energy transfer exist
9377 if (positi.lt.buftubebot) then
9379 & ((positi-bordtubebot)/tubebufthick)
9380 C lipbufthick is thickenes of lipid buffore
9381 sstube=sscalelip(fracinbuf)
9382 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9383 print *,ssgradtube, sstube,tubetranene(itype(i))
9384 enetube(i)=enetube(i)+sstube*tubetranenepep
9385 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9386 C &+ssgradtube*tubetranene(itype(i))
9387 C gg_tube(3,i-1)= gg_tube(3,i-1)
9388 C &+ssgradtube*tubetranene(itype(i))
9389 C print *,"doing sccale for lower part"
9390 elseif (positi.gt.buftubetop) then
9392 &((bordtubetop-positi)/tubebufthick)
9393 sstube=sscalelip(fracinbuf)
9394 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9395 enetube(i)=enetube(i)+sstube*tubetranenepep
9396 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9397 C &+ssgradtube*tubetranene(itype(i))
9398 C gg_tube(3,i-1)= gg_tube(3,i-1)
9399 C &+ssgradtube*tubetranene(itype(i))
9400 C print *, "doing sscalefor top part",sslip,fracinbuf
9404 enetube(i)=enetube(i)+sstube*tubetranenepep
9405 C print *,"I am in true lipid"
9411 endif ! if in lipid or buffor
9413 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9414 enetube(i)=enetube(i)+sstube*
9415 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
9416 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9417 C print *,rdiff,rdiff6,pep_aa_tube
9418 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9419 C now we calculate gradient
9420 fac=(-12.0d0*pep_aa_tube/rdiff6-
9421 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
9422 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9425 C now direction of gg_tube vector
9427 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9428 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9430 gg_tube(3,i)=gg_tube(3,i)
9431 &+ssgradtube*enetube(i)/sstube/2.0d0
9432 gg_tube(3,i-1)= gg_tube(3,i-1)
9433 &+ssgradtube*enetube(i)/sstube/2.0d0
9436 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9437 C print *,gg_tube(1,0),"TU"
9438 do i=itube_start,itube_end
9439 C Lets not jump over memory as we use many times iti
9441 C lets ommit dummy atoms for now
9443 C in UNRES uncomment the line below as GLY has no side-chain...
9446 vectube(1)=c(1,i+nres)
9447 vectube(1)=mod(vectube(1),boxxsize)
9448 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9449 vectube(2)=c(2,i+nres)
9450 vectube(2)=mod(vectube(2),boxysize)
9451 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9453 vectube(1)=vectube(1)-tubecenter(1)
9454 vectube(2)=vectube(2)-tubecenter(2)
9455 C THIS FRAGMENT MAKES TUBE FINITE
9456 positi=(mod(c(3,i+nres),boxzsize))
9457 if (positi.le.0) positi=positi+boxzsize
9458 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9459 c for each residue check if it is in lipid or lipid water border area
9460 C respos=mod(c(3,i+nres),boxzsize)
9461 print *,positi,bordtubebot,buftubebot,bordtubetop
9462 if ((positi.gt.bordtubebot)
9463 & .and.(positi.lt.bordtubetop)) then
9464 C the energy transfer exist
9465 if (positi.lt.buftubebot) then
9467 & ((positi-bordtubebot)/tubebufthick)
9468 C lipbufthick is thickenes of lipid buffore
9469 sstube=sscalelip(fracinbuf)
9470 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9471 print *,ssgradtube, sstube,tubetranene(itype(i))
9472 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9473 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9474 C &+ssgradtube*tubetranene(itype(i))
9475 C gg_tube(3,i-1)= gg_tube(3,i-1)
9476 C &+ssgradtube*tubetranene(itype(i))
9477 C print *,"doing sccale for lower part"
9478 elseif (positi.gt.buftubetop) then
9480 &((bordtubetop-positi)/tubebufthick)
9481 sstube=sscalelip(fracinbuf)
9482 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9483 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9484 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9485 C &+ssgradtube*tubetranene(itype(i))
9486 C gg_tube(3,i-1)= gg_tube(3,i-1)
9487 C &+ssgradtube*tubetranene(itype(i))
9488 C print *, "doing sscalefor top part",sslip,fracinbuf
9492 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9493 C print *,"I am in true lipid"
9499 endif ! if in lipid or buffor
9500 CEND OF FINITE FRAGMENT
9501 C as the tube is infinity we do not calculate the Z-vector use of Z
9504 C now calculte the distance
9505 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9506 C now normalize vector
9507 vectube(1)=vectube(1)/tub_r
9508 vectube(2)=vectube(2)/tub_r
9509 C calculte rdiffrence between r and r0
9513 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9514 sc_aa_tube=sc_aa_tube_par(iti)
9515 sc_bb_tube=sc_bb_tube_par(iti)
9516 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
9517 & *sstube+enetube(i+nres)
9518 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9519 C now we calculate gradient
9520 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9521 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
9522 C now direction of gg_tube vector
9524 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9525 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9527 gg_tube_SC(3,i)=gg_tube_SC(3,i)
9528 &+ssgradtube*enetube(i+nres)/sstube
9529 gg_tube(3,i-1)= gg_tube(3,i-1)
9530 &+ssgradtube*enetube(i+nres)/sstube
9533 do i=itube_start,itube_end
9534 Etube=Etube+enetube(i)+enetube(i+nres)
9536 C print *,"ETUBE", etube
9539 C TO DO 1) add to total energy
9540 C 2) add to gradient summation
9541 C 3) add reading parameters (AND of course oppening of PARAM file)
9542 C 4) add reading the center of tube
9544 C 6) add to zerograd
9547 C#-------------------------------------------------------------------------------
9548 C This subroutine is to mimic the histone like structure but as well can be
9549 C utilizet to nanostructures (infinit) small modification has to be used to
9550 C make it finite (z gradient at the ends has to be changes as well as the x,y
9551 C gradient has to be modified at the ends
9552 C The energy function is Kihara potential
9553 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9554 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9555 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9556 C simple Kihara potential
9557 subroutine calcnano(Etube)
9558 implicit real*8 (a-h,o-z)
9559 include 'DIMENSIONS'
9560 include 'COMMON.GEO'
9561 include 'COMMON.VAR'
9562 include 'COMMON.LOCAL'
9563 include 'COMMON.CHAIN'
9564 include 'COMMON.DERIV'
9565 include 'COMMON.INTERACT'
9566 include 'COMMON.IOUNITS'
9567 include 'COMMON.CALC'
9568 include 'COMMON.CONTROL'
9569 include 'COMMON.SPLITELE'
9570 include 'COMMON.SBRIDGE'
9571 double precision tub_r,vectube(3),enetube(maxres*2),
9572 & enecavtube(maxres*2)
9574 do i=itube_start,itube_end
9576 enetube(i+nres)=0.0d0
9578 C first we calculate the distance from tube center
9579 C first sugare-phosphate group for NARES this would be peptide group
9581 do i=itube_start,itube_end
9582 C lets ommit dummy atoms for now
9583 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9584 C now calculate distance from center of tube and direction vectors
9590 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9591 vectube(1)=vectube(1)+boxxsize*j
9592 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9593 vectube(2)=vectube(2)+boxysize*j
9594 vectube(3)=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9595 vectube(3)=vectube(3)+boxzsize*j
9598 xminact=abs(vectube(1)-tubecenter(1))
9599 yminact=abs(vectube(2)-tubecenter(2))
9600 zminact=abs(vectube(3)-tubecenter(3))
9602 if (xmin.gt.xminact) then
9606 if (ymin.gt.yminact) then
9610 if (zmin.gt.zminact) then
9619 vectube(1)=vectube(1)-tubecenter(1)
9620 vectube(2)=vectube(2)-tubecenter(2)
9621 vectube(3)=vectube(3)-tubecenter(3)
9623 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9624 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9625 C as the tube is infinity we do not calculate the Z-vector use of Z
9628 C now calculte the distance
9629 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9630 C now normalize vector
9631 vectube(1)=vectube(1)/tub_r
9632 vectube(2)=vectube(2)/tub_r
9633 vectube(3)=vectube(3)/tub_r
9634 C calculte rdiffrence between r and r0
9638 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9639 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9640 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9641 C print *,rdiff,rdiff6,pep_aa_tube
9642 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9643 C now we calculate gradient
9644 fac=(-12.0d0*pep_aa_tube/rdiff6-
9645 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9646 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9648 if (acavtubpep.eq.0.0d0) then
9653 denominator=(1.0+dcavtubpep*rdiff6*rdiff6)
9655 & (bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)+ccavtubpep)
9658 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/sqrt(rdiff))
9659 & *denominator-(bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)
9660 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
9661 & /denominator**2.0d0
9666 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
9667 C & enecavtube(i),faccav
9669 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9670 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
9672 C now direction of gg_tube vector
9674 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9675 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9679 do i=itube_start,itube_end
9681 C Lets not jump over memory as we use many times iti
9683 C lets ommit dummy atoms for now
9685 C in UNRES uncomment the line below as GLY has no side-chain...
9692 vectube(1)=mod((c(1,i+nres)),boxxsize)
9693 vectube(1)=vectube(1)+boxxsize*j
9694 vectube(2)=mod((c(2,i+nres)),boxysize)
9695 vectube(2)=vectube(2)+boxysize*j
9696 vectube(3)=mod((c(3,i+nres)),boxzsize)
9697 vectube(3)=vectube(3)+boxzsize*j
9700 xminact=abs(vectube(1)-tubecenter(1))
9701 yminact=abs(vectube(2)-tubecenter(2))
9702 zminact=abs(vectube(3)-tubecenter(3))
9704 if (xmin.gt.xminact) then
9708 if (ymin.gt.yminact) then
9712 if (zmin.gt.zminact) then
9721 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9723 vectube(1)=vectube(1)-tubecenter(1)
9724 vectube(2)=vectube(2)-tubecenter(2)
9725 vectube(3)=vectube(3)-tubecenter(3)
9726 C now calculte the distance
9727 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9728 C now normalize vector
9729 vectube(1)=vectube(1)/tub_r
9730 vectube(2)=vectube(2)/tub_r
9731 vectube(3)=vectube(3)/tub_r
9733 C calculte rdiffrence between r and r0
9737 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9738 sc_aa_tube=sc_aa_tube_par(iti)
9739 sc_bb_tube=sc_bb_tube_par(iti)
9740 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9741 C enetube(i+nres)=0.0d0
9742 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9743 C now we calculate gradient
9744 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9745 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9747 C now direction of gg_tube vector
9748 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9749 if (acavtub(iti).eq.0.0d0) then
9751 enecavtube(i+nres)=0.0
9754 denominator=(1.0+dcavtub(iti)*rdiff6*rdiff6)
9756 & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9759 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/sqrt(rdiff))
9760 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)
9761 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
9762 & /denominator**2.0d0
9767 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
9768 C & enecavtube(i),faccav
9770 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9771 C print *,"finene=",enetube(i+nres)+enecavtube(i)
9773 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9774 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9777 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9778 C do i=itube_start,itube_end
9781 C if (acavtub(iti).eq.0.0) cycle
9785 do i=itube_start,itube_end
9786 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
9787 & +enecavtube(i+nres)
9789 C print *,"ETUBE", etube
9792 C TO DO 1) add to total energy
9793 C 2) add to gradient summation
9794 C 3) add reading parameters (AND of course oppening of PARAM file)
9795 C 4) add reading the center of tube
9797 C 6) add to zerograd