1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C write(iout,*) 'po eelec'
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
63 C write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
73 C print *,'Bend energy finished.'
74 call ebend(ebe,ethetacnstr)
75 cd print *,'Bend energy finished.'
77 C Calculate the SC local energy.
80 C print *,'SCLOC energy finished.'
82 C Calculate the virtual-bond torsional energy.
84 cd print *,'nterm=',nterm
85 call etor(etors,edihcnstr,fact(1))
87 C 6/23/01 Calculate double-torsional energy
89 call etor_d(etors_d,fact(2))
91 C 21/5/07 Calculate local sicdechain correlation energy
93 call eback_sc_corr(esccor)
95 if (wliptran.gt.0) then
96 call Eliptransfer(eliptran)
100 C 12/1/95 Multi-body terms
104 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
105 & .or. wturn6.gt.0.0d0) then
106 c print *,"calling multibody_eello"
107 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
108 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
109 c print *,ecorr,ecorr5,ecorr6,eturn6
111 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
112 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
114 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
126 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
127 & +welec*fact(1)*(ees+evdw1)
128 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
129 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
130 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
131 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
132 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
133 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
139 energia(2)=evdw2-evdw2_14
156 energia(8)=eello_turn3
157 energia(9)=eello_turn4
166 energia(20)=edihcnstr
168 energia(24)=ethetacnstr
173 if (isnan(etot).ne.0) energia(0)=1.0d+99
175 if (isnan(etot)) energia(0)=1.0d+99
180 idumm=proc_proc(etot,i)
182 call proc_proc(etot,i)
184 if(i.eq.1)energia(0)=1.0d+99
191 C Sum up the components of the Cartesian gradient.
196 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
197 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
199 & wstrain*ghpbc(j,i)+
200 & wcorr*fact(3)*gradcorr(j,i)+
201 & wel_loc*fact(2)*gel_loc(j,i)+
202 & wturn3*fact(2)*gcorr3_turn(j,i)+
203 & wturn4*fact(3)*gcorr4_turn(j,i)+
204 & wcorr5*fact(4)*gradcorr5(j,i)+
205 & wcorr6*fact(5)*gradcorr6(j,i)+
206 & wturn6*fact(5)*gcorr6_turn(j,i)+
207 & wsccor*fact(2)*gsccorc(j,i)
208 & +wliptran*gliptranc(j,i)
209 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
211 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
212 & wsccor*fact(2)*gsccorx(j,i)
213 & +wliptran*gliptranx(j,i)
218 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
219 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
221 & wcorr*fact(3)*gradcorr(j,i)+
222 & wel_loc*fact(2)*gel_loc(j,i)+
223 & wturn3*fact(2)*gcorr3_turn(j,i)+
224 & wturn4*fact(3)*gcorr4_turn(j,i)+
225 & wcorr5*fact(4)*gradcorr5(j,i)+
226 & wcorr6*fact(5)*gradcorr6(j,i)+
227 & wturn6*fact(5)*gcorr6_turn(j,i)+
228 & wsccor*fact(2)*gsccorc(j,i)
229 & +wliptran*gliptranc(j,i)
230 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
232 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
233 & wsccor*fact(1)*gsccorx(j,i)
234 & +wliptran*gliptranx(j,i)
241 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
242 & +wcorr5*fact(4)*g_corr5_loc(i)
243 & +wcorr6*fact(5)*g_corr6_loc(i)
244 & +wturn4*fact(3)*gel_loc_turn4(i)
245 & +wturn3*fact(2)*gel_loc_turn3(i)
246 & +wturn6*fact(5)*gel_loc_turn6(i)
247 & +wel_loc*fact(2)*gel_loc_loc(i)
248 c & +wsccor*fact(1)*gsccor_loc(i)
249 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
252 if (dyn_ss) call dyn_set_nss
255 C------------------------------------------------------------------------
256 subroutine enerprint(energia,fact)
257 implicit real*8 (a-h,o-z)
259 include 'DIMENSIONS.ZSCOPT'
260 include 'COMMON.IOUNITS'
261 include 'COMMON.FFIELD'
262 include 'COMMON.SBRIDGE'
263 double precision energia(0:max_ene),fact(6)
265 evdw=energia(1)+fact(6)*energia(21)
267 evdw2=energia(2)+energia(17)
279 eello_turn3=energia(8)
280 eello_turn4=energia(9)
281 eello_turn6=energia(10)
288 edihcnstr=energia(20)
290 ethetacnstr=energia(24)
293 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
295 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
296 & etors_d,wtor_d*fact(2),ehpb,wstrain,
297 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
298 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
299 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
300 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
301 & eliptran,wliptran,etot
302 10 format (/'Virtual-chain energies:'//
303 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
304 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
305 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
306 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
307 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
308 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
309 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
310 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
311 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
312 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
313 & ' (SS bridges & dist. cnstr.)'/
314 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
315 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
316 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
317 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
318 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
319 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
320 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
321 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
322 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
323 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
324 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
325 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
326 & 'ETOT= ',1pE16.6,' (total)')
328 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
329 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
330 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
331 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
332 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
333 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
334 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
335 10 format (/'Virtual-chain energies:'//
336 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
337 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
338 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
339 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
340 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
341 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
342 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
343 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
344 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
345 & ' (SS bridges & dist. cnstr.)'/
346 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
347 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
348 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
349 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
350 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
351 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
352 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
353 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
354 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
355 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
356 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
357 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
358 & 'ETOT= ',1pE16.6,' (total)')
362 C-----------------------------------------------------------------------
363 subroutine elj(evdw,evdw_t)
365 C This subroutine calculates the interaction energy of nonbonded side chains
366 C assuming the LJ potential of interaction.
368 implicit real*8 (a-h,o-z)
370 include 'DIMENSIONS.ZSCOPT'
371 include "DIMENSIONS.COMPAR"
372 parameter (accur=1.0d-10)
375 include 'COMMON.LOCAL'
376 include 'COMMON.CHAIN'
377 include 'COMMON.DERIV'
378 include 'COMMON.INTERACT'
379 include 'COMMON.TORSION'
380 include 'COMMON.ENEPS'
381 include 'COMMON.SBRIDGE'
382 include 'COMMON.NAMES'
383 include 'COMMON.IOUNITS'
384 include 'COMMON.CONTACTS'
388 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
392 eneps_temp(j,i)=0.0d0
401 if (itypi.eq.ntyp1) cycle
402 itypi1=iabs(itype(i+1))
409 C Calculate SC interaction energy.
412 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
413 cd & 'iend=',iend(i,iint)
414 do j=istart(i,iint),iend(i,iint)
416 if (itypj.eq.ntyp1) cycle
420 C Change 12/1/95 to calculate four-body interactions
421 rij=xj*xj+yj*yj+zj*zj
423 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
424 eps0ij=eps(itypi,itypj)
429 ij=icant(itypi,itypj)
431 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
432 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
435 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
436 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
437 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
438 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
439 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
440 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
441 if (bb.gt.0.0d0) then
448 C Calculate the components of the gradient in DC and X
450 fac=-rrij*(e1+evdwij)
455 gvdwx(k,i)=gvdwx(k,i)-gg(k)
456 gvdwx(k,j)=gvdwx(k,j)+gg(k)
460 gvdwc(l,k)=gvdwc(l,k)+gg(l)
465 C 12/1/95, revised on 5/20/97
467 C Calculate the contact function. The ith column of the array JCONT will
468 C contain the numbers of atoms that make contacts with the atom I (of numbers
469 C greater than I). The arrays FACONT and GACONT will contain the values of
470 C the contact function and its derivative.
472 C Uncomment next line, if the correlation interactions include EVDW explicitly.
473 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
474 C Uncomment next line, if the correlation interactions are contact function only
475 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
477 sigij=sigma(itypi,itypj)
478 r0ij=rs0(itypi,itypj)
480 C Check whether the SC's are not too far to make a contact.
483 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
484 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
486 if (fcont.gt.0.0D0) then
487 C If the SC-SC distance if close to sigma, apply spline.
488 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
489 cAdam & fcont1,fprimcont1)
490 cAdam fcont1=1.0d0-fcont1
491 cAdam if (fcont1.gt.0.0d0) then
492 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
493 cAdam fcont=fcont*fcont1
495 C Uncomment following 4 lines to have the geometric average of the epsilon0's
496 cga eps0ij=1.0d0/dsqrt(eps0ij)
498 cga gg(k)=gg(k)*eps0ij
500 cga eps0ij=-evdwij*eps0ij
501 C Uncomment for AL's type of SC correlation interactions.
503 num_conti=num_conti+1
505 facont(num_conti,i)=fcont*eps0ij
506 fprimcont=eps0ij*fprimcont/rij
508 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
509 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
510 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
511 C Uncomment following 3 lines for Skolnick's type of SC correlation.
512 gacont(1,num_conti,i)=-fprimcont*xj
513 gacont(2,num_conti,i)=-fprimcont*yj
514 gacont(3,num_conti,i)=-fprimcont*zj
515 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
516 cd write (iout,'(2i3,3f10.5)')
517 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
523 num_cont(i)=num_conti
528 gvdwc(j,i)=expon*gvdwc(j,i)
529 gvdwx(j,i)=expon*gvdwx(j,i)
533 C******************************************************************************
537 C To save time, the factor of EXPON has been extracted from ALL components
538 C of GVDWC and GRADX. Remember to multiply them by this factor before further
541 C******************************************************************************
544 C-----------------------------------------------------------------------------
545 subroutine eljk(evdw,evdw_t)
547 C This subroutine calculates the interaction energy of nonbonded side chains
548 C assuming the LJK potential of interaction.
550 implicit real*8 (a-h,o-z)
552 include 'DIMENSIONS.ZSCOPT'
553 include "DIMENSIONS.COMPAR"
556 include 'COMMON.LOCAL'
557 include 'COMMON.CHAIN'
558 include 'COMMON.DERIV'
559 include 'COMMON.INTERACT'
560 include 'COMMON.ENEPS'
561 include 'COMMON.IOUNITS'
562 include 'COMMON.NAMES'
567 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
570 eneps_temp(j,i)=0.0d0
577 if (itypi.eq.ntyp1) cycle
578 itypi1=iabs(itype(i+1))
583 C Calculate SC interaction energy.
586 do j=istart(i,iint),iend(i,iint)
588 if (itypj.eq.ntyp1) cycle
592 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
594 e_augm=augm(itypi,itypj)*fac_augm
597 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
598 fac=r_shift_inv**expon
602 ij=icant(itypi,itypj)
603 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
604 & /dabs(eps(itypi,itypj))
605 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
606 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
607 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
608 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
609 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
610 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
611 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
612 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
613 if (bb.gt.0.0d0) then
620 C Calculate the components of the gradient in DC and X
622 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
627 gvdwx(k,i)=gvdwx(k,i)-gg(k)
628 gvdwx(k,j)=gvdwx(k,j)+gg(k)
632 gvdwc(l,k)=gvdwc(l,k)+gg(l)
642 gvdwc(j,i)=expon*gvdwc(j,i)
643 gvdwx(j,i)=expon*gvdwx(j,i)
649 C-----------------------------------------------------------------------------
650 subroutine ebp(evdw,evdw_t)
652 C This subroutine calculates the interaction energy of nonbonded side chains
653 C assuming the Berne-Pechukas potential of interaction.
655 implicit real*8 (a-h,o-z)
657 include 'DIMENSIONS.ZSCOPT'
658 include "DIMENSIONS.COMPAR"
661 include 'COMMON.LOCAL'
662 include 'COMMON.CHAIN'
663 include 'COMMON.DERIV'
664 include 'COMMON.NAMES'
665 include 'COMMON.INTERACT'
666 include 'COMMON.ENEPS'
667 include 'COMMON.IOUNITS'
668 include 'COMMON.CALC'
670 c double precision rrsave(maxdim)
676 eneps_temp(j,i)=0.0d0
681 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
682 c if (icall.eq.0) then
690 if (itypi.eq.ntyp1) cycle
691 itypi1=iabs(itype(i+1))
695 dxi=dc_norm(1,nres+i)
696 dyi=dc_norm(2,nres+i)
697 dzi=dc_norm(3,nres+i)
698 dsci_inv=vbld_inv(i+nres)
700 C Calculate SC interaction energy.
703 do j=istart(i,iint),iend(i,iint)
706 if (itypj.eq.ntyp1) cycle
707 dscj_inv=vbld_inv(j+nres)
708 chi1=chi(itypi,itypj)
709 chi2=chi(itypj,itypi)
716 alf12=0.5D0*(alf1+alf2)
717 C For diagnostics only!!!
730 dxj=dc_norm(1,nres+j)
731 dyj=dc_norm(2,nres+j)
732 dzj=dc_norm(3,nres+j)
733 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
734 cd if (icall.eq.0) then
740 C Calculate the angle-dependent terms of energy & contributions to derivatives.
742 C Calculate whole angle-dependent part of epsilon and contributions
744 fac=(rrij*sigsq)**expon2
747 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
748 eps2der=evdwij*eps3rt
749 eps3der=evdwij*eps2rt
750 evdwij=evdwij*eps2rt*eps3rt
751 ij=icant(itypi,itypj)
752 aux=eps1*eps2rt**2*eps3rt**2
753 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
754 & /dabs(eps(itypi,itypj))
755 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
756 if (bb.gt.0.0d0) then
763 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
765 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
766 & restyp(itypi),i,restyp(itypj),j,
767 & epsi,sigm,chi1,chi2,chip1,chip2,
768 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
769 & om1,om2,om12,1.0D0/dsqrt(rrij),
772 C Calculate gradient components.
773 e1=e1*eps1*eps2rt**2*eps3rt**2
774 fac=-expon*(e1+evdwij)
777 C Calculate radial part of the gradient
781 C Calculate the angular part of the gradient and sum add the contributions
782 C to the appropriate components of the Cartesian gradient.
791 C-----------------------------------------------------------------------------
792 subroutine egb(evdw,evdw_t)
794 C This subroutine calculates the interaction energy of nonbonded side chains
795 C assuming the Gay-Berne potential of interaction.
797 implicit real*8 (a-h,o-z)
799 include 'DIMENSIONS.ZSCOPT'
800 include "DIMENSIONS.COMPAR"
803 include 'COMMON.LOCAL'
804 include 'COMMON.CHAIN'
805 include 'COMMON.DERIV'
806 include 'COMMON.NAMES'
807 include 'COMMON.INTERACT'
808 include 'COMMON.ENEPS'
809 include 'COMMON.IOUNITS'
810 include 'COMMON.CALC'
811 include 'COMMON.SBRIDGE'
818 eneps_temp(j,i)=0.0d0
821 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
825 c if (icall.gt.0) lprn=.true.
829 if (itypi.eq.ntyp1) cycle
830 itypi1=iabs(itype(i+1))
834 C returning the ith atom to box
836 if (xi.lt.0) xi=xi+boxxsize
838 if (yi.lt.0) yi=yi+boxysize
840 if (zi.lt.0) zi=zi+boxzsize
841 if ((zi.gt.bordlipbot)
842 &.and.(zi.lt.bordliptop)) then
843 C the energy transfer exist
844 if (zi.lt.buflipbot) then
845 C what fraction I am in
847 & ((zi-bordlipbot)/lipbufthick)
848 C lipbufthick is thickenes of lipid buffore
849 sslipi=sscalelip(fracinbuf)
850 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
851 elseif (zi.gt.bufliptop) then
852 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
853 sslipi=sscalelip(fracinbuf)
854 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
864 dxi=dc_norm(1,nres+i)
865 dyi=dc_norm(2,nres+i)
866 dzi=dc_norm(3,nres+i)
867 dsci_inv=vbld_inv(i+nres)
869 C Calculate SC interaction energy.
872 do j=istart(i,iint),iend(i,iint)
873 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
874 call dyn_ssbond_ene(i,j,evdwij)
876 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
877 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
878 C triple bond artifac removal
879 do k=j+1,iend(i,iint)
880 C search over all next residues
881 if (dyn_ss_mask(k)) then
882 C check if they are cysteins
883 C write(iout,*) 'k=',k
884 call triple_ssbond_ene(i,j,k,evdwij)
885 C call the energy function that removes the artifical triple disulfide
886 C bond the soubroutine is located in ssMD.F
888 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
889 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
895 if (itypj.eq.ntyp1) cycle
896 dscj_inv=vbld_inv(j+nres)
897 sig0ij=sigma(itypi,itypj)
898 chi1=chi(itypi,itypj)
899 chi2=chi(itypj,itypi)
906 alf12=0.5D0*(alf1+alf2)
907 C For diagnostics only!!!
920 C returning jth atom to box
922 if (xj.lt.0) xj=xj+boxxsize
924 if (yj.lt.0) yj=yj+boxysize
926 if (zj.lt.0) zj=zj+boxzsize
927 if ((zj.gt.bordlipbot)
928 &.and.(zj.lt.bordliptop)) then
929 C the energy transfer exist
930 if (zj.lt.buflipbot) then
931 C what fraction I am in
933 & ((zj-bordlipbot)/lipbufthick)
934 C lipbufthick is thickenes of lipid buffore
935 sslipj=sscalelip(fracinbuf)
936 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
937 elseif (zj.gt.bufliptop) then
938 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
939 sslipj=sscalelip(fracinbuf)
940 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
949 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
950 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
951 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
952 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
953 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
954 C checking the distance
955 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
960 C finding the closest
964 xj=xj_safe+xshift*boxxsize
965 yj=yj_safe+yshift*boxysize
966 zj=zj_safe+zshift*boxzsize
967 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
968 if(dist_temp.lt.dist_init) then
978 if (subchap.eq.1) then
988 dxj=dc_norm(1,nres+j)
989 dyj=dc_norm(2,nres+j)
990 dzj=dc_norm(3,nres+j)
991 c write (iout,*) i,j,xj,yj,zj
992 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
994 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
995 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
996 if (sss.le.0.0) cycle
997 C Calculate angle-dependent terms of energy and contributions to their
1002 sig=sig0ij*dsqrt(sigsq)
1003 rij_shift=1.0D0/rij-sig+sig0ij
1004 C I hate to put IF's in the loops, but here don't have another choice!!!!
1005 if (rij_shift.le.0.0D0) then
1010 c---------------------------------------------------------------
1011 rij_shift=1.0D0/rij_shift
1012 fac=rij_shift**expon
1015 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1016 eps2der=evdwij*eps3rt
1017 eps3der=evdwij*eps2rt
1018 evdwij=evdwij*eps2rt*eps3rt
1020 evdw=evdw+evdwij*sss
1022 evdw_t=evdw_t+evdwij*sss
1024 ij=icant(itypi,itypj)
1025 aux=eps1*eps2rt**2*eps3rt**2
1026 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1027 & /dabs(eps(itypi,itypj))
1028 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1029 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1030 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1031 c & aux*e2/eps(itypi,itypj)
1033 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1036 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1037 & restyp(itypi),i,restyp(itypj),j,
1038 & epsi,sigm,chi1,chi2,chip1,chip2,
1039 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1040 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1042 write (iout,*) "partial sum", evdw, evdw_t
1046 C Calculate gradient components.
1047 e1=e1*eps1*eps2rt**2*eps3rt**2
1048 fac=-expon*(e1+evdwij)*rij_shift
1051 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1052 C Calculate the radial part of the gradient
1056 C Calculate angular part of the gradient.
1059 C write(iout,*) "partial sum", evdw, evdw_t
1066 C-----------------------------------------------------------------------------
1067 subroutine egbv(evdw,evdw_t)
1069 C This subroutine calculates the interaction energy of nonbonded side chains
1070 C assuming the Gay-Berne-Vorobjev potential of interaction.
1072 implicit real*8 (a-h,o-z)
1073 include 'DIMENSIONS'
1074 include 'DIMENSIONS.ZSCOPT'
1075 include "DIMENSIONS.COMPAR"
1076 include 'COMMON.GEO'
1077 include 'COMMON.VAR'
1078 include 'COMMON.LOCAL'
1079 include 'COMMON.CHAIN'
1080 include 'COMMON.DERIV'
1081 include 'COMMON.NAMES'
1082 include 'COMMON.INTERACT'
1083 include 'COMMON.ENEPS'
1084 include 'COMMON.IOUNITS'
1085 include 'COMMON.CALC'
1086 common /srutu/ icall
1092 eneps_temp(j,i)=0.0d0
1097 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1100 c if (icall.gt.0) lprn=.true.
1102 do i=iatsc_s,iatsc_e
1103 itypi=iabs(itype(i))
1104 if (itypi.eq.ntyp1) cycle
1105 itypi1=iabs(itype(i+1))
1109 dxi=dc_norm(1,nres+i)
1110 dyi=dc_norm(2,nres+i)
1111 dzi=dc_norm(3,nres+i)
1112 dsci_inv=vbld_inv(i+nres)
1114 C Calculate SC interaction energy.
1116 do iint=1,nint_gr(i)
1117 do j=istart(i,iint),iend(i,iint)
1119 itypj=iabs(itype(j))
1120 if (itypj.eq.ntyp1) cycle
1121 dscj_inv=vbld_inv(j+nres)
1122 sig0ij=sigma(itypi,itypj)
1123 r0ij=r0(itypi,itypj)
1124 chi1=chi(itypi,itypj)
1125 chi2=chi(itypj,itypi)
1132 alf12=0.5D0*(alf1+alf2)
1133 C For diagnostics only!!!
1146 dxj=dc_norm(1,nres+j)
1147 dyj=dc_norm(2,nres+j)
1148 dzj=dc_norm(3,nres+j)
1149 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1151 C Calculate angle-dependent terms of energy and contributions to their
1155 sig=sig0ij*dsqrt(sigsq)
1156 rij_shift=1.0D0/rij-sig+r0ij
1157 C I hate to put IF's in the loops, but here don't have another choice!!!!
1158 if (rij_shift.le.0.0D0) then
1163 c---------------------------------------------------------------
1164 rij_shift=1.0D0/rij_shift
1165 fac=rij_shift**expon
1168 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1169 eps2der=evdwij*eps3rt
1170 eps3der=evdwij*eps2rt
1171 fac_augm=rrij**expon
1172 e_augm=augm(itypi,itypj)*fac_augm
1173 evdwij=evdwij*eps2rt*eps3rt
1174 if (bb.gt.0.0d0) then
1175 evdw=evdw+evdwij+e_augm
1177 evdw_t=evdw_t+evdwij+e_augm
1179 ij=icant(itypi,itypj)
1180 aux=eps1*eps2rt**2*eps3rt**2
1181 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1182 & /dabs(eps(itypi,itypj))
1183 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1184 c eneps_temp(ij)=eneps_temp(ij)
1185 c & +(evdwij+e_augm)/eps(itypi,itypj)
1187 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1188 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1189 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1190 c & restyp(itypi),i,restyp(itypj),j,
1191 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1192 c & chi1,chi2,chip1,chip2,
1193 c & eps1,eps2rt**2,eps3rt**2,
1194 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1198 C Calculate gradient components.
1199 e1=e1*eps1*eps2rt**2*eps3rt**2
1200 fac=-expon*(e1+evdwij)*rij_shift
1202 fac=rij*fac-2*expon*rrij*e_augm
1203 C Calculate the radial part of the gradient
1207 C Calculate angular part of the gradient.
1215 C-----------------------------------------------------------------------------
1216 subroutine sc_angular
1217 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1218 C om12. Called by ebp, egb, and egbv.
1220 include 'COMMON.CALC'
1224 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1225 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1226 om12=dxi*dxj+dyi*dyj+dzi*dzj
1228 C Calculate eps1(om12) and its derivative in om12
1229 faceps1=1.0D0-om12*chiom12
1230 faceps1_inv=1.0D0/faceps1
1231 eps1=dsqrt(faceps1_inv)
1232 C Following variable is eps1*deps1/dom12
1233 eps1_om12=faceps1_inv*chiom12
1234 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1239 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1240 sigsq=1.0D0-facsig*faceps1_inv
1241 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1242 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1243 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1244 C Calculate eps2 and its derivatives in om1, om2, and om12.
1247 chipom12=chip12*om12
1248 facp=1.0D0-om12*chipom12
1250 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1251 C Following variable is the square root of eps2
1252 eps2rt=1.0D0-facp1*facp_inv
1253 C Following three variables are the derivatives of the square root of eps
1254 C in om1, om2, and om12.
1255 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1256 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1257 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1258 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1259 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1260 C Calculate whole angle-dependent part of epsilon and contributions
1261 C to its derivatives
1264 C----------------------------------------------------------------------------
1266 implicit real*8 (a-h,o-z)
1267 include 'DIMENSIONS'
1268 include 'DIMENSIONS.ZSCOPT'
1269 include 'COMMON.CHAIN'
1270 include 'COMMON.DERIV'
1271 include 'COMMON.CALC'
1272 double precision dcosom1(3),dcosom2(3)
1273 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1274 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1275 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1276 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1278 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1279 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1282 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1285 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1286 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1287 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1288 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1289 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1290 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1293 C Calculate the components of the gradient in DC and X
1297 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1302 c------------------------------------------------------------------------------
1303 subroutine vec_and_deriv
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'DIMENSIONS.ZSCOPT'
1307 include 'COMMON.IOUNITS'
1308 include 'COMMON.GEO'
1309 include 'COMMON.VAR'
1310 include 'COMMON.LOCAL'
1311 include 'COMMON.CHAIN'
1312 include 'COMMON.VECTORS'
1313 include 'COMMON.DERIV'
1314 include 'COMMON.INTERACT'
1315 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1316 C Compute the local reference systems. For reference system (i), the
1317 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1318 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1320 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1321 if (i.eq.nres-1) then
1322 C Case of the last full residue
1323 C Compute the Z-axis
1324 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1325 costh=dcos(pi-theta(nres))
1326 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1331 C Compute the derivatives of uz
1333 uzder(2,1,1)=-dc_norm(3,i-1)
1334 uzder(3,1,1)= dc_norm(2,i-1)
1335 uzder(1,2,1)= dc_norm(3,i-1)
1337 uzder(3,2,1)=-dc_norm(1,i-1)
1338 uzder(1,3,1)=-dc_norm(2,i-1)
1339 uzder(2,3,1)= dc_norm(1,i-1)
1342 uzder(2,1,2)= dc_norm(3,i)
1343 uzder(3,1,2)=-dc_norm(2,i)
1344 uzder(1,2,2)=-dc_norm(3,i)
1346 uzder(3,2,2)= dc_norm(1,i)
1347 uzder(1,3,2)= dc_norm(2,i)
1348 uzder(2,3,2)=-dc_norm(1,i)
1351 C Compute the Y-axis
1354 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1357 C Compute the derivatives of uy
1360 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1361 & -dc_norm(k,i)*dc_norm(j,i-1)
1362 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1364 uyder(j,j,1)=uyder(j,j,1)-costh
1365 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1370 uygrad(l,k,j,i)=uyder(l,k,j)
1371 uzgrad(l,k,j,i)=uzder(l,k,j)
1375 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1376 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1377 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1378 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1382 C Compute the Z-axis
1383 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1384 costh=dcos(pi-theta(i+2))
1385 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1390 C Compute the derivatives of uz
1392 uzder(2,1,1)=-dc_norm(3,i+1)
1393 uzder(3,1,1)= dc_norm(2,i+1)
1394 uzder(1,2,1)= dc_norm(3,i+1)
1396 uzder(3,2,1)=-dc_norm(1,i+1)
1397 uzder(1,3,1)=-dc_norm(2,i+1)
1398 uzder(2,3,1)= dc_norm(1,i+1)
1401 uzder(2,1,2)= dc_norm(3,i)
1402 uzder(3,1,2)=-dc_norm(2,i)
1403 uzder(1,2,2)=-dc_norm(3,i)
1405 uzder(3,2,2)= dc_norm(1,i)
1406 uzder(1,3,2)= dc_norm(2,i)
1407 uzder(2,3,2)=-dc_norm(1,i)
1410 C Compute the Y-axis
1413 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1416 C Compute the derivatives of uy
1419 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1420 & -dc_norm(k,i)*dc_norm(j,i+1)
1421 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1423 uyder(j,j,1)=uyder(j,j,1)-costh
1424 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1429 uygrad(l,k,j,i)=uyder(l,k,j)
1430 uzgrad(l,k,j,i)=uzder(l,k,j)
1434 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1435 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1436 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1437 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1443 vbld_inv_temp(1)=vbld_inv(i+1)
1444 if (i.lt.nres-1) then
1445 vbld_inv_temp(2)=vbld_inv(i+2)
1447 vbld_inv_temp(2)=vbld_inv(i)
1452 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1453 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1461 C-----------------------------------------------------------------------------
1462 subroutine vec_and_deriv_test
1463 implicit real*8 (a-h,o-z)
1464 include 'DIMENSIONS'
1465 include 'DIMENSIONS.ZSCOPT'
1466 include 'COMMON.IOUNITS'
1467 include 'COMMON.GEO'
1468 include 'COMMON.VAR'
1469 include 'COMMON.LOCAL'
1470 include 'COMMON.CHAIN'
1471 include 'COMMON.VECTORS'
1472 dimension uyder(3,3,2),uzder(3,3,2)
1473 C Compute the local reference systems. For reference system (i), the
1474 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1475 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1477 if (i.eq.nres-1) then
1478 C Case of the last full residue
1479 C Compute the Z-axis
1480 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1481 costh=dcos(pi-theta(nres))
1482 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1483 c write (iout,*) 'fac',fac,
1484 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1485 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1489 C Compute the derivatives of uz
1491 uzder(2,1,1)=-dc_norm(3,i-1)
1492 uzder(3,1,1)= dc_norm(2,i-1)
1493 uzder(1,2,1)= dc_norm(3,i-1)
1495 uzder(3,2,1)=-dc_norm(1,i-1)
1496 uzder(1,3,1)=-dc_norm(2,i-1)
1497 uzder(2,3,1)= dc_norm(1,i-1)
1500 uzder(2,1,2)= dc_norm(3,i)
1501 uzder(3,1,2)=-dc_norm(2,i)
1502 uzder(1,2,2)=-dc_norm(3,i)
1504 uzder(3,2,2)= dc_norm(1,i)
1505 uzder(1,3,2)= dc_norm(2,i)
1506 uzder(2,3,2)=-dc_norm(1,i)
1508 C Compute the Y-axis
1510 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1513 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1514 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1515 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1517 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1520 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1521 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1524 c write (iout,*) 'facy',facy,
1525 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1526 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1528 uy(k,i)=facy*uy(k,i)
1530 C Compute the derivatives of uy
1533 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1534 & -dc_norm(k,i)*dc_norm(j,i-1)
1535 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1537 c uyder(j,j,1)=uyder(j,j,1)-costh
1538 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1539 uyder(j,j,1)=uyder(j,j,1)
1540 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1541 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1547 uygrad(l,k,j,i)=uyder(l,k,j)
1548 uzgrad(l,k,j,i)=uzder(l,k,j)
1552 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1553 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1554 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1555 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1558 C Compute the Z-axis
1559 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1560 costh=dcos(pi-theta(i+2))
1561 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1562 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1566 C Compute the derivatives of uz
1568 uzder(2,1,1)=-dc_norm(3,i+1)
1569 uzder(3,1,1)= dc_norm(2,i+1)
1570 uzder(1,2,1)= dc_norm(3,i+1)
1572 uzder(3,2,1)=-dc_norm(1,i+1)
1573 uzder(1,3,1)=-dc_norm(2,i+1)
1574 uzder(2,3,1)= dc_norm(1,i+1)
1577 uzder(2,1,2)= dc_norm(3,i)
1578 uzder(3,1,2)=-dc_norm(2,i)
1579 uzder(1,2,2)=-dc_norm(3,i)
1581 uzder(3,2,2)= dc_norm(1,i)
1582 uzder(1,3,2)= dc_norm(2,i)
1583 uzder(2,3,2)=-dc_norm(1,i)
1585 C Compute the Y-axis
1587 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1588 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1589 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1591 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1594 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1595 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1598 c write (iout,*) 'facy',facy,
1599 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1600 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1602 uy(k,i)=facy*uy(k,i)
1604 C Compute the derivatives of uy
1607 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1608 & -dc_norm(k,i)*dc_norm(j,i+1)
1609 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1611 c uyder(j,j,1)=uyder(j,j,1)-costh
1612 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1613 uyder(j,j,1)=uyder(j,j,1)
1614 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1615 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1621 uygrad(l,k,j,i)=uyder(l,k,j)
1622 uzgrad(l,k,j,i)=uzder(l,k,j)
1626 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1627 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1628 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1629 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1636 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1637 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1644 C-----------------------------------------------------------------------------
1645 subroutine check_vecgrad
1646 implicit real*8 (a-h,o-z)
1647 include 'DIMENSIONS'
1648 include 'DIMENSIONS.ZSCOPT'
1649 include 'COMMON.IOUNITS'
1650 include 'COMMON.GEO'
1651 include 'COMMON.VAR'
1652 include 'COMMON.LOCAL'
1653 include 'COMMON.CHAIN'
1654 include 'COMMON.VECTORS'
1655 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1656 dimension uyt(3,maxres),uzt(3,maxres)
1657 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1658 double precision delta /1.0d-7/
1661 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1662 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1663 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1664 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1665 cd & (dc_norm(if90,i),if90=1,3)
1666 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1667 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1668 cd write(iout,'(a)')
1674 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1675 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1688 cd write (iout,*) 'i=',i
1690 erij(k)=dc_norm(k,i)
1694 dc_norm(k,i)=erij(k)
1696 dc_norm(j,i)=dc_norm(j,i)+delta
1697 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1699 c dc_norm(k,i)=dc_norm(k,i)/fac
1701 c write (iout,*) (dc_norm(k,i),k=1,3)
1702 c write (iout,*) (erij(k),k=1,3)
1705 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1706 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1707 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1708 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1710 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1711 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1712 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1715 dc_norm(k,i)=erij(k)
1718 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1719 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1720 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1721 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1722 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1723 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1724 cd write (iout,'(a)')
1729 C--------------------------------------------------------------------------
1730 subroutine set_matrices
1731 implicit real*8 (a-h,o-z)
1732 include 'DIMENSIONS'
1733 include 'DIMENSIONS.ZSCOPT'
1734 include 'COMMON.IOUNITS'
1735 include 'COMMON.GEO'
1736 include 'COMMON.VAR'
1737 include 'COMMON.LOCAL'
1738 include 'COMMON.CHAIN'
1739 include 'COMMON.DERIV'
1740 include 'COMMON.INTERACT'
1741 include 'COMMON.CONTACTS'
1742 include 'COMMON.TORSION'
1743 include 'COMMON.VECTORS'
1744 include 'COMMON.FFIELD'
1745 double precision auxvec(2),auxmat(2,2)
1747 C Compute the virtual-bond-torsional-angle dependent quantities needed
1748 C to calculate the el-loc multibody terms of various order.
1751 if (i .lt. nres+1) then
1788 if (i .gt. 3 .and. i .lt. nres+1) then
1789 obrot_der(1,i-2)=-sin1
1790 obrot_der(2,i-2)= cos1
1791 Ugder(1,1,i-2)= sin1
1792 Ugder(1,2,i-2)=-cos1
1793 Ugder(2,1,i-2)=-cos1
1794 Ugder(2,2,i-2)=-sin1
1797 obrot2_der(1,i-2)=-dwasin2
1798 obrot2_der(2,i-2)= dwacos2
1799 Ug2der(1,1,i-2)= dwasin2
1800 Ug2der(1,2,i-2)=-dwacos2
1801 Ug2der(2,1,i-2)=-dwacos2
1802 Ug2der(2,2,i-2)=-dwasin2
1804 obrot_der(1,i-2)=0.0d0
1805 obrot_der(2,i-2)=0.0d0
1806 Ugder(1,1,i-2)=0.0d0
1807 Ugder(1,2,i-2)=0.0d0
1808 Ugder(2,1,i-2)=0.0d0
1809 Ugder(2,2,i-2)=0.0d0
1810 obrot2_der(1,i-2)=0.0d0
1811 obrot2_der(2,i-2)=0.0d0
1812 Ug2der(1,1,i-2)=0.0d0
1813 Ug2der(1,2,i-2)=0.0d0
1814 Ug2der(2,1,i-2)=0.0d0
1815 Ug2der(2,2,i-2)=0.0d0
1817 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1818 if (itype(i-2).le.ntyp) then
1819 iti = itortyp(itype(i-2))
1826 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1827 if (itype(i-1).le.ntyp) then
1828 iti1 = itortyp(itype(i-1))
1835 cd write (iout,*) '*******i',i,' iti1',iti
1836 cd write (iout,*) 'b1',b1(:,iti)
1837 cd write (iout,*) 'b2',b2(:,iti)
1838 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1839 c print *,"itilde1 i iti iti1",i,iti,iti1
1840 if (i .gt. iatel_s+2) then
1841 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1842 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1843 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1844 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1845 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1846 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1847 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1857 DtUg2(l,k,i-2)=0.0d0
1861 c print *,"itilde2 i iti iti1",i,iti,iti1
1862 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1863 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1864 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1865 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1866 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1867 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1868 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1869 c print *,"itilde3 i iti iti1",i,iti,iti1
1871 muder(k,i-2)=Ub2der(k,i-2)
1873 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1874 if (itype(i-1).le.ntyp) then
1875 iti1 = itortyp(itype(i-1))
1883 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1885 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
1887 C Vectors and matrices dependent on a single virtual-bond dihedral.
1888 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1889 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1890 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1891 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1892 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1893 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1894 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1895 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1896 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1897 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1898 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1900 C Matrices dependent on two consecutive virtual-bond dihedrals.
1901 C The order of matrices is from left to right.
1903 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1904 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1905 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1906 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1907 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1908 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1909 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1910 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1913 cd iti = itortyp(itype(i))
1916 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1917 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1922 C--------------------------------------------------------------------------
1923 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1925 C This subroutine calculates the average interaction energy and its gradient
1926 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1927 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1928 C The potential depends both on the distance of peptide-group centers and on
1929 C the orientation of the CA-CA virtual bonds.
1931 implicit real*8 (a-h,o-z)
1932 include 'DIMENSIONS'
1933 include 'DIMENSIONS.ZSCOPT'
1934 include 'COMMON.CONTROL'
1935 include 'COMMON.IOUNITS'
1936 include 'COMMON.GEO'
1937 include 'COMMON.VAR'
1938 include 'COMMON.LOCAL'
1939 include 'COMMON.CHAIN'
1940 include 'COMMON.DERIV'
1941 include 'COMMON.INTERACT'
1942 include 'COMMON.CONTACTS'
1943 include 'COMMON.TORSION'
1944 include 'COMMON.VECTORS'
1945 include 'COMMON.FFIELD'
1946 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1947 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1948 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1949 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1950 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1951 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1952 double precision scal_el /0.5d0/
1954 C 13-go grudnia roku pamietnego...
1955 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1956 & 0.0d0,1.0d0,0.0d0,
1957 & 0.0d0,0.0d0,1.0d0/
1958 cd write(iout,*) 'In EELEC'
1960 cd write(iout,*) 'Type',i
1961 cd write(iout,*) 'B1',B1(:,i)
1962 cd write(iout,*) 'B2',B2(:,i)
1963 cd write(iout,*) 'CC',CC(:,:,i)
1964 cd write(iout,*) 'DD',DD(:,:,i)
1965 cd write(iout,*) 'EE',EE(:,:,i)
1967 cd call check_vecgrad
1969 if (icheckgrad.eq.1) then
1971 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1973 dc_norm(k,i)=dc(k,i)*fac
1975 c write (iout,*) 'i',i,' fac',fac
1978 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1979 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1980 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1981 cd if (wel_loc.gt.0.0d0) then
1982 if (icheckgrad.eq.1) then
1983 call vec_and_deriv_test
1990 cd write (iout,*) 'i=',i
1992 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1995 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1996 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2009 C print '(a)','Enter EELEC'
2010 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2012 gel_loc_loc(i)=0.0d0
2015 do i=iatel_s,iatel_e
2017 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2018 & .or. itype(i+2).eq.ntyp1) cycle
2020 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2021 & .or. itype(i+2).eq.ntyp1
2022 & .or. itype(i-1).eq.ntyp1
2025 if (itel(i).eq.0) goto 1215
2029 dx_normi=dc_norm(1,i)
2030 dy_normi=dc_norm(2,i)
2031 dz_normi=dc_norm(3,i)
2032 xmedi=c(1,i)+0.5d0*dxi
2033 ymedi=c(2,i)+0.5d0*dyi
2034 zmedi=c(3,i)+0.5d0*dzi
2035 xmedi=mod(xmedi,boxxsize)
2036 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2037 ymedi=mod(ymedi,boxysize)
2038 if (ymedi.lt.0) ymedi=ymedi+boxysize
2039 zmedi=mod(zmedi,boxzsize)
2040 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2042 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2043 do j=ielstart(i),ielend(i)
2045 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2046 & .or.itype(j+2).eq.ntyp1
2049 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2050 & .or.itype(j+2).eq.ntyp1
2051 & .or.itype(j-1).eq.ntyp1
2056 if (itel(j).eq.0) goto 1216
2060 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2061 aaa=app(iteli,itelj)
2062 bbb=bpp(iteli,itelj)
2063 C Diagnostics only!!!
2069 ael6i=ael6(iteli,itelj)
2070 ael3i=ael3(iteli,itelj)
2074 dx_normj=dc_norm(1,j)
2075 dy_normj=dc_norm(2,j)
2076 dz_normj=dc_norm(3,j)
2081 if (xj.lt.0) xj=xj+boxxsize
2083 if (yj.lt.0) yj=yj+boxysize
2085 if (zj.lt.0) zj=zj+boxzsize
2086 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2094 xj=xj_safe+xshift*boxxsize
2095 yj=yj_safe+yshift*boxysize
2096 zj=zj_safe+zshift*boxzsize
2097 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2098 if(dist_temp.lt.dist_init) then
2108 if (isubchap.eq.1) then
2117 rij=xj*xj+yj*yj+zj*zj
2118 sss=sscale(sqrt(rij))
2119 sssgrad=sscagrad(sqrt(rij))
2125 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2126 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2127 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2128 fac=cosa-3.0D0*cosb*cosg
2130 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2131 if (j.eq.i+2) ev1=scal_el*ev1
2136 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2139 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2140 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2141 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2143 evdw1=evdw1+evdwij*sss
2144 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2145 c &'evdw1',i,j,evdwij
2146 c &,iteli,itelj,aaa,evdw1
2148 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2149 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2150 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2151 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2152 c & xmedi,ymedi,zmedi,xj,yj,zj
2154 C Calculate contributions to the Cartesian gradient.
2157 facvdw=-6*rrmij*(ev1+evdwij)*sss
2158 facel=-3*rrmij*(el1+eesij)
2165 * Radial derivatives. First process both termini of the fragment (i,j)
2172 gelc(k,i)=gelc(k,i)+ghalf
2173 gelc(k,j)=gelc(k,j)+ghalf
2176 * Loop over residues i+1 thru j-1.
2180 gelc(l,k)=gelc(l,k)+ggg(l)
2186 if (sss.gt.0.0) then
2187 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2188 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2189 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2197 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2198 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2201 * Loop over residues i+1 thru j-1.
2205 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2209 facvdw=(ev1+evdwij)*sss
2212 fac=-3*rrmij*(facvdw+facvdw+facel)
2218 * Radial derivatives. First process both termini of the fragment (i,j)
2225 gelc(k,i)=gelc(k,i)+ghalf
2226 gelc(k,j)=gelc(k,j)+ghalf
2229 * Loop over residues i+1 thru j-1.
2233 gelc(l,k)=gelc(l,k)+ggg(l)
2240 ecosa=2.0D0*fac3*fac1+fac4
2243 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2244 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2246 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2247 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2249 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2250 cd & (dcosg(k),k=1,3)
2252 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2256 gelc(k,i)=gelc(k,i)+ghalf
2257 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2258 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2259 gelc(k,j)=gelc(k,j)+ghalf
2260 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2261 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2265 gelc(l,k)=gelc(l,k)+ggg(l)
2270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2275 C energy of a peptide unit is assumed in the form of a second-order
2276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2278 C are computed for EVERY pair of non-contiguous peptide groups.
2280 if (j.lt.nres-1) then
2291 muij(kkk)=mu(k,i)*mu(l,j)
2294 cd write (iout,*) 'EELEC: i',i,' j',j
2295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2296 cd write(iout,*) 'muij',muij
2297 ury=scalar(uy(1,i),erij)
2298 urz=scalar(uz(1,i),erij)
2299 vry=scalar(uy(1,j),erij)
2300 vrz=scalar(uz(1,j),erij)
2301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2305 C For diagnostics only
2310 fac=dsqrt(-ael6i)*r3ij
2311 cd write (2,*) 'fac=',fac
2312 C For diagnostics only
2318 cd write (iout,'(4i5,4f10.5)')
2319 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2320 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2321 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2322 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2323 cd write (iout,'(4f10.5)')
2324 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2325 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2326 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2327 cd write (iout,'(2i3,9f10.5/)') i,j,
2328 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2330 C Derivatives of the elements of A in virtual-bond vectors
2331 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2338 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2339 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2340 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2341 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2342 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2343 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2344 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2345 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2346 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2347 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2348 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2349 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2359 C Compute radial contributions to the gradient
2381 C Add the contributions coming from er
2384 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2385 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2386 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2387 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2390 C Derivatives in DC(i)
2391 ghalf1=0.5d0*agg(k,1)
2392 ghalf2=0.5d0*agg(k,2)
2393 ghalf3=0.5d0*agg(k,3)
2394 ghalf4=0.5d0*agg(k,4)
2395 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2396 & -3.0d0*uryg(k,2)*vry)+ghalf1
2397 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2398 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2399 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2400 & -3.0d0*urzg(k,2)*vry)+ghalf3
2401 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2402 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2403 C Derivatives in DC(i+1)
2404 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2405 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2406 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2407 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2408 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2409 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2410 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2411 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2412 C Derivatives in DC(j)
2413 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2414 & -3.0d0*vryg(k,2)*ury)+ghalf1
2415 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2416 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2417 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2418 & -3.0d0*vryg(k,2)*urz)+ghalf3
2419 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2420 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2421 C Derivatives in DC(j+1) or DC(nres-1)
2422 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2423 & -3.0d0*vryg(k,3)*ury)
2424 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2425 & -3.0d0*vrzg(k,3)*ury)
2426 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2427 & -3.0d0*vryg(k,3)*urz)
2428 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2429 & -3.0d0*vrzg(k,3)*urz)
2434 C Derivatives in DC(i+1)
2435 cd aggi1(k,1)=agg(k,1)
2436 cd aggi1(k,2)=agg(k,2)
2437 cd aggi1(k,3)=agg(k,3)
2438 cd aggi1(k,4)=agg(k,4)
2439 C Derivatives in DC(j)
2444 C Derivatives in DC(j+1)
2449 if (j.eq.nres-1 .and. i.lt.j-2) then
2451 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2452 cd aggj1(k,l)=agg(k,l)
2458 C Check the loc-el terms by numerical integration
2468 aggi(k,l)=-aggi(k,l)
2469 aggi1(k,l)=-aggi1(k,l)
2470 aggj(k,l)=-aggj(k,l)
2471 aggj1(k,l)=-aggj1(k,l)
2474 if (j.lt.nres-1) then
2480 aggi(k,l)=-aggi(k,l)
2481 aggi1(k,l)=-aggi1(k,l)
2482 aggj(k,l)=-aggj(k,l)
2483 aggj1(k,l)=-aggj1(k,l)
2494 aggi(k,l)=-aggi(k,l)
2495 aggi1(k,l)=-aggi1(k,l)
2496 aggj(k,l)=-aggj(k,l)
2497 aggj1(k,l)=-aggj1(k,l)
2503 IF (wel_loc.gt.0.0d0) THEN
2504 C Contribution to the local-electrostatic energy coming from the i-j pair
2505 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2507 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2508 C write (iout,'(a6,2i5,0pf7.3)')
2509 C & 'eelloc',i,j,eel_loc_ij
2510 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2511 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2512 eel_loc=eel_loc+eel_loc_ij
2513 C Partial derivatives in virtual-bond dihedral angles gamma
2516 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2517 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2518 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2519 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2520 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2521 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2522 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2523 cd write(iout,*) 'agg ',agg
2524 cd write(iout,*) 'aggi ',aggi
2525 cd write(iout,*) 'aggi1',aggi1
2526 cd write(iout,*) 'aggj ',aggj
2527 cd write(iout,*) 'aggj1',aggj1
2529 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2531 ggg(l)=agg(l,1)*muij(1)+
2532 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2536 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2539 C Remaining derivatives of eello
2541 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2542 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2543 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2544 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2545 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2546 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2547 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2548 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2552 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2553 C Contributions from turns
2558 call eturn34(i,j,eello_turn3,eello_turn4)
2560 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2561 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2563 C Calculate the contact function. The ith column of the array JCONT will
2564 C contain the numbers of atoms that make contacts with the atom I (of numbers
2565 C greater than I). The arrays FACONT and GACONT will contain the values of
2566 C the contact function and its derivative.
2567 c r0ij=1.02D0*rpp(iteli,itelj)
2568 c r0ij=1.11D0*rpp(iteli,itelj)
2569 r0ij=2.20D0*rpp(iteli,itelj)
2570 c r0ij=1.55D0*rpp(iteli,itelj)
2571 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2572 if (fcont.gt.0.0D0) then
2573 num_conti=num_conti+1
2574 if (num_conti.gt.maxconts) then
2575 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2576 & ' will skip next contacts for this conf.'
2578 jcont_hb(num_conti,i)=j
2579 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2580 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2581 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2583 d_cont(num_conti,i)=rij
2584 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2585 C --- Electrostatic-interaction matrix ---
2586 a_chuj(1,1,num_conti,i)=a22
2587 a_chuj(1,2,num_conti,i)=a23
2588 a_chuj(2,1,num_conti,i)=a32
2589 a_chuj(2,2,num_conti,i)=a33
2590 C --- Gradient of rij
2592 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2595 c a_chuj(1,1,num_conti,i)=-0.61d0
2596 c a_chuj(1,2,num_conti,i)= 0.4d0
2597 c a_chuj(2,1,num_conti,i)= 0.65d0
2598 c a_chuj(2,2,num_conti,i)= 0.50d0
2599 c else if (i.eq.2) then
2600 c a_chuj(1,1,num_conti,i)= 0.0d0
2601 c a_chuj(1,2,num_conti,i)= 0.0d0
2602 c a_chuj(2,1,num_conti,i)= 0.0d0
2603 c a_chuj(2,2,num_conti,i)= 0.0d0
2605 C --- and its gradients
2606 cd write (iout,*) 'i',i,' j',j
2608 cd write (iout,*) 'iii 1 kkk',kkk
2609 cd write (iout,*) agg(kkk,:)
2612 cd write (iout,*) 'iii 2 kkk',kkk
2613 cd write (iout,*) aggi(kkk,:)
2616 cd write (iout,*) 'iii 3 kkk',kkk
2617 cd write (iout,*) aggi1(kkk,:)
2620 cd write (iout,*) 'iii 4 kkk',kkk
2621 cd write (iout,*) aggj(kkk,:)
2624 cd write (iout,*) 'iii 5 kkk',kkk
2625 cd write (iout,*) aggj1(kkk,:)
2632 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2633 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2634 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2635 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2636 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2638 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2644 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2645 C Calculate contact energies
2647 wij=cosa-3.0D0*cosb*cosg
2650 c fac3=dsqrt(-ael6i)/r0ij**3
2651 fac3=dsqrt(-ael6i)*r3ij
2652 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2653 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2655 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2656 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2657 C Diagnostics. Comment out or remove after debugging!
2658 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2659 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2660 c ees0m(num_conti,i)=0.0D0
2662 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2663 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2664 facont_hb(num_conti,i)=fcont
2666 C Angular derivatives of the contact function
2667 ees0pij1=fac3/ees0pij
2668 ees0mij1=fac3/ees0mij
2669 fac3p=-3.0D0*fac3*rrmij
2670 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2671 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2673 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2674 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2675 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2676 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2677 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2678 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2679 ecosap=ecosa1+ecosa2
2680 ecosbp=ecosb1+ecosb2
2681 ecosgp=ecosg1+ecosg2
2682 ecosam=ecosa1-ecosa2
2683 ecosbm=ecosb1-ecosb2
2684 ecosgm=ecosg1-ecosg2
2693 fprimcont=fprimcont/rij
2694 cd facont_hb(num_conti,i)=1.0D0
2695 C Following line is for diagnostics.
2698 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2699 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2702 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2703 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2705 gggp(1)=gggp(1)+ees0pijp*xj
2706 gggp(2)=gggp(2)+ees0pijp*yj
2707 gggp(3)=gggp(3)+ees0pijp*zj
2708 gggm(1)=gggm(1)+ees0mijp*xj
2709 gggm(2)=gggm(2)+ees0mijp*yj
2710 gggm(3)=gggm(3)+ees0mijp*zj
2711 C Derivatives due to the contact function
2712 gacont_hbr(1,num_conti,i)=fprimcont*xj
2713 gacont_hbr(2,num_conti,i)=fprimcont*yj
2714 gacont_hbr(3,num_conti,i)=fprimcont*zj
2716 ghalfp=0.5D0*gggp(k)
2717 ghalfm=0.5D0*gggm(k)
2718 gacontp_hb1(k,num_conti,i)=ghalfp
2719 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2720 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2721 gacontp_hb2(k,num_conti,i)=ghalfp
2722 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2723 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2724 gacontp_hb3(k,num_conti,i)=gggp(k)
2725 gacontm_hb1(k,num_conti,i)=ghalfm
2726 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2727 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2728 gacontm_hb2(k,num_conti,i)=ghalfm
2729 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2730 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2731 gacontm_hb3(k,num_conti,i)=gggm(k)
2734 C Diagnostics. Comment out or remove after debugging!
2736 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2737 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2738 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2739 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2740 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2741 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2744 endif ! num_conti.le.maxconts
2749 num_cont_hb(i)=num_conti
2753 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2754 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2756 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2757 ccc eel_loc=eel_loc+eello_turn3
2760 C-----------------------------------------------------------------------------
2761 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2762 C Third- and fourth-order contributions from turns
2763 implicit real*8 (a-h,o-z)
2764 include 'DIMENSIONS'
2765 include 'DIMENSIONS.ZSCOPT'
2766 include 'COMMON.IOUNITS'
2767 include 'COMMON.GEO'
2768 include 'COMMON.VAR'
2769 include 'COMMON.LOCAL'
2770 include 'COMMON.CHAIN'
2771 include 'COMMON.DERIV'
2772 include 'COMMON.INTERACT'
2773 include 'COMMON.CONTACTS'
2774 include 'COMMON.TORSION'
2775 include 'COMMON.VECTORS'
2776 include 'COMMON.FFIELD'
2778 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2779 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2780 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2781 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2782 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2783 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2787 C Third-order contributions
2794 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2795 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2796 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2797 call transpose2(auxmat(1,1),auxmat1(1,1))
2798 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2799 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2800 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2801 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2802 cd & ' eello_turn3_num',4*eello_turn3_num
2804 C Derivatives in gamma(i)
2805 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2806 call transpose2(auxmat2(1,1),pizda(1,1))
2807 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2808 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2809 C Derivatives in gamma(i+1)
2810 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2811 call transpose2(auxmat2(1,1),pizda(1,1))
2812 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2813 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2814 & +0.5d0*(pizda(1,1)+pizda(2,2))
2815 C Cartesian derivatives
2817 a_temp(1,1)=aggi(l,1)
2818 a_temp(1,2)=aggi(l,2)
2819 a_temp(2,1)=aggi(l,3)
2820 a_temp(2,2)=aggi(l,4)
2821 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2822 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2823 & +0.5d0*(pizda(1,1)+pizda(2,2))
2824 a_temp(1,1)=aggi1(l,1)
2825 a_temp(1,2)=aggi1(l,2)
2826 a_temp(2,1)=aggi1(l,3)
2827 a_temp(2,2)=aggi1(l,4)
2828 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2829 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2830 & +0.5d0*(pizda(1,1)+pizda(2,2))
2831 a_temp(1,1)=aggj(l,1)
2832 a_temp(1,2)=aggj(l,2)
2833 a_temp(2,1)=aggj(l,3)
2834 a_temp(2,2)=aggj(l,4)
2835 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2836 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2837 & +0.5d0*(pizda(1,1)+pizda(2,2))
2838 a_temp(1,1)=aggj1(l,1)
2839 a_temp(1,2)=aggj1(l,2)
2840 a_temp(2,1)=aggj1(l,3)
2841 a_temp(2,2)=aggj1(l,4)
2842 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2843 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2844 & +0.5d0*(pizda(1,1)+pizda(2,2))
2847 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2848 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2849 C changes suggested by Ana to avoid out of bounds
2850 & .or.((i+5).gt.nres)
2852 C end of changes suggested by Ana
2853 & .or. itype(i+3).eq.ntyp1
2854 & .or. itype(i+4).eq.ntyp1
2855 & .or. itype(i+5).eq.ntyp1
2856 & .or. itype(i).eq.ntyp1
2857 & .or. itype(i-1).eq.ntyp1) goto 178
2858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2860 C Fourth-order contributions
2868 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2869 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2870 iti1=itortyp(itype(i+1))
2871 iti2=itortyp(itype(i+2))
2872 iti3=itortyp(itype(i+3))
2873 call transpose2(EUg(1,1,i+1),e1t(1,1))
2874 call transpose2(Eug(1,1,i+2),e2t(1,1))
2875 call transpose2(Eug(1,1,i+3),e3t(1,1))
2876 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2877 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2878 s1=scalar2(b1(1,iti2),auxvec(1))
2879 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2880 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2881 s2=scalar2(b1(1,iti1),auxvec(1))
2882 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2883 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2885 eello_turn4=eello_turn4-(s1+s2+s3)
2886 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2887 cd & ' eello_turn4_num',8*eello_turn4_num
2888 C Derivatives in gamma(i)
2890 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2891 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2892 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2893 s1=scalar2(b1(1,iti2),auxvec(1))
2894 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2895 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2896 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2897 C Derivatives in gamma(i+1)
2898 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2899 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2900 s2=scalar2(b1(1,iti1),auxvec(1))
2901 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2902 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2903 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2904 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2905 C Derivatives in gamma(i+2)
2906 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2907 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2908 s1=scalar2(b1(1,iti2),auxvec(1))
2909 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2910 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2911 s2=scalar2(b1(1,iti1),auxvec(1))
2912 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2913 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2914 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2915 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2916 C Cartesian derivatives
2917 C Derivatives of this turn contributions in DC(i+2)
2918 if (j.lt.nres-1) then
2920 a_temp(1,1)=agg(l,1)
2921 a_temp(1,2)=agg(l,2)
2922 a_temp(2,1)=agg(l,3)
2923 a_temp(2,2)=agg(l,4)
2924 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2925 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2926 s1=scalar2(b1(1,iti2),auxvec(1))
2927 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2928 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2929 s2=scalar2(b1(1,iti1),auxvec(1))
2930 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2931 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2932 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2934 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2937 C Remaining derivatives of this turn contribution
2939 a_temp(1,1)=aggi(l,1)
2940 a_temp(1,2)=aggi(l,2)
2941 a_temp(2,1)=aggi(l,3)
2942 a_temp(2,2)=aggi(l,4)
2943 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2944 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2945 s1=scalar2(b1(1,iti2),auxvec(1))
2946 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2947 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2948 s2=scalar2(b1(1,iti1),auxvec(1))
2949 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2950 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2951 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2952 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2953 a_temp(1,1)=aggi1(l,1)
2954 a_temp(1,2)=aggi1(l,2)
2955 a_temp(2,1)=aggi1(l,3)
2956 a_temp(2,2)=aggi1(l,4)
2957 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2958 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2959 s1=scalar2(b1(1,iti2),auxvec(1))
2960 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2961 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2962 s2=scalar2(b1(1,iti1),auxvec(1))
2963 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2964 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2965 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2966 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2967 a_temp(1,1)=aggj(l,1)
2968 a_temp(1,2)=aggj(l,2)
2969 a_temp(2,1)=aggj(l,3)
2970 a_temp(2,2)=aggj(l,4)
2971 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2972 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2973 s1=scalar2(b1(1,iti2),auxvec(1))
2974 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2975 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2976 s2=scalar2(b1(1,iti1),auxvec(1))
2977 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2978 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2979 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2980 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2981 a_temp(1,1)=aggj1(l,1)
2982 a_temp(1,2)=aggj1(l,2)
2983 a_temp(2,1)=aggj1(l,3)
2984 a_temp(2,2)=aggj1(l,4)
2985 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2986 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2987 s1=scalar2(b1(1,iti2),auxvec(1))
2988 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2989 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2990 s2=scalar2(b1(1,iti1),auxvec(1))
2991 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2992 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2993 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2994 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3001 C-----------------------------------------------------------------------------
3002 subroutine vecpr(u,v,w)
3003 implicit real*8(a-h,o-z)
3004 dimension u(3),v(3),w(3)
3005 w(1)=u(2)*v(3)-u(3)*v(2)
3006 w(2)=-u(1)*v(3)+u(3)*v(1)
3007 w(3)=u(1)*v(2)-u(2)*v(1)
3010 C-----------------------------------------------------------------------------
3011 subroutine unormderiv(u,ugrad,unorm,ungrad)
3012 C This subroutine computes the derivatives of a normalized vector u, given
3013 C the derivatives computed without normalization conditions, ugrad. Returns
3016 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3017 double precision vec(3)
3018 double precision scalar
3020 c write (2,*) 'ugrad',ugrad
3023 vec(i)=scalar(ugrad(1,i),u(1))
3025 c write (2,*) 'vec',vec
3028 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3031 c write (2,*) 'ungrad',ungrad
3034 C-----------------------------------------------------------------------------
3035 subroutine escp(evdw2,evdw2_14)
3037 C This subroutine calculates the excluded-volume interaction energy between
3038 C peptide-group centers and side chains and its gradient in virtual-bond and
3039 C side-chain vectors.
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3043 include 'DIMENSIONS.ZSCOPT'
3044 include 'COMMON.GEO'
3045 include 'COMMON.VAR'
3046 include 'COMMON.LOCAL'
3047 include 'COMMON.CHAIN'
3048 include 'COMMON.DERIV'
3049 include 'COMMON.INTERACT'
3050 include 'COMMON.FFIELD'
3051 include 'COMMON.IOUNITS'
3055 cd print '(a)','Enter ESCP'
3056 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3057 c & ' scal14',scal14
3058 do i=iatscp_s,iatscp_e
3059 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3061 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3062 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3063 if (iteli.eq.0) goto 1225
3064 xi=0.5D0*(c(1,i)+c(1,i+1))
3065 yi=0.5D0*(c(2,i)+c(2,i+1))
3066 zi=0.5D0*(c(3,i)+c(3,i+1))
3067 C Returning the ith atom to box
3069 if (xi.lt.0) xi=xi+boxxsize
3071 if (yi.lt.0) yi=yi+boxysize
3073 if (zi.lt.0) zi=zi+boxzsize
3074 do iint=1,nscp_gr(i)
3076 do j=iscpstart(i,iint),iscpend(i,iint)
3077 itypj=iabs(itype(j))
3078 if (itypj.eq.ntyp1) cycle
3079 C Uncomment following three lines for SC-p interactions
3083 C Uncomment following three lines for Ca-p interactions
3087 C returning the jth atom to box
3089 if (xj.lt.0) xj=xj+boxxsize
3091 if (yj.lt.0) yj=yj+boxysize
3093 if (zj.lt.0) zj=zj+boxzsize
3094 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3099 C Finding the closest jth atom
3103 xj=xj_safe+xshift*boxxsize
3104 yj=yj_safe+yshift*boxysize
3105 zj=zj_safe+zshift*boxzsize
3106 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3107 if(dist_temp.lt.dist_init) then
3117 if (subchap.eq.1) then
3126 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3127 C sss is scaling function for smoothing the cutoff gradient otherwise
3128 C the gradient would not be continuouse
3129 sss=sscale(1.0d0/(dsqrt(rrij)))
3130 if (sss.le.0.0d0) cycle
3131 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3133 e1=fac*fac*aad(itypj,iteli)
3134 e2=fac*bad(itypj,iteli)
3135 if (iabs(j-i) .le. 2) then
3138 evdw2_14=evdw2_14+(e1+e2)*sss
3141 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3142 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3143 c & bad(itypj,iteli)
3144 evdw2=evdw2+evdwij*sss
3147 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3149 fac=-(evdwij+e1)*rrij*sss
3150 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3155 cd write (iout,*) 'j<i'
3156 C Uncomment following three lines for SC-p interactions
3158 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3161 cd write (iout,*) 'j>i'
3164 C Uncomment following line for SC-p interactions
3165 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3169 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3173 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3174 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3177 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3187 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3188 gradx_scp(j,i)=expon*gradx_scp(j,i)
3191 C******************************************************************************
3195 C To save time the factor EXPON has been extracted from ALL components
3196 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3199 C******************************************************************************
3202 C--------------------------------------------------------------------------
3203 subroutine edis(ehpb)
3205 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3207 implicit real*8 (a-h,o-z)
3208 include 'DIMENSIONS'
3209 include 'DIMENSIONS.ZSCOPT'
3210 include 'COMMON.SBRIDGE'
3211 include 'COMMON.CHAIN'
3212 include 'COMMON.DERIV'
3213 include 'COMMON.VAR'
3214 include 'COMMON.INTERACT'
3215 include 'COMMON.CONTROL'
3216 include 'COMMON.IOUNITS'
3219 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3220 cd print *,'link_start=',link_start,' link_end=',link_end
3221 C write(iout,*) link_end, "link_end"
3222 if (link_end.eq.0) return
3223 do i=link_start,link_end
3224 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3225 C CA-CA distance used in regularization of structure.
3228 C iii and jjj point to the residues for which the distance is assigned.
3229 if (ii.gt.nres) then
3236 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3237 C distance and angle dependent SS bond potential.
3238 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3239 C & iabs(itype(jjj)).eq.1) then
3240 C write(iout,*) constr_dist,"const"
3241 if (.not.dyn_ss .and. i.le.nss) then
3242 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3243 & iabs(itype(jjj)).eq.1) then
3244 call ssbond_ene(iii,jjj,eij)
3247 else if (ii.gt.nres .and. jj.gt.nres) then
3248 c Restraints from contact prediction
3250 if (constr_dist.eq.11) then
3251 C ehpb=ehpb+fordepth(i)**4.0d0
3252 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3253 ehpb=ehpb+fordepth(i)**4.0d0
3254 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3255 fac=fordepth(i)**4.0d0
3256 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3257 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3258 C & ehpb,fordepth(i),dd
3259 C write(iout,*) ehpb,"atu?"
3261 C fac=fordepth(i)**4.0d0
3262 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3264 if (dhpb1(i).gt.0.0d0) then
3265 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3266 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3267 c write (iout,*) "beta nmr",
3268 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3272 C Get the force constant corresponding to this distance.
3274 C Calculate the contribution to energy.
3275 ehpb=ehpb+waga*rdis*rdis
3276 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3278 C Evaluate gradient.
3281 endif !end dhpb1(i).gt.0
3282 endif !end const_dist=11
3284 ggg(j)=fac*(c(j,jj)-c(j,ii))
3287 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3288 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3291 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3292 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3295 C write(iout,*) "before"
3297 C write(iout,*) "after",dd
3298 if (constr_dist.eq.11) then
3299 ehpb=ehpb+fordepth(i)**4.0d0
3300 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3301 fac=fordepth(i)**4.0d0
3302 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3303 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3304 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3305 C print *,ehpb,"tu?"
3306 C write(iout,*) ehpb,"btu?",
3307 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3308 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3309 C & ehpb,fordepth(i),dd
3311 if (dhpb1(i).gt.0.0d0) then
3312 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3313 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3314 c write (iout,*) "alph nmr",
3315 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3318 C Get the force constant corresponding to this distance.
3320 C Calculate the contribution to energy.
3321 ehpb=ehpb+waga*rdis*rdis
3322 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3324 C Evaluate gradient.
3331 ggg(j)=fac*(c(j,jj)-c(j,ii))
3333 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3334 C If this is a SC-SC distance, we need to calculate the contributions to the
3335 C Cartesian gradient in the SC vectors (ghpbx).
3338 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3339 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3344 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3349 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3352 C--------------------------------------------------------------------------
3353 subroutine ssbond_ene(i,j,eij)
3355 C Calculate the distance and angle dependent SS-bond potential energy
3356 C using a free-energy function derived based on RHF/6-31G** ab initio
3357 C calculations of diethyl disulfide.
3359 C A. Liwo and U. Kozlowska, 11/24/03
3361 implicit real*8 (a-h,o-z)
3362 include 'DIMENSIONS'
3363 include 'DIMENSIONS.ZSCOPT'
3364 include 'COMMON.SBRIDGE'
3365 include 'COMMON.CHAIN'
3366 include 'COMMON.DERIV'
3367 include 'COMMON.LOCAL'
3368 include 'COMMON.INTERACT'
3369 include 'COMMON.VAR'
3370 include 'COMMON.IOUNITS'
3371 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3372 itypi=iabs(itype(i))
3376 dxi=dc_norm(1,nres+i)
3377 dyi=dc_norm(2,nres+i)
3378 dzi=dc_norm(3,nres+i)
3379 dsci_inv=dsc_inv(itypi)
3380 itypj=iabs(itype(j))
3381 dscj_inv=dsc_inv(itypj)
3385 dxj=dc_norm(1,nres+j)
3386 dyj=dc_norm(2,nres+j)
3387 dzj=dc_norm(3,nres+j)
3388 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3393 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3394 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3395 om12=dxi*dxj+dyi*dyj+dzi*dzj
3397 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3398 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3404 deltat12=om2-om1+2.0d0
3406 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3407 & +akct*deltad*deltat12
3408 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3409 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3410 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3411 c & " deltat12",deltat12," eij",eij
3412 ed=2*akcm*deltad+akct*deltat12
3414 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3415 eom1=-2*akth*deltat1-pom1-om2*pom2
3416 eom2= 2*akth*deltat2+pom1-om1*pom2
3419 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3422 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3423 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3424 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3425 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3428 C Calculate the components of the gradient in DC and X
3432 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3437 C--------------------------------------------------------------------------
3438 subroutine ebond(estr)
3440 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3442 implicit real*8 (a-h,o-z)
3443 include 'DIMENSIONS'
3444 include 'DIMENSIONS.ZSCOPT'
3445 include 'COMMON.LOCAL'
3446 include 'COMMON.GEO'
3447 include 'COMMON.INTERACT'
3448 include 'COMMON.DERIV'
3449 include 'COMMON.VAR'
3450 include 'COMMON.CHAIN'
3451 include 'COMMON.IOUNITS'
3452 include 'COMMON.NAMES'
3453 include 'COMMON.FFIELD'
3454 include 'COMMON.CONTROL'
3455 logical energy_dec /.false./
3456 double precision u(3),ud(3)
3459 c write (iout,*) "distchainmax",distchainmax
3461 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3462 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3464 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3465 C & *dc(j,i-1)/vbld(i)
3467 C if (energy_dec) write(iout,*)
3468 C & "estr1",i,vbld(i),distchainmax,
3469 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3471 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3472 diff = vbld(i)-vbldpDUM
3474 diff = vbld(i)-vbldp0
3475 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3479 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3482 C write (iout,'(a7,i5,4f7.3)')
3483 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3485 estr=0.5d0*AKP*estr+estr1
3487 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3491 if (iti.ne.10 .and. iti.ne.ntyp1) then
3494 diff=vbld(i+nres)-vbldsc0(1,iti)
3495 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3496 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3497 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3499 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3503 diff=vbld(i+nres)-vbldsc0(j,iti)
3504 ud(j)=aksc(j,iti)*diff
3505 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3519 uprod2=uprod2*u(k)*u(k)
3523 usumsqder=usumsqder+ud(j)*uprod2
3525 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3526 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3527 estr=estr+uprod/usum
3529 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3537 C--------------------------------------------------------------------------
3538 subroutine ebend(etheta,ethetacnstr)
3540 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3541 C angles gamma and its derivatives in consecutive thetas and gammas.
3543 implicit real*8 (a-h,o-z)
3544 include 'DIMENSIONS'
3545 include 'DIMENSIONS.ZSCOPT'
3546 include 'COMMON.LOCAL'
3547 include 'COMMON.GEO'
3548 include 'COMMON.INTERACT'
3549 include 'COMMON.DERIV'
3550 include 'COMMON.VAR'
3551 include 'COMMON.CHAIN'
3552 include 'COMMON.IOUNITS'
3553 include 'COMMON.NAMES'
3554 include 'COMMON.FFIELD'
3555 include 'COMMON.TORCNSTR'
3556 common /calcthet/ term1,term2,termm,diffak,ratak,
3557 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3558 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3559 double precision y(2),z(2)
3561 c time11=dexp(-2*time)
3564 c write (iout,*) "nres",nres
3565 c write (*,'(a,i2)') 'EBEND ICG=',icg
3566 c write (iout,*) ithet_start,ithet_end
3567 do i=ithet_start,ithet_end
3568 C if (itype(i-1).eq.ntyp1) cycle
3570 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3571 & .or.itype(i).eq.ntyp1) cycle
3572 C Zero the energy function and its derivative at 0 or pi.
3573 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3575 ichir1=isign(1,itype(i-2))
3576 ichir2=isign(1,itype(i))
3577 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3578 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3579 if (itype(i-1).eq.10) then
3580 itype1=isign(10,itype(i-2))
3581 ichir11=isign(1,itype(i-2))
3582 ichir12=isign(1,itype(i-2))
3583 itype2=isign(10,itype(i))
3584 ichir21=isign(1,itype(i))
3585 ichir22=isign(1,itype(i))
3592 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3596 c call proc_proc(phii,icrc)
3597 if (icrc.eq.1) phii=150.0
3608 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3612 c call proc_proc(phii1,icrc)
3613 if (icrc.eq.1) phii1=150.0
3625 C Calculate the "mean" value of theta from the part of the distribution
3626 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3627 C In following comments this theta will be referred to as t_c.
3628 thet_pred_mean=0.0d0
3630 athetk=athet(k,it,ichir1,ichir2)
3631 bthetk=bthet(k,it,ichir1,ichir2)
3633 athetk=athet(k,itype1,ichir11,ichir12)
3634 bthetk=bthet(k,itype2,ichir21,ichir22)
3636 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3638 c write (iout,*) "thet_pred_mean",thet_pred_mean
3639 dthett=thet_pred_mean*ssd
3640 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3641 c write (iout,*) "thet_pred_mean",thet_pred_mean
3642 C Derivatives of the "mean" values in gamma1 and gamma2.
3643 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3644 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3645 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3646 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3648 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3649 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3650 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3651 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3653 if (theta(i).gt.pi-delta) then
3654 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3656 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3657 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3658 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3660 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3662 else if (theta(i).lt.delta) then
3663 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3664 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3665 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3667 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3668 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3671 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3674 etheta=etheta+ethetai
3675 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3676 c & 'ebend',i,ethetai,theta(i),itype(i)
3677 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3678 c & rad2deg*phii,rad2deg*phii1,ethetai
3679 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3680 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3681 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3685 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3686 do i=1,ntheta_constr
3687 itheta=itheta_constr(i)
3688 thetiii=theta(itheta)
3689 difi=pinorm(thetiii-theta_constr0(i))
3690 if (difi.gt.theta_drange(i)) then
3691 difi=difi-theta_drange(i)
3692 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3693 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3694 & +for_thet_constr(i)*difi**3
3695 else if (difi.lt.-drange(i)) then
3697 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3698 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3699 & +for_thet_constr(i)*difi**3
3703 C if (energy_dec) then
3704 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3705 C & i,itheta,rad2deg*thetiii,
3706 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3707 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3708 C & gloc(itheta+nphi-2,icg)
3711 C Ufff.... We've done all this!!!
3714 C---------------------------------------------------------------------------
3715 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3717 implicit real*8 (a-h,o-z)
3718 include 'DIMENSIONS'
3719 include 'COMMON.LOCAL'
3720 include 'COMMON.IOUNITS'
3721 common /calcthet/ term1,term2,termm,diffak,ratak,
3722 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3723 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3724 C Calculate the contributions to both Gaussian lobes.
3725 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3726 C The "polynomial part" of the "standard deviation" of this part of
3730 sig=sig*thet_pred_mean+polthet(j,it)
3732 C Derivative of the "interior part" of the "standard deviation of the"
3733 C gamma-dependent Gaussian lobe in t_c.
3734 sigtc=3*polthet(3,it)
3736 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3739 C Set the parameters of both Gaussian lobes of the distribution.
3740 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3741 fac=sig*sig+sigc0(it)
3744 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3745 sigsqtc=-4.0D0*sigcsq*sigtc
3746 c print *,i,sig,sigtc,sigsqtc
3747 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3748 sigtc=-sigtc/(fac*fac)
3749 C Following variable is sigma(t_c)**(-2)
3750 sigcsq=sigcsq*sigcsq
3752 sig0inv=1.0D0/sig0i**2
3753 delthec=thetai-thet_pred_mean
3754 delthe0=thetai-theta0i
3755 term1=-0.5D0*sigcsq*delthec*delthec
3756 term2=-0.5D0*sig0inv*delthe0*delthe0
3757 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3758 C NaNs in taking the logarithm. We extract the largest exponent which is added
3759 C to the energy (this being the log of the distribution) at the end of energy
3760 C term evaluation for this virtual-bond angle.
3761 if (term1.gt.term2) then
3763 term2=dexp(term2-termm)
3767 term1=dexp(term1-termm)
3770 C The ratio between the gamma-independent and gamma-dependent lobes of
3771 C the distribution is a Gaussian function of thet_pred_mean too.
3772 diffak=gthet(2,it)-thet_pred_mean
3773 ratak=diffak/gthet(3,it)**2
3774 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3775 C Let's differentiate it in thet_pred_mean NOW.
3777 C Now put together the distribution terms to make complete distribution.
3778 termexp=term1+ak*term2
3779 termpre=sigc+ak*sig0i
3780 C Contribution of the bending energy from this theta is just the -log of
3781 C the sum of the contributions from the two lobes and the pre-exponential
3782 C factor. Simple enough, isn't it?
3783 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3784 C NOW the derivatives!!!
3785 C 6/6/97 Take into account the deformation.
3786 E_theta=(delthec*sigcsq*term1
3787 & +ak*delthe0*sig0inv*term2)/termexp
3788 E_tc=((sigtc+aktc*sig0i)/termpre
3789 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3790 & aktc*term2)/termexp)
3793 c-----------------------------------------------------------------------------
3794 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3795 implicit real*8 (a-h,o-z)
3796 include 'DIMENSIONS'
3797 include 'COMMON.LOCAL'
3798 include 'COMMON.IOUNITS'
3799 common /calcthet/ term1,term2,termm,diffak,ratak,
3800 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3801 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3802 delthec=thetai-thet_pred_mean
3803 delthe0=thetai-theta0i
3804 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3805 t3 = thetai-thet_pred_mean
3809 t14 = t12+t6*sigsqtc
3811 t21 = thetai-theta0i
3817 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3818 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3819 & *(-t12*t9-ak*sig0inv*t27)
3823 C--------------------------------------------------------------------------
3824 subroutine ebend(etheta,ethetacnstr)
3826 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3827 C angles gamma and its derivatives in consecutive thetas and gammas.
3828 C ab initio-derived potentials from
3829 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3831 implicit real*8 (a-h,o-z)
3832 include 'DIMENSIONS'
3833 include 'DIMENSIONS.ZSCOPT'
3834 include 'COMMON.LOCAL'
3835 include 'COMMON.GEO'
3836 include 'COMMON.INTERACT'
3837 include 'COMMON.DERIV'
3838 include 'COMMON.VAR'
3839 include 'COMMON.CHAIN'
3840 include 'COMMON.IOUNITS'
3841 include 'COMMON.NAMES'
3842 include 'COMMON.FFIELD'
3843 include 'COMMON.CONTROL'
3844 include 'COMMON.TORCNSTR'
3845 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3846 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3847 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3848 & sinph1ph2(maxdouble,maxdouble)
3849 logical lprn /.false./, lprn1 /.false./
3851 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3852 do i=ithet_start,ithet_end
3854 C if (itype(i-1).eq.ntyp1) cycle
3856 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3857 & .or.itype(i).eq.ntyp1) cycle
3858 if (iabs(itype(i+1)).eq.20) iblock=2
3859 if (iabs(itype(i+1)).ne.20) iblock=1
3863 theti2=0.5d0*theta(i)
3864 ityp2=ithetyp((itype(i-1)))
3866 coskt(k)=dcos(k*theti2)
3867 sinkt(k)=dsin(k*theti2)
3877 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3880 if (phii.ne.phii) phii=150.0
3884 ityp1=ithetyp((itype(i-2)))
3886 cosph1(k)=dcos(k*phii)
3887 sinph1(k)=dsin(k*phii)
3893 ityp1=ithetyp((itype(i-2)))
3899 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3902 if (phii1.ne.phii1) phii1=150.0
3907 ityp3=ithetyp((itype(i)))
3909 cosph2(k)=dcos(k*phii1)
3910 sinph2(k)=dsin(k*phii1)
3915 ityp3=ithetyp((itype(i)))
3921 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3922 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3924 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3927 ccl=cosph1(l)*cosph2(k-l)
3928 ssl=sinph1(l)*sinph2(k-l)
3929 scl=sinph1(l)*cosph2(k-l)
3930 csl=cosph1(l)*sinph2(k-l)
3931 cosph1ph2(l,k)=ccl-ssl
3932 cosph1ph2(k,l)=ccl+ssl
3933 sinph1ph2(l,k)=scl+csl
3934 sinph1ph2(k,l)=scl-csl
3938 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3939 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3940 write (iout,*) "coskt and sinkt"
3942 write (iout,*) k,coskt(k),sinkt(k)
3946 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3947 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3950 & write (iout,*) "k",k,"
3951 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3952 & " ethetai",ethetai
3955 write (iout,*) "cosph and sinph"
3957 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3959 write (iout,*) "cosph1ph2 and sinph2ph2"
3962 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3963 & sinph1ph2(l,k),sinph1ph2(k,l)
3966 write(iout,*) "ethetai",ethetai
3970 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3971 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3972 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3973 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3974 ethetai=ethetai+sinkt(m)*aux
3975 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3976 dephii=dephii+k*sinkt(m)*(
3977 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3978 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3979 dephii1=dephii1+k*sinkt(m)*(
3980 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3981 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3983 & write (iout,*) "m",m," k",k," bbthet",
3984 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3985 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3986 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3987 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3991 & write(iout,*) "ethetai",ethetai
3995 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3996 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3997 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3998 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3999 ethetai=ethetai+sinkt(m)*aux
4000 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4001 dephii=dephii+l*sinkt(m)*(
4002 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4003 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4004 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4005 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4006 dephii1=dephii1+(k-l)*sinkt(m)*(
4007 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4008 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4009 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4010 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4012 write (iout,*) "m",m," k",k," l",l," ffthet",
4013 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4014 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4015 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4016 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4017 & " ethetai",ethetai
4018 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4019 & cosph1ph2(k,l)*sinkt(m),
4020 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4026 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4027 & i,theta(i)*rad2deg,phii*rad2deg,
4028 & phii1*rad2deg,ethetai
4029 etheta=etheta+ethetai
4030 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4031 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4032 c gloc(nphi+i-2,icg)=wang*dethetai
4033 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4037 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4038 do i=1,ntheta_constr
4039 itheta=itheta_constr(i)
4040 thetiii=theta(itheta)
4041 difi=pinorm(thetiii-theta_constr0(i))
4042 if (difi.gt.theta_drange(i)) then
4043 difi=difi-theta_drange(i)
4044 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4045 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4046 & +for_thet_constr(i)*difi**3
4047 else if (difi.lt.-drange(i)) then
4049 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4050 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4051 & +for_thet_constr(i)*difi**3
4055 C if (energy_dec) then
4056 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4057 C & i,itheta,rad2deg*thetiii,
4058 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4059 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4060 C & gloc(itheta+nphi-2,icg)
4067 c-----------------------------------------------------------------------------
4068 subroutine esc(escloc)
4069 C Calculate the local energy of a side chain and its derivatives in the
4070 C corresponding virtual-bond valence angles THETA and the spherical angles
4072 implicit real*8 (a-h,o-z)
4073 include 'DIMENSIONS'
4074 include 'DIMENSIONS.ZSCOPT'
4075 include 'COMMON.GEO'
4076 include 'COMMON.LOCAL'
4077 include 'COMMON.VAR'
4078 include 'COMMON.INTERACT'
4079 include 'COMMON.DERIV'
4080 include 'COMMON.CHAIN'
4081 include 'COMMON.IOUNITS'
4082 include 'COMMON.NAMES'
4083 include 'COMMON.FFIELD'
4084 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4085 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4086 common /sccalc/ time11,time12,time112,theti,it,nlobit
4089 C write (iout,*) 'ESC'
4090 do i=loc_start,loc_end
4092 if (it.eq.ntyp1) cycle
4093 if (it.eq.10) goto 1
4094 nlobit=nlob(iabs(it))
4095 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4096 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4097 theti=theta(i+1)-pipol
4101 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4103 if (x(2).gt.pi-delta) then
4107 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4109 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4110 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4112 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4113 & ddersc0(1),dersc(1))
4114 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4115 & ddersc0(3),dersc(3))
4117 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4119 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4120 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4121 & dersc0(2),esclocbi,dersc02)
4122 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4124 call splinthet(x(2),0.5d0*delta,ss,ssd)
4129 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4131 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4132 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4134 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4136 c write (iout,*) escloci
4137 else if (x(2).lt.delta) then
4141 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4143 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4144 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4146 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4147 & ddersc0(1),dersc(1))
4148 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4149 & ddersc0(3),dersc(3))
4151 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4153 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4154 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4155 & dersc0(2),esclocbi,dersc02)
4156 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4161 call splinthet(x(2),0.5d0*delta,ss,ssd)
4163 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4165 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4166 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4168 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4169 C write (iout,*) 'i=',i, escloci
4171 call enesc(x,escloci,dersc,ddummy,.false.)
4174 escloc=escloc+escloci
4175 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4176 write (iout,'(a6,i5,0pf7.3)')
4177 & 'escloc',i,escloci
4179 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4181 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4182 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4187 C---------------------------------------------------------------------------
4188 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4189 implicit real*8 (a-h,o-z)
4190 include 'DIMENSIONS'
4191 include 'COMMON.GEO'
4192 include 'COMMON.LOCAL'
4193 include 'COMMON.IOUNITS'
4194 common /sccalc/ time11,time12,time112,theti,it,nlobit
4195 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4196 double precision contr(maxlob,-1:1)
4198 c write (iout,*) 'it=',it,' nlobit=',nlobit
4202 if (mixed) ddersc(j)=0.0d0
4206 C Because of periodicity of the dependence of the SC energy in omega we have
4207 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4208 C To avoid underflows, first compute & store the exponents.
4216 z(k)=x(k)-censc(k,j,it)
4221 Axk=Axk+gaussc(l,k,j,it)*z(l)
4227 expfac=expfac+Ax(k,j,iii)*z(k)
4235 C As in the case of ebend, we want to avoid underflows in exponentiation and
4236 C subsequent NaNs and INFs in energy calculation.
4237 C Find the largest exponent
4241 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4245 cd print *,'it=',it,' emin=',emin
4247 C Compute the contribution to SC energy and derivatives
4251 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4252 cd print *,'j=',j,' expfac=',expfac
4253 escloc_i=escloc_i+expfac
4255 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4259 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4260 & +gaussc(k,2,j,it))*expfac
4267 dersc(1)=dersc(1)/cos(theti)**2
4268 ddersc(1)=ddersc(1)/cos(theti)**2
4271 escloci=-(dlog(escloc_i)-emin)
4273 dersc(j)=dersc(j)/escloc_i
4277 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4282 C------------------------------------------------------------------------------
4283 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4284 implicit real*8 (a-h,o-z)
4285 include 'DIMENSIONS'
4286 include 'COMMON.GEO'
4287 include 'COMMON.LOCAL'
4288 include 'COMMON.IOUNITS'
4289 common /sccalc/ time11,time12,time112,theti,it,nlobit
4290 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4291 double precision contr(maxlob)
4302 z(k)=x(k)-censc(k,j,it)
4308 Axk=Axk+gaussc(l,k,j,it)*z(l)
4314 expfac=expfac+Ax(k,j)*z(k)
4319 C As in the case of ebend, we want to avoid underflows in exponentiation and
4320 C subsequent NaNs and INFs in energy calculation.
4321 C Find the largest exponent
4324 if (emin.gt.contr(j)) emin=contr(j)
4328 C Compute the contribution to SC energy and derivatives
4332 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4333 escloc_i=escloc_i+expfac
4335 dersc(k)=dersc(k)+Ax(k,j)*expfac
4337 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4338 & +gaussc(1,2,j,it))*expfac
4342 dersc(1)=dersc(1)/cos(theti)**2
4343 dersc12=dersc12/cos(theti)**2
4344 escloci=-(dlog(escloc_i)-emin)
4346 dersc(j)=dersc(j)/escloc_i
4348 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4352 c----------------------------------------------------------------------------------
4353 subroutine esc(escloc)
4354 C Calculate the local energy of a side chain and its derivatives in the
4355 C corresponding virtual-bond valence angles THETA and the spherical angles
4356 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4357 C added by Urszula Kozlowska. 07/11/2007
4359 implicit real*8 (a-h,o-z)
4360 include 'DIMENSIONS'
4361 include 'DIMENSIONS.ZSCOPT'
4362 include 'COMMON.GEO'
4363 include 'COMMON.LOCAL'
4364 include 'COMMON.VAR'
4365 include 'COMMON.SCROT'
4366 include 'COMMON.INTERACT'
4367 include 'COMMON.DERIV'
4368 include 'COMMON.CHAIN'
4369 include 'COMMON.IOUNITS'
4370 include 'COMMON.NAMES'
4371 include 'COMMON.FFIELD'
4372 include 'COMMON.CONTROL'
4373 include 'COMMON.VECTORS'
4374 double precision x_prime(3),y_prime(3),z_prime(3)
4375 & , sumene,dsc_i,dp2_i,x(65),
4376 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4377 & de_dxx,de_dyy,de_dzz,de_dt
4378 double precision s1_t,s1_6_t,s2_t,s2_6_t
4380 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4381 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4382 & dt_dCi(3),dt_dCi1(3)
4383 common /sccalc/ time11,time12,time112,theti,it,nlobit
4386 do i=loc_start,loc_end
4387 if (itype(i).eq.ntyp1) cycle
4388 costtab(i+1) =dcos(theta(i+1))
4389 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4390 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4391 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4392 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4393 cosfac=dsqrt(cosfac2)
4394 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4395 sinfac=dsqrt(sinfac2)
4397 if (it.eq.10) goto 1
4399 C Compute the axes of tghe local cartesian coordinates system; store in
4400 c x_prime, y_prime and z_prime
4407 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4408 C & dc_norm(3,i+nres)
4410 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4411 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4414 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4417 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4418 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4419 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4420 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4421 c & " xy",scalar(x_prime(1),y_prime(1)),
4422 c & " xz",scalar(x_prime(1),z_prime(1)),
4423 c & " yy",scalar(y_prime(1),y_prime(1)),
4424 c & " yz",scalar(y_prime(1),z_prime(1)),
4425 c & " zz",scalar(z_prime(1),z_prime(1))
4427 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4428 C to local coordinate system. Store in xx, yy, zz.
4434 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4435 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4436 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4443 C Compute the energy of the ith side cbain
4445 c write (2,*) "xx",xx," yy",yy," zz",zz
4448 x(j) = sc_parmin(j,it)
4451 Cc diagnostics - remove later
4453 yy1 = dsin(alph(2))*dcos(omeg(2))
4454 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4455 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4456 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4458 C," --- ", xx_w,yy_w,zz_w
4461 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4462 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4464 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4465 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4467 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4468 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4469 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4470 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4471 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4473 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4474 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4475 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4476 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4477 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4479 dsc_i = 0.743d0+x(61)
4481 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4482 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4483 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4484 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4485 s1=(1+x(63))/(0.1d0 + dscp1)
4486 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4487 s2=(1+x(65))/(0.1d0 + dscp2)
4488 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4489 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4490 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4491 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4493 c & dscp1,dscp2,sumene
4494 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4495 escloc = escloc + sumene
4496 c write (2,*) "escloc",escloc
4497 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4499 if (.not. calc_grad) goto 1
4502 C This section to check the numerical derivatives of the energy of ith side
4503 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4504 C #define DEBUG in the code to turn it on.
4506 write (2,*) "sumene =",sumene
4510 write (2,*) xx,yy,zz
4511 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4512 de_dxx_num=(sumenep-sumene)/aincr
4514 write (2,*) "xx+ sumene from enesc=",sumenep
4517 write (2,*) xx,yy,zz
4518 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4519 de_dyy_num=(sumenep-sumene)/aincr
4521 write (2,*) "yy+ sumene from enesc=",sumenep
4524 write (2,*) xx,yy,zz
4525 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4526 de_dzz_num=(sumenep-sumene)/aincr
4528 write (2,*) "zz+ sumene from enesc=",sumenep
4529 costsave=cost2tab(i+1)
4530 sintsave=sint2tab(i+1)
4531 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4532 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4533 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4534 de_dt_num=(sumenep-sumene)/aincr
4535 write (2,*) " t+ sumene from enesc=",sumenep
4536 cost2tab(i+1)=costsave
4537 sint2tab(i+1)=sintsave
4538 C End of diagnostics section.
4541 C Compute the gradient of esc
4543 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4544 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4545 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4546 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4547 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4548 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4549 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4550 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4551 pom1=(sumene3*sint2tab(i+1)+sumene1)
4552 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4553 pom2=(sumene4*cost2tab(i+1)+sumene2)
4554 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4555 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4556 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4557 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4559 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4560 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4561 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4563 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4564 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4565 & +(pom1+pom2)*pom_dx
4567 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4570 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4571 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4572 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4574 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4575 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4576 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4577 & +x(59)*zz**2 +x(60)*xx*zz
4578 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4579 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4580 & +(pom1-pom2)*pom_dy
4582 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4585 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4586 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4587 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4588 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4589 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4590 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4591 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4592 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4594 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4597 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4598 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4599 & +pom1*pom_dt1+pom2*pom_dt2
4601 write(2,*), "de_dt = ", de_dt,de_dt_num
4605 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4606 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4607 cosfac2xx=cosfac2*xx
4608 sinfac2yy=sinfac2*yy
4610 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4612 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4614 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4615 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4616 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4617 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4618 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4619 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4620 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4621 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4622 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4623 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4627 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4628 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4629 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4630 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4633 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4634 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4635 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4637 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4638 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4642 dXX_Ctab(k,i)=dXX_Ci(k)
4643 dXX_C1tab(k,i)=dXX_Ci1(k)
4644 dYY_Ctab(k,i)=dYY_Ci(k)
4645 dYY_C1tab(k,i)=dYY_Ci1(k)
4646 dZZ_Ctab(k,i)=dZZ_Ci(k)
4647 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4648 dXX_XYZtab(k,i)=dXX_XYZ(k)
4649 dYY_XYZtab(k,i)=dYY_XYZ(k)
4650 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4654 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4655 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4656 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4657 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4658 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4660 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4661 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4662 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4663 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4664 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4665 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4666 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4667 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4669 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4670 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4672 C to check gradient call subroutine check_grad
4679 c------------------------------------------------------------------------------
4680 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4682 C This procedure calculates two-body contact function g(rij) and its derivative:
4685 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4688 C where x=(rij-r0ij)/delta
4690 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4693 double precision rij,r0ij,eps0ij,fcont,fprimcont
4694 double precision x,x2,x4,delta
4698 if (x.lt.-1.0D0) then
4701 else if (x.le.1.0D0) then
4704 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4705 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4712 c------------------------------------------------------------------------------
4713 subroutine splinthet(theti,delta,ss,ssder)
4714 implicit real*8 (a-h,o-z)
4715 include 'DIMENSIONS'
4716 include 'DIMENSIONS.ZSCOPT'
4717 include 'COMMON.VAR'
4718 include 'COMMON.GEO'
4721 if (theti.gt.pipol) then
4722 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4724 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4729 c------------------------------------------------------------------------------
4730 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4732 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4733 double precision ksi,ksi2,ksi3,a1,a2,a3
4734 a1=fprim0*delta/(f1-f0)
4740 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4741 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4744 c------------------------------------------------------------------------------
4745 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4747 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4748 double precision ksi,ksi2,ksi3,a1,a2,a3
4753 a2=3*(f1x-f0x)-2*fprim0x*delta
4754 a3=fprim0x*delta-2*(f1x-f0x)
4755 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4758 C-----------------------------------------------------------------------------
4760 C-----------------------------------------------------------------------------
4761 subroutine etor(etors,edihcnstr,fact)
4762 implicit real*8 (a-h,o-z)
4763 include 'DIMENSIONS'
4764 include 'DIMENSIONS.ZSCOPT'
4765 include 'COMMON.VAR'
4766 include 'COMMON.GEO'
4767 include 'COMMON.LOCAL'
4768 include 'COMMON.TORSION'
4769 include 'COMMON.INTERACT'
4770 include 'COMMON.DERIV'
4771 include 'COMMON.CHAIN'
4772 include 'COMMON.NAMES'
4773 include 'COMMON.IOUNITS'
4774 include 'COMMON.FFIELD'
4775 include 'COMMON.TORCNSTR'
4777 C Set lprn=.true. for debugging
4781 do i=iphi_start,iphi_end
4782 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4783 & .or. itype(i).eq.ntyp1) cycle
4784 itori=itortyp(itype(i-2))
4785 itori1=itortyp(itype(i-1))
4788 C Proline-Proline pair is a special case...
4789 if (itori.eq.3 .and. itori1.eq.3) then
4790 if (phii.gt.-dwapi3) then
4792 fac=1.0D0/(1.0D0-cosphi)
4793 etorsi=v1(1,3,3)*fac
4794 etorsi=etorsi+etorsi
4795 etors=etors+etorsi-v1(1,3,3)
4796 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4799 v1ij=v1(j+1,itori,itori1)
4800 v2ij=v2(j+1,itori,itori1)
4803 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4804 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4808 v1ij=v1(j,itori,itori1)
4809 v2ij=v2(j,itori,itori1)
4812 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4813 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4817 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4818 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4819 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4820 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4821 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4823 ! 6/20/98 - dihedral angle constraints
4826 itori=idih_constr(i)
4829 if (difi.gt.drange(i)) then
4831 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4832 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4833 else if (difi.lt.-drange(i)) then
4835 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4836 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4838 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4839 C & i,itori,rad2deg*phii,
4840 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4842 ! write (iout,*) 'edihcnstr',edihcnstr
4845 c------------------------------------------------------------------------------
4847 subroutine etor(etors,edihcnstr,fact)
4848 implicit real*8 (a-h,o-z)
4849 include 'DIMENSIONS'
4850 include 'DIMENSIONS.ZSCOPT'
4851 include 'COMMON.VAR'
4852 include 'COMMON.GEO'
4853 include 'COMMON.LOCAL'
4854 include 'COMMON.TORSION'
4855 include 'COMMON.INTERACT'
4856 include 'COMMON.DERIV'
4857 include 'COMMON.CHAIN'
4858 include 'COMMON.NAMES'
4859 include 'COMMON.IOUNITS'
4860 include 'COMMON.FFIELD'
4861 include 'COMMON.TORCNSTR'
4863 C Set lprn=.true. for debugging
4867 do i=iphi_start,iphi_end
4869 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4870 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4871 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4872 C & .or. itype(i).eq.ntyp1) cycle
4873 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4874 if (iabs(itype(i)).eq.20) then
4879 itori=itortyp(itype(i-2))
4880 itori1=itortyp(itype(i-1))
4883 C Regular cosine and sine terms
4884 do j=1,nterm(itori,itori1,iblock)
4885 v1ij=v1(j,itori,itori1,iblock)
4886 v2ij=v2(j,itori,itori1,iblock)
4889 etors=etors+v1ij*cosphi+v2ij*sinphi
4890 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4894 C E = SUM ----------------------------------- - v1
4895 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4897 cosphi=dcos(0.5d0*phii)
4898 sinphi=dsin(0.5d0*phii)
4899 do j=1,nlor(itori,itori1,iblock)
4900 vl1ij=vlor1(j,itori,itori1)
4901 vl2ij=vlor2(j,itori,itori1)
4902 vl3ij=vlor3(j,itori,itori1)
4903 pom=vl2ij*cosphi+vl3ij*sinphi
4904 pom1=1.0d0/(pom*pom+1.0d0)
4905 etors=etors+vl1ij*pom1
4906 c if (energy_dec) etors_ii=etors_ii+
4909 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4911 C Subtract the constant term
4912 etors=etors-v0(itori,itori1,iblock)
4914 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4915 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4916 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4917 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4918 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4921 ! 6/20/98 - dihedral angle constraints
4924 itori=idih_constr(i)
4926 difi=pinorm(phii-phi0(i))
4928 if (difi.gt.drange(i)) then
4930 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4931 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4932 edihi=0.25d0*ftors(i)*difi**4
4933 else if (difi.lt.-drange(i)) then
4935 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4936 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4937 edihi=0.25d0*ftors(i)*difi**4
4941 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4942 & i,itori,rad2deg*phii,
4943 & rad2deg*difi,0.25d0*ftors(i)*difi**4
4944 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4946 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4947 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4949 ! write (iout,*) 'edihcnstr',edihcnstr
4952 c----------------------------------------------------------------------------
4953 subroutine etor_d(etors_d,fact2)
4954 C 6/23/01 Compute double torsional energy
4955 implicit real*8 (a-h,o-z)
4956 include 'DIMENSIONS'
4957 include 'DIMENSIONS.ZSCOPT'
4958 include 'COMMON.VAR'
4959 include 'COMMON.GEO'
4960 include 'COMMON.LOCAL'
4961 include 'COMMON.TORSION'
4962 include 'COMMON.INTERACT'
4963 include 'COMMON.DERIV'
4964 include 'COMMON.CHAIN'
4965 include 'COMMON.NAMES'
4966 include 'COMMON.IOUNITS'
4967 include 'COMMON.FFIELD'
4968 include 'COMMON.TORCNSTR'
4970 C Set lprn=.true. for debugging
4974 do i=iphi_start,iphi_end-1
4976 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4977 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4978 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4979 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4980 & (itype(i+1).eq.ntyp1)) cycle
4981 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4983 itori=itortyp(itype(i-2))
4984 itori1=itortyp(itype(i-1))
4985 itori2=itortyp(itype(i))
4991 if (iabs(itype(i+1)).eq.20) iblock=2
4992 C Regular cosine and sine terms
4993 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4994 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4995 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4996 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4997 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4998 cosphi1=dcos(j*phii)
4999 sinphi1=dsin(j*phii)
5000 cosphi2=dcos(j*phii1)
5001 sinphi2=dsin(j*phii1)
5002 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5003 & v2cij*cosphi2+v2sij*sinphi2
5004 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5005 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5007 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5009 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5010 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5011 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5012 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5013 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5014 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5015 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5016 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5017 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5018 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5019 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5020 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5021 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5022 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5025 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5026 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5032 c------------------------------------------------------------------------------
5033 subroutine eback_sc_corr(esccor)
5034 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5035 c conformational states; temporarily implemented as differences
5036 c between UNRES torsional potentials (dependent on three types of
5037 c residues) and the torsional potentials dependent on all 20 types
5038 c of residues computed from AM1 energy surfaces of terminally-blocked
5039 c amino-acid residues.
5040 implicit real*8 (a-h,o-z)
5041 include 'DIMENSIONS'
5042 include 'DIMENSIONS.ZSCOPT'
5043 include 'COMMON.VAR'
5044 include 'COMMON.GEO'
5045 include 'COMMON.LOCAL'
5046 include 'COMMON.TORSION'
5047 include 'COMMON.SCCOR'
5048 include 'COMMON.INTERACT'
5049 include 'COMMON.DERIV'
5050 include 'COMMON.CHAIN'
5051 include 'COMMON.NAMES'
5052 include 'COMMON.IOUNITS'
5053 include 'COMMON.FFIELD'
5054 include 'COMMON.CONTROL'
5056 C Set lprn=.true. for debugging
5059 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5061 do i=itau_start,itau_end
5062 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5064 isccori=isccortyp(itype(i-2))
5065 isccori1=isccortyp(itype(i-1))
5067 do intertyp=1,3 !intertyp
5068 cc Added 09 May 2012 (Adasko)
5069 cc Intertyp means interaction type of backbone mainchain correlation:
5070 c 1 = SC...Ca...Ca...Ca
5071 c 2 = Ca...Ca...Ca...SC
5072 c 3 = SC...Ca...Ca...SCi
5074 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5075 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5076 & (itype(i-1).eq.ntyp1)))
5077 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5078 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5079 & .or.(itype(i).eq.ntyp1)))
5080 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5081 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5082 & (itype(i-3).eq.ntyp1)))) cycle
5083 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5084 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5086 do j=1,nterm_sccor(isccori,isccori1)
5087 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5088 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5089 cosphi=dcos(j*tauangle(intertyp,i))
5090 sinphi=dsin(j*tauangle(intertyp,i))
5091 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5092 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5094 C write (iout,*)"EBACK_SC_COR",esccor,i
5095 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5096 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5097 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5099 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5100 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5101 & (v1sccor(j,1,itori,itori1),j=1,6)
5102 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5103 c gsccor_loc(i-3)=gloci
5108 c------------------------------------------------------------------------------
5109 subroutine multibody(ecorr)
5110 C This subroutine calculates multi-body contributions to energy following
5111 C the idea of Skolnick et al. If side chains I and J make a contact and
5112 C at the same time side chains I+1 and J+1 make a contact, an extra
5113 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5114 implicit real*8 (a-h,o-z)
5115 include 'DIMENSIONS'
5116 include 'COMMON.IOUNITS'
5117 include 'COMMON.DERIV'
5118 include 'COMMON.INTERACT'
5119 include 'COMMON.CONTACTS'
5120 double precision gx(3),gx1(3)
5123 C Set lprn=.true. for debugging
5127 write (iout,'(a)') 'Contact function values:'
5129 write (iout,'(i2,20(1x,i2,f10.5))')
5130 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5145 num_conti=num_cont(i)
5146 num_conti1=num_cont(i1)
5151 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5152 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5153 cd & ' ishift=',ishift
5154 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5155 C The system gains extra energy.
5156 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5157 endif ! j1==j+-ishift
5166 c------------------------------------------------------------------------------
5167 double precision function esccorr(i,j,k,l,jj,kk)
5168 implicit real*8 (a-h,o-z)
5169 include 'DIMENSIONS'
5170 include 'COMMON.IOUNITS'
5171 include 'COMMON.DERIV'
5172 include 'COMMON.INTERACT'
5173 include 'COMMON.CONTACTS'
5174 double precision gx(3),gx1(3)
5179 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5180 C Calculate the multi-body contribution to energy.
5181 C Calculate multi-body contributions to the gradient.
5182 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5183 cd & k,l,(gacont(m,kk,k),m=1,3)
5185 gx(m) =ekl*gacont(m,jj,i)
5186 gx1(m)=eij*gacont(m,kk,k)
5187 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5188 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5189 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5190 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5194 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5199 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5205 c------------------------------------------------------------------------------
5207 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5208 implicit real*8 (a-h,o-z)
5209 include 'DIMENSIONS'
5210 integer dimen1,dimen2,atom,indx
5211 double precision buffer(dimen1,dimen2)
5212 double precision zapas
5213 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5214 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5215 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5216 num_kont=num_cont_hb(atom)
5220 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5223 buffer(i,indx+22)=facont_hb(i,atom)
5224 buffer(i,indx+23)=ees0p(i,atom)
5225 buffer(i,indx+24)=ees0m(i,atom)
5226 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5228 buffer(1,indx+26)=dfloat(num_kont)
5231 c------------------------------------------------------------------------------
5232 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5233 implicit real*8 (a-h,o-z)
5234 include 'DIMENSIONS'
5235 integer dimen1,dimen2,atom,indx
5236 double precision buffer(dimen1,dimen2)
5237 double precision zapas
5238 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5239 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5240 & ees0m(ntyp,maxres),
5241 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5242 num_kont=buffer(1,indx+26)
5243 num_kont_old=num_cont_hb(atom)
5244 num_cont_hb(atom)=num_kont+num_kont_old
5249 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5252 facont_hb(ii,atom)=buffer(i,indx+22)
5253 ees0p(ii,atom)=buffer(i,indx+23)
5254 ees0m(ii,atom)=buffer(i,indx+24)
5255 jcont_hb(ii,atom)=buffer(i,indx+25)
5259 c------------------------------------------------------------------------------
5261 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5262 C This subroutine calculates multi-body contributions to hydrogen-bonding
5263 implicit real*8 (a-h,o-z)
5264 include 'DIMENSIONS'
5265 include 'DIMENSIONS.ZSCOPT'
5266 include 'COMMON.IOUNITS'
5268 include 'COMMON.INFO'
5270 include 'COMMON.FFIELD'
5271 include 'COMMON.DERIV'
5272 include 'COMMON.INTERACT'
5273 include 'COMMON.CONTACTS'
5275 parameter (max_cont=maxconts)
5276 parameter (max_dim=2*(8*3+2))
5277 parameter (msglen1=max_cont*max_dim*4)
5278 parameter (msglen2=2*msglen1)
5279 integer source,CorrelType,CorrelID,Error
5280 double precision buffer(max_cont,max_dim)
5282 double precision gx(3),gx1(3)
5285 C Set lprn=.true. for debugging
5290 if (fgProcs.le.1) goto 30
5292 write (iout,'(a)') 'Contact function values:'
5294 write (iout,'(2i3,50(1x,i2,f5.2))')
5295 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5296 & j=1,num_cont_hb(i))
5299 C Caution! Following code assumes that electrostatic interactions concerning
5300 C a given atom are split among at most two processors!
5310 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5313 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5314 if (MyRank.gt.0) then
5315 C Send correlation contributions to the preceding processor
5317 nn=num_cont_hb(iatel_s)
5318 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5319 cd write (iout,*) 'The BUFFER array:'
5321 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5323 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5325 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5326 C Clear the contacts of the atom passed to the neighboring processor
5327 nn=num_cont_hb(iatel_s+1)
5329 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5331 num_cont_hb(iatel_s)=0
5333 cd write (iout,*) 'Processor ',MyID,MyRank,
5334 cd & ' is sending correlation contribution to processor',MyID-1,
5335 cd & ' msglen=',msglen
5336 cd write (*,*) 'Processor ',MyID,MyRank,
5337 cd & ' is sending correlation contribution to processor',MyID-1,
5338 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5339 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5340 cd write (iout,*) 'Processor ',MyID,
5341 cd & ' has sent correlation contribution to processor',MyID-1,
5342 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5343 cd write (*,*) 'Processor ',MyID,
5344 cd & ' has sent correlation contribution to processor',MyID-1,
5345 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5347 endif ! (MyRank.gt.0)
5351 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5352 if (MyRank.lt.fgProcs-1) then
5353 C Receive correlation contributions from the next processor
5355 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5356 cd write (iout,*) 'Processor',MyID,
5357 cd & ' is receiving correlation contribution from processor',MyID+1,
5358 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5359 cd write (*,*) 'Processor',MyID,
5360 cd & ' is receiving correlation contribution from processor',MyID+1,
5361 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5363 do while (nbytes.le.0)
5364 call mp_probe(MyID+1,CorrelType,nbytes)
5366 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5367 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5368 cd write (iout,*) 'Processor',MyID,
5369 cd & ' has received correlation contribution from processor',MyID+1,
5370 cd & ' msglen=',msglen,' nbytes=',nbytes
5371 cd write (iout,*) 'The received BUFFER array:'
5373 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5375 if (msglen.eq.msglen1) then
5376 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5377 else if (msglen.eq.msglen2) then
5378 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5379 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5382 & 'ERROR!!!! message length changed while processing correlations.'
5384 & 'ERROR!!!! message length changed while processing correlations.'
5385 call mp_stopall(Error)
5386 endif ! msglen.eq.msglen1
5387 endif ! MyRank.lt.fgProcs-1
5394 write (iout,'(a)') 'Contact function values:'
5396 write (iout,'(2i3,50(1x,i2,f5.2))')
5397 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5398 & j=1,num_cont_hb(i))
5402 C Remove the loop below after debugging !!!
5409 C Calculate the local-electrostatic correlation terms
5410 do i=iatel_s,iatel_e+1
5412 num_conti=num_cont_hb(i)
5413 num_conti1=num_cont_hb(i+1)
5418 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5419 c & ' jj=',jj,' kk=',kk
5420 if (j1.eq.j+1 .or. j1.eq.j-1) then
5421 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5422 C The system gains extra energy.
5423 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5425 else if (j1.eq.j) then
5426 C Contacts I-J and I-(J+1) occur simultaneously.
5427 C The system loses extra energy.
5428 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5433 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5434 c & ' jj=',jj,' kk=',kk
5436 C Contacts I-J and (I+1)-J occur simultaneously.
5437 C The system loses extra energy.
5438 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5445 c------------------------------------------------------------------------------
5446 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5448 C This subroutine calculates multi-body contributions to hydrogen-bonding
5449 implicit real*8 (a-h,o-z)
5450 include 'DIMENSIONS'
5451 include 'DIMENSIONS.ZSCOPT'
5452 include 'COMMON.IOUNITS'
5454 include 'COMMON.INFO'
5456 include 'COMMON.FFIELD'
5457 include 'COMMON.DERIV'
5458 include 'COMMON.INTERACT'
5459 include 'COMMON.CONTACTS'
5461 parameter (max_cont=maxconts)
5462 parameter (max_dim=2*(8*3+2))
5463 parameter (msglen1=max_cont*max_dim*4)
5464 parameter (msglen2=2*msglen1)
5465 integer source,CorrelType,CorrelID,Error
5466 double precision buffer(max_cont,max_dim)
5468 double precision gx(3),gx1(3)
5471 C Set lprn=.true. for debugging
5477 if (fgProcs.le.1) goto 30
5479 write (iout,'(a)') 'Contact function values:'
5481 write (iout,'(2i3,50(1x,i2,f5.2))')
5482 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5483 & j=1,num_cont_hb(i))
5486 C Caution! Following code assumes that electrostatic interactions concerning
5487 C a given atom are split among at most two processors!
5497 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5500 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5501 if (MyRank.gt.0) then
5502 C Send correlation contributions to the preceding processor
5504 nn=num_cont_hb(iatel_s)
5505 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5506 cd write (iout,*) 'The BUFFER array:'
5508 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5510 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5512 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5513 C Clear the contacts of the atom passed to the neighboring processor
5514 nn=num_cont_hb(iatel_s+1)
5516 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5518 num_cont_hb(iatel_s)=0
5520 cd write (iout,*) 'Processor ',MyID,MyRank,
5521 cd & ' is sending correlation contribution to processor',MyID-1,
5522 cd & ' msglen=',msglen
5523 cd write (*,*) 'Processor ',MyID,MyRank,
5524 cd & ' is sending correlation contribution to processor',MyID-1,
5525 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5526 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5527 cd write (iout,*) 'Processor ',MyID,
5528 cd & ' has sent correlation contribution to processor',MyID-1,
5529 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5530 cd write (*,*) 'Processor ',MyID,
5531 cd & ' has sent correlation contribution to processor',MyID-1,
5532 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5534 endif ! (MyRank.gt.0)
5538 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5539 if (MyRank.lt.fgProcs-1) then
5540 C Receive correlation contributions from the next processor
5542 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5543 cd write (iout,*) 'Processor',MyID,
5544 cd & ' is receiving correlation contribution from processor',MyID+1,
5545 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5546 cd write (*,*) 'Processor',MyID,
5547 cd & ' is receiving correlation contribution from processor',MyID+1,
5548 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5550 do while (nbytes.le.0)
5551 call mp_probe(MyID+1,CorrelType,nbytes)
5553 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5554 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5555 cd write (iout,*) 'Processor',MyID,
5556 cd & ' has received correlation contribution from processor',MyID+1,
5557 cd & ' msglen=',msglen,' nbytes=',nbytes
5558 cd write (iout,*) 'The received BUFFER array:'
5560 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5562 if (msglen.eq.msglen1) then
5563 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5564 else if (msglen.eq.msglen2) then
5565 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5566 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5569 & 'ERROR!!!! message length changed while processing correlations.'
5571 & 'ERROR!!!! message length changed while processing correlations.'
5572 call mp_stopall(Error)
5573 endif ! msglen.eq.msglen1
5574 endif ! MyRank.lt.fgProcs-1
5581 write (iout,'(a)') 'Contact function values:'
5583 write (iout,'(2i3,50(1x,i2,f5.2))')
5584 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5585 & j=1,num_cont_hb(i))
5591 C Remove the loop below after debugging !!!
5598 C Calculate the dipole-dipole interaction energies
5599 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5600 do i=iatel_s,iatel_e+1
5601 num_conti=num_cont_hb(i)
5608 C Calculate the local-electrostatic correlation terms
5609 do i=iatel_s,iatel_e+1
5611 num_conti=num_cont_hb(i)
5612 num_conti1=num_cont_hb(i+1)
5617 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5618 c & ' jj=',jj,' kk=',kk
5619 if (j1.eq.j+1 .or. j1.eq.j-1) then
5620 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5621 C The system gains extra energy.
5623 sqd1=dsqrt(d_cont(jj,i))
5624 sqd2=dsqrt(d_cont(kk,i1))
5625 sred_geom = sqd1*sqd2
5626 IF (sred_geom.lt.cutoff_corr) THEN
5627 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5629 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5630 c & ' jj=',jj,' kk=',kk
5631 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5632 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5634 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5635 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5638 cd write (iout,*) 'sred_geom=',sred_geom,
5639 cd & ' ekont=',ekont,' fprim=',fprimcont
5640 call calc_eello(i,j,i+1,j1,jj,kk)
5641 if (wcorr4.gt.0.0d0)
5642 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5643 if (wcorr5.gt.0.0d0)
5644 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5645 c print *,"wcorr5",ecorr5
5646 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5647 cd write(2,*)'ijkl',i,j,i+1,j1
5648 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5649 & .or. wturn6.eq.0.0d0))then
5650 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5651 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5652 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5653 cd & 'ecorr6=',ecorr6
5654 cd write (iout,'(4e15.5)') sred_geom,
5655 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5656 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5657 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5658 else if (wturn6.gt.0.0d0
5659 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5660 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5661 eturn6=eturn6+eello_turn6(i,jj,kk)
5662 cd write (2,*) 'multibody_eello:eturn6',eturn6
5666 else if (j1.eq.j) then
5667 C Contacts I-J and I-(J+1) occur simultaneously.
5668 C The system loses extra energy.
5669 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5674 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5675 c & ' jj=',jj,' kk=',kk
5677 C Contacts I-J and (I+1)-J occur simultaneously.
5678 C The system loses extra energy.
5679 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5686 c------------------------------------------------------------------------------
5687 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5688 implicit real*8 (a-h,o-z)
5689 include 'DIMENSIONS'
5690 include 'COMMON.IOUNITS'
5691 include 'COMMON.DERIV'
5692 include 'COMMON.INTERACT'
5693 include 'COMMON.CONTACTS'
5694 double precision gx(3),gx1(3)
5704 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5705 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5706 C Following 4 lines for diagnostics.
5711 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5713 c write (iout,*)'Contacts have occurred for peptide groups',
5714 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5715 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5716 C Calculate the multi-body contribution to energy.
5717 ecorr=ecorr+ekont*ees
5719 C Calculate multi-body contributions to the gradient.
5721 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5722 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5723 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5724 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5725 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5726 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5727 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5728 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5729 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5730 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5731 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5732 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5733 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5734 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5738 gradcorr(ll,m)=gradcorr(ll,m)+
5739 & ees*ekl*gacont_hbr(ll,jj,i)-
5740 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5741 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5746 gradcorr(ll,m)=gradcorr(ll,m)+
5747 & ees*eij*gacont_hbr(ll,kk,k)-
5748 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5749 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5756 C---------------------------------------------------------------------------
5757 subroutine dipole(i,j,jj)
5758 implicit real*8 (a-h,o-z)
5759 include 'DIMENSIONS'
5760 include 'DIMENSIONS.ZSCOPT'
5761 include 'COMMON.IOUNITS'
5762 include 'COMMON.CHAIN'
5763 include 'COMMON.FFIELD'
5764 include 'COMMON.DERIV'
5765 include 'COMMON.INTERACT'
5766 include 'COMMON.CONTACTS'
5767 include 'COMMON.TORSION'
5768 include 'COMMON.VAR'
5769 include 'COMMON.GEO'
5770 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5772 iti1 = itortyp(itype(i+1))
5773 if (j.lt.nres-1) then
5774 if (itype(j).le.ntyp) then
5775 itj1 = itortyp(itype(j+1))
5783 dipi(iii,1)=Ub2(iii,i)
5784 dipderi(iii)=Ub2der(iii,i)
5785 dipi(iii,2)=b1(iii,iti1)
5786 dipj(iii,1)=Ub2(iii,j)
5787 dipderj(iii)=Ub2der(iii,j)
5788 dipj(iii,2)=b1(iii,itj1)
5792 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5795 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5798 if (.not.calc_grad) return
5803 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5807 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5812 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5813 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5815 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5817 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5819 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5823 C---------------------------------------------------------------------------
5824 subroutine calc_eello(i,j,k,l,jj,kk)
5826 C This subroutine computes matrices and vectors needed to calculate
5827 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5829 implicit real*8 (a-h,o-z)
5830 include 'DIMENSIONS'
5831 include 'DIMENSIONS.ZSCOPT'
5832 include 'COMMON.IOUNITS'
5833 include 'COMMON.CHAIN'
5834 include 'COMMON.DERIV'
5835 include 'COMMON.INTERACT'
5836 include 'COMMON.CONTACTS'
5837 include 'COMMON.TORSION'
5838 include 'COMMON.VAR'
5839 include 'COMMON.GEO'
5840 include 'COMMON.FFIELD'
5841 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5842 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5845 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5846 cd & ' jj=',jj,' kk=',kk
5847 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5850 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5851 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5854 call transpose2(aa1(1,1),aa1t(1,1))
5855 call transpose2(aa2(1,1),aa2t(1,1))
5858 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5859 & aa1tder(1,1,lll,kkk))
5860 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5861 & aa2tder(1,1,lll,kkk))
5865 C parallel orientation of the two CA-CA-CA frames.
5866 if (i.gt.1 .and. itype(i).le.ntyp) then
5867 iti=itortyp(itype(i))
5871 itk1=itortyp(itype(k+1))
5872 itj=itortyp(itype(j))
5873 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5874 itl1=itortyp(itype(l+1))
5878 C A1 kernel(j+1) A2T
5880 cd write (iout,'(3f10.5,5x,3f10.5)')
5881 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5883 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5884 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5885 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5886 C Following matrices are needed only for 6-th order cumulants
5887 IF (wcorr6.gt.0.0d0) THEN
5888 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5889 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5890 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5891 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5892 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5893 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5894 & ADtEAderx(1,1,1,1,1,1))
5896 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5897 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5898 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5899 & ADtEA1derx(1,1,1,1,1,1))
5901 C End 6-th order cumulants
5904 cd write (2,*) 'In calc_eello6'
5906 cd write (2,*) 'iii=',iii
5908 cd write (2,*) 'kkk=',kkk
5910 cd write (2,'(3(2f10.5),5x)')
5911 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5916 call transpose2(EUgder(1,1,k),auxmat(1,1))
5917 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5918 call transpose2(EUg(1,1,k),auxmat(1,1))
5919 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5920 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5924 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5925 & EAEAderx(1,1,lll,kkk,iii,1))
5929 C A1T kernel(i+1) A2
5930 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5931 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5932 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5933 C Following matrices are needed only for 6-th order cumulants
5934 IF (wcorr6.gt.0.0d0) THEN
5935 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5936 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5937 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5938 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5939 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5940 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5941 & ADtEAderx(1,1,1,1,1,2))
5942 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5943 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5944 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5945 & ADtEA1derx(1,1,1,1,1,2))
5947 C End 6-th order cumulants
5948 call transpose2(EUgder(1,1,l),auxmat(1,1))
5949 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5950 call transpose2(EUg(1,1,l),auxmat(1,1))
5951 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5952 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5956 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5957 & EAEAderx(1,1,lll,kkk,iii,2))
5962 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5963 C They are needed only when the fifth- or the sixth-order cumulants are
5965 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5966 call transpose2(AEA(1,1,1),auxmat(1,1))
5967 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5968 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5969 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5970 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5971 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5972 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5973 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5974 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5975 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5976 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5977 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5978 call transpose2(AEA(1,1,2),auxmat(1,1))
5979 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5980 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5981 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5982 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5983 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5984 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5985 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5986 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5987 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5988 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5989 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5990 C Calculate the Cartesian derivatives of the vectors.
5994 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5995 call matvec2(auxmat(1,1),b1(1,iti),
5996 & AEAb1derx(1,lll,kkk,iii,1,1))
5997 call matvec2(auxmat(1,1),Ub2(1,i),
5998 & AEAb2derx(1,lll,kkk,iii,1,1))
5999 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6000 & AEAb1derx(1,lll,kkk,iii,2,1))
6001 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6002 & AEAb2derx(1,lll,kkk,iii,2,1))
6003 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6004 call matvec2(auxmat(1,1),b1(1,itj),
6005 & AEAb1derx(1,lll,kkk,iii,1,2))
6006 call matvec2(auxmat(1,1),Ub2(1,j),
6007 & AEAb2derx(1,lll,kkk,iii,1,2))
6008 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6009 & AEAb1derx(1,lll,kkk,iii,2,2))
6010 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6011 & AEAb2derx(1,lll,kkk,iii,2,2))
6018 C Antiparallel orientation of the two CA-CA-CA frames.
6019 if (i.gt.1 .and. itype(i).le.ntyp) then
6020 iti=itortyp(itype(i))
6024 itk1=itortyp(itype(k+1))
6025 itl=itortyp(itype(l))
6026 itj=itortyp(itype(j))
6027 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6028 itj1=itortyp(itype(j+1))
6032 C A2 kernel(j-1)T A1T
6033 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6034 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6035 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6036 C Following matrices are needed only for 6-th order cumulants
6037 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6038 & j.eq.i+4 .and. l.eq.i+3)) THEN
6039 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6040 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6041 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6042 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6043 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6044 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6045 & ADtEAderx(1,1,1,1,1,1))
6046 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6047 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6048 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6049 & ADtEA1derx(1,1,1,1,1,1))
6051 C End 6-th order cumulants
6052 call transpose2(EUgder(1,1,k),auxmat(1,1))
6053 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6054 call transpose2(EUg(1,1,k),auxmat(1,1))
6055 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6056 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6060 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6061 & EAEAderx(1,1,lll,kkk,iii,1))
6065 C A2T kernel(i+1)T A1
6066 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6067 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6068 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6069 C Following matrices are needed only for 6-th order cumulants
6070 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6071 & j.eq.i+4 .and. l.eq.i+3)) THEN
6072 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6073 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6074 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6075 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6076 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6077 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6078 & ADtEAderx(1,1,1,1,1,2))
6079 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6080 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6081 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6082 & ADtEA1derx(1,1,1,1,1,2))
6084 C End 6-th order cumulants
6085 call transpose2(EUgder(1,1,j),auxmat(1,1))
6086 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6087 call transpose2(EUg(1,1,j),auxmat(1,1))
6088 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6089 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6093 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6094 & EAEAderx(1,1,lll,kkk,iii,2))
6099 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6100 C They are needed only when the fifth- or the sixth-order cumulants are
6102 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6103 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6104 call transpose2(AEA(1,1,1),auxmat(1,1))
6105 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6106 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6107 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6108 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6109 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6110 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6111 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6112 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6113 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6114 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6115 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6116 call transpose2(AEA(1,1,2),auxmat(1,1))
6117 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6118 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6119 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6120 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6121 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6122 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6123 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6124 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6125 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6126 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6127 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6128 C Calculate the Cartesian derivatives of the vectors.
6132 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6133 call matvec2(auxmat(1,1),b1(1,iti),
6134 & AEAb1derx(1,lll,kkk,iii,1,1))
6135 call matvec2(auxmat(1,1),Ub2(1,i),
6136 & AEAb2derx(1,lll,kkk,iii,1,1))
6137 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6138 & AEAb1derx(1,lll,kkk,iii,2,1))
6139 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6140 & AEAb2derx(1,lll,kkk,iii,2,1))
6141 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6142 call matvec2(auxmat(1,1),b1(1,itl),
6143 & AEAb1derx(1,lll,kkk,iii,1,2))
6144 call matvec2(auxmat(1,1),Ub2(1,l),
6145 & AEAb2derx(1,lll,kkk,iii,1,2))
6146 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6147 & AEAb1derx(1,lll,kkk,iii,2,2))
6148 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6149 & AEAb2derx(1,lll,kkk,iii,2,2))
6158 C---------------------------------------------------------------------------
6159 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6160 & KK,KKderg,AKA,AKAderg,AKAderx)
6164 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6165 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6166 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6171 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6173 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6176 cd if (lprn) write (2,*) 'In kernel'
6178 cd if (lprn) write (2,*) 'kkk=',kkk
6180 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6181 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6183 cd write (2,*) 'lll=',lll
6184 cd write (2,*) 'iii=1'
6186 cd write (2,'(3(2f10.5),5x)')
6187 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6190 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6191 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6193 cd write (2,*) 'lll=',lll
6194 cd write (2,*) 'iii=2'
6196 cd write (2,'(3(2f10.5),5x)')
6197 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6204 C---------------------------------------------------------------------------
6205 double precision function eello4(i,j,k,l,jj,kk)
6206 implicit real*8 (a-h,o-z)
6207 include 'DIMENSIONS'
6208 include 'DIMENSIONS.ZSCOPT'
6209 include 'COMMON.IOUNITS'
6210 include 'COMMON.CHAIN'
6211 include 'COMMON.DERIV'
6212 include 'COMMON.INTERACT'
6213 include 'COMMON.CONTACTS'
6214 include 'COMMON.TORSION'
6215 include 'COMMON.VAR'
6216 include 'COMMON.GEO'
6217 double precision pizda(2,2),ggg1(3),ggg2(3)
6218 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6222 cd print *,'eello4:',i,j,k,l,jj,kk
6223 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6224 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6225 cold eij=facont_hb(jj,i)
6226 cold ekl=facont_hb(kk,k)
6228 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6230 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6231 gcorr_loc(k-1)=gcorr_loc(k-1)
6232 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6234 gcorr_loc(l-1)=gcorr_loc(l-1)
6235 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6237 gcorr_loc(j-1)=gcorr_loc(j-1)
6238 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6243 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6244 & -EAEAderx(2,2,lll,kkk,iii,1)
6245 cd derx(lll,kkk,iii)=0.0d0
6249 cd gcorr_loc(l-1)=0.0d0
6250 cd gcorr_loc(j-1)=0.0d0
6251 cd gcorr_loc(k-1)=0.0d0
6253 cd write (iout,*)'Contacts have occurred for peptide groups',
6254 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6255 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6256 if (j.lt.nres-1) then
6263 if (l.lt.nres-1) then
6271 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6272 ggg1(ll)=eel4*g_contij(ll,1)
6273 ggg2(ll)=eel4*g_contij(ll,2)
6274 ghalf=0.5d0*ggg1(ll)
6276 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6277 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6278 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6279 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6280 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6281 ghalf=0.5d0*ggg2(ll)
6283 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6284 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6285 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6286 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6291 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6292 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6297 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6298 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6304 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6309 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6313 cd write (2,*) iii,gcorr_loc(iii)
6317 cd write (2,*) 'ekont',ekont
6318 cd write (iout,*) 'eello4',ekont*eel4
6321 C---------------------------------------------------------------------------
6322 double precision function eello5(i,j,k,l,jj,kk)
6323 implicit real*8 (a-h,o-z)
6324 include 'DIMENSIONS'
6325 include 'DIMENSIONS.ZSCOPT'
6326 include 'COMMON.IOUNITS'
6327 include 'COMMON.CHAIN'
6328 include 'COMMON.DERIV'
6329 include 'COMMON.INTERACT'
6330 include 'COMMON.CONTACTS'
6331 include 'COMMON.TORSION'
6332 include 'COMMON.VAR'
6333 include 'COMMON.GEO'
6334 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6335 double precision ggg1(3),ggg2(3)
6336 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6341 C /l\ / \ \ / \ / \ / C
6342 C / \ / \ \ / \ / \ / C
6343 C j| o |l1 | o | o| o | | o |o C
6344 C \ |/k\| |/ \| / |/ \| |/ \| C
6345 C \i/ \ / \ / / \ / \ C
6347 C (I) (II) (III) (IV) C
6349 C eello5_1 eello5_2 eello5_3 eello5_4 C
6351 C Antiparallel chains C
6354 C /j\ / \ \ / \ / \ / C
6355 C / \ / \ \ / \ / \ / C
6356 C j1| o |l | o | o| o | | o |o C
6357 C \ |/k\| |/ \| / |/ \| |/ \| C
6358 C \i/ \ / \ / / \ / \ C
6360 C (I) (II) (III) (IV) C
6362 C eello5_1 eello5_2 eello5_3 eello5_4 C
6364 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6366 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6367 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6372 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6374 itk=itortyp(itype(k))
6375 itl=itortyp(itype(l))
6376 itj=itortyp(itype(j))
6381 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6382 cd & eel5_3_num,eel5_4_num)
6386 derx(lll,kkk,iii)=0.0d0
6390 cd eij=facont_hb(jj,i)
6391 cd ekl=facont_hb(kk,k)
6393 cd write (iout,*)'Contacts have occurred for peptide groups',
6394 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6396 C Contribution from the graph I.
6397 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6398 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6399 call transpose2(EUg(1,1,k),auxmat(1,1))
6400 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6401 vv(1)=pizda(1,1)-pizda(2,2)
6402 vv(2)=pizda(1,2)+pizda(2,1)
6403 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6404 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6406 C Explicit gradient in virtual-dihedral angles.
6407 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6408 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6409 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6410 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6411 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6412 vv(1)=pizda(1,1)-pizda(2,2)
6413 vv(2)=pizda(1,2)+pizda(2,1)
6414 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6415 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6416 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6417 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6418 vv(1)=pizda(1,1)-pizda(2,2)
6419 vv(2)=pizda(1,2)+pizda(2,1)
6421 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6422 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6423 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6425 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6426 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6427 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6429 C Cartesian gradient
6433 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6435 vv(1)=pizda(1,1)-pizda(2,2)
6436 vv(2)=pizda(1,2)+pizda(2,1)
6437 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6438 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6439 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6446 C Contribution from graph II
6447 call transpose2(EE(1,1,itk),auxmat(1,1))
6448 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6449 vv(1)=pizda(1,1)+pizda(2,2)
6450 vv(2)=pizda(2,1)-pizda(1,2)
6451 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6452 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6454 C Explicit gradient in virtual-dihedral angles.
6455 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6456 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6457 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6458 vv(1)=pizda(1,1)+pizda(2,2)
6459 vv(2)=pizda(2,1)-pizda(1,2)
6461 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6462 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6463 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6465 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6466 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6467 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6469 C Cartesian gradient
6473 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6475 vv(1)=pizda(1,1)+pizda(2,2)
6476 vv(2)=pizda(2,1)-pizda(1,2)
6477 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6478 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6479 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6488 C Parallel orientation
6489 C Contribution from graph III
6490 call transpose2(EUg(1,1,l),auxmat(1,1))
6491 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6492 vv(1)=pizda(1,1)-pizda(2,2)
6493 vv(2)=pizda(1,2)+pizda(2,1)
6494 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6495 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6497 C Explicit gradient in virtual-dihedral angles.
6498 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6499 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6500 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6501 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6502 vv(1)=pizda(1,1)-pizda(2,2)
6503 vv(2)=pizda(1,2)+pizda(2,1)
6504 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6505 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6506 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6507 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6508 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6509 vv(1)=pizda(1,1)-pizda(2,2)
6510 vv(2)=pizda(1,2)+pizda(2,1)
6511 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6512 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6513 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6514 C Cartesian gradient
6518 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6520 vv(1)=pizda(1,1)-pizda(2,2)
6521 vv(2)=pizda(1,2)+pizda(2,1)
6522 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6523 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6524 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6530 C Contribution from graph IV
6532 call transpose2(EE(1,1,itl),auxmat(1,1))
6533 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6534 vv(1)=pizda(1,1)+pizda(2,2)
6535 vv(2)=pizda(2,1)-pizda(1,2)
6536 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6537 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6539 C Explicit gradient in virtual-dihedral angles.
6540 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6541 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6542 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6543 vv(1)=pizda(1,1)+pizda(2,2)
6544 vv(2)=pizda(2,1)-pizda(1,2)
6545 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6546 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6547 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6548 C Cartesian gradient
6552 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6554 vv(1)=pizda(1,1)+pizda(2,2)
6555 vv(2)=pizda(2,1)-pizda(1,2)
6556 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6557 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6558 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6564 C Antiparallel orientation
6565 C Contribution from graph III
6567 call transpose2(EUg(1,1,j),auxmat(1,1))
6568 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6569 vv(1)=pizda(1,1)-pizda(2,2)
6570 vv(2)=pizda(1,2)+pizda(2,1)
6571 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6572 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6574 C Explicit gradient in virtual-dihedral angles.
6575 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6576 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6577 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6578 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6579 vv(1)=pizda(1,1)-pizda(2,2)
6580 vv(2)=pizda(1,2)+pizda(2,1)
6581 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6582 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6583 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6584 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6585 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6586 vv(1)=pizda(1,1)-pizda(2,2)
6587 vv(2)=pizda(1,2)+pizda(2,1)
6588 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6589 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6590 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6591 C Cartesian gradient
6595 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6597 vv(1)=pizda(1,1)-pizda(2,2)
6598 vv(2)=pizda(1,2)+pizda(2,1)
6599 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6600 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6601 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6607 C Contribution from graph IV
6609 call transpose2(EE(1,1,itj),auxmat(1,1))
6610 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6611 vv(1)=pizda(1,1)+pizda(2,2)
6612 vv(2)=pizda(2,1)-pizda(1,2)
6613 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6614 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6616 C Explicit gradient in virtual-dihedral angles.
6617 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6618 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6619 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6620 vv(1)=pizda(1,1)+pizda(2,2)
6621 vv(2)=pizda(2,1)-pizda(1,2)
6622 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6623 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6624 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6625 C Cartesian gradient
6629 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6631 vv(1)=pizda(1,1)+pizda(2,2)
6632 vv(2)=pizda(2,1)-pizda(1,2)
6633 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6634 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6635 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6642 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6643 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6644 cd write (2,*) 'ijkl',i,j,k,l
6645 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6646 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6648 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6649 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6650 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6651 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6653 if (j.lt.nres-1) then
6660 if (l.lt.nres-1) then
6670 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6672 ggg1(ll)=eel5*g_contij(ll,1)
6673 ggg2(ll)=eel5*g_contij(ll,2)
6674 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6675 ghalf=0.5d0*ggg1(ll)
6677 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6678 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6679 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6680 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6681 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6682 ghalf=0.5d0*ggg2(ll)
6684 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6685 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6686 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6687 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6692 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6693 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6698 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6699 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6705 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6710 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6714 cd write (2,*) iii,g_corr5_loc(iii)
6718 cd write (2,*) 'ekont',ekont
6719 cd write (iout,*) 'eello5',ekont*eel5
6722 c--------------------------------------------------------------------------
6723 double precision function eello6(i,j,k,l,jj,kk)
6724 implicit real*8 (a-h,o-z)
6725 include 'DIMENSIONS'
6726 include 'DIMENSIONS.ZSCOPT'
6727 include 'COMMON.IOUNITS'
6728 include 'COMMON.CHAIN'
6729 include 'COMMON.DERIV'
6730 include 'COMMON.INTERACT'
6731 include 'COMMON.CONTACTS'
6732 include 'COMMON.TORSION'
6733 include 'COMMON.VAR'
6734 include 'COMMON.GEO'
6735 include 'COMMON.FFIELD'
6736 double precision ggg1(3),ggg2(3)
6737 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6742 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6750 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6751 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6755 derx(lll,kkk,iii)=0.0d0
6759 cd eij=facont_hb(jj,i)
6760 cd ekl=facont_hb(kk,k)
6766 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6767 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6768 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6769 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6770 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6771 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6773 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6774 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6775 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6776 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6777 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6778 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6782 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6784 C If turn contributions are considered, they will be handled separately.
6785 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6786 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6787 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6788 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6789 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6790 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6791 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6794 if (j.lt.nres-1) then
6801 if (l.lt.nres-1) then
6809 ggg1(ll)=eel6*g_contij(ll,1)
6810 ggg2(ll)=eel6*g_contij(ll,2)
6811 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6812 ghalf=0.5d0*ggg1(ll)
6814 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6815 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6816 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6817 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6818 ghalf=0.5d0*ggg2(ll)
6819 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6821 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6822 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6823 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6824 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6829 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6830 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6835 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6836 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6842 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6847 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6851 cd write (2,*) iii,g_corr6_loc(iii)
6855 cd write (2,*) 'ekont',ekont
6856 cd write (iout,*) 'eello6',ekont*eel6
6859 c--------------------------------------------------------------------------
6860 double precision function eello6_graph1(i,j,k,l,imat,swap)
6861 implicit real*8 (a-h,o-z)
6862 include 'DIMENSIONS'
6863 include 'DIMENSIONS.ZSCOPT'
6864 include 'COMMON.IOUNITS'
6865 include 'COMMON.CHAIN'
6866 include 'COMMON.DERIV'
6867 include 'COMMON.INTERACT'
6868 include 'COMMON.CONTACTS'
6869 include 'COMMON.TORSION'
6870 include 'COMMON.VAR'
6871 include 'COMMON.GEO'
6872 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6876 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6878 C Parallel Antiparallel C
6884 C \ j|/k\| / \ |/k\|l / C
6889 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6890 itk=itortyp(itype(k))
6891 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6892 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6893 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6894 call transpose2(EUgC(1,1,k),auxmat(1,1))
6895 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6896 vv1(1)=pizda1(1,1)-pizda1(2,2)
6897 vv1(2)=pizda1(1,2)+pizda1(2,1)
6898 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6899 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6900 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6901 s5=scalar2(vv(1),Dtobr2(1,i))
6902 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6903 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6904 if (.not. calc_grad) return
6905 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6906 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6907 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6908 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6909 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6910 & +scalar2(vv(1),Dtobr2der(1,i)))
6911 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6912 vv1(1)=pizda1(1,1)-pizda1(2,2)
6913 vv1(2)=pizda1(1,2)+pizda1(2,1)
6914 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6915 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6917 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6918 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6919 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6920 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6921 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6923 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6924 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6925 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6926 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6927 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6929 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6930 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6931 vv1(1)=pizda1(1,1)-pizda1(2,2)
6932 vv1(2)=pizda1(1,2)+pizda1(2,1)
6933 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6934 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6935 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6936 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6945 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6946 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6947 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6948 call transpose2(EUgC(1,1,k),auxmat(1,1))
6949 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6951 vv1(1)=pizda1(1,1)-pizda1(2,2)
6952 vv1(2)=pizda1(1,2)+pizda1(2,1)
6953 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6954 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6955 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6956 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6957 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6958 s5=scalar2(vv(1),Dtobr2(1,i))
6959 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6965 c----------------------------------------------------------------------------
6966 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6967 implicit real*8 (a-h,o-z)
6968 include 'DIMENSIONS'
6969 include 'DIMENSIONS.ZSCOPT'
6970 include 'COMMON.IOUNITS'
6971 include 'COMMON.CHAIN'
6972 include 'COMMON.DERIV'
6973 include 'COMMON.INTERACT'
6974 include 'COMMON.CONTACTS'
6975 include 'COMMON.TORSION'
6976 include 'COMMON.VAR'
6977 include 'COMMON.GEO'
6979 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6980 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6983 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6985 C Parallel Antiparallel C
6991 C \ j|/k\| \ |/k\|l C
6996 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6997 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6998 C AL 7/4/01 s1 would occur in the sixth-order moment,
6999 C but not in a cluster cumulant
7001 s1=dip(1,jj,i)*dip(1,kk,k)
7003 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7004 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7005 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7006 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7007 call transpose2(EUg(1,1,k),auxmat(1,1))
7008 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7009 vv(1)=pizda(1,1)-pizda(2,2)
7010 vv(2)=pizda(1,2)+pizda(2,1)
7011 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7012 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7014 eello6_graph2=-(s1+s2+s3+s4)
7016 eello6_graph2=-(s2+s3+s4)
7019 if (.not. calc_grad) return
7020 C Derivatives in gamma(i-1)
7023 s1=dipderg(1,jj,i)*dip(1,kk,k)
7025 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7026 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7027 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7028 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7030 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7032 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7034 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7036 C Derivatives in gamma(k-1)
7038 s1=dip(1,jj,i)*dipderg(1,kk,k)
7040 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7041 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7042 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7043 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7044 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7045 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7046 vv(1)=pizda(1,1)-pizda(2,2)
7047 vv(2)=pizda(1,2)+pizda(2,1)
7048 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7050 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7052 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7054 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7055 C Derivatives in gamma(j-1) or gamma(l-1)
7058 s1=dipderg(3,jj,i)*dip(1,kk,k)
7060 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7061 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7062 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7063 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7064 vv(1)=pizda(1,1)-pizda(2,2)
7065 vv(2)=pizda(1,2)+pizda(2,1)
7066 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7069 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7071 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7074 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7075 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7077 C Derivatives in gamma(l-1) or gamma(j-1)
7080 s1=dip(1,jj,i)*dipderg(3,kk,k)
7082 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7083 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7084 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7085 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7086 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7087 vv(1)=pizda(1,1)-pizda(2,2)
7088 vv(2)=pizda(1,2)+pizda(2,1)
7089 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7092 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7094 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7097 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7098 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7100 C Cartesian derivatives.
7102 write (2,*) 'In eello6_graph2'
7104 write (2,*) 'iii=',iii
7106 write (2,*) 'kkk=',kkk
7108 write (2,'(3(2f10.5),5x)')
7109 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7119 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7121 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7124 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7126 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7127 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7129 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7130 call transpose2(EUg(1,1,k),auxmat(1,1))
7131 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7133 vv(1)=pizda(1,1)-pizda(2,2)
7134 vv(2)=pizda(1,2)+pizda(2,1)
7135 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7136 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7138 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7140 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7143 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7145 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7152 c----------------------------------------------------------------------------
7153 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7154 implicit real*8 (a-h,o-z)
7155 include 'DIMENSIONS'
7156 include 'DIMENSIONS.ZSCOPT'
7157 include 'COMMON.IOUNITS'
7158 include 'COMMON.CHAIN'
7159 include 'COMMON.DERIV'
7160 include 'COMMON.INTERACT'
7161 include 'COMMON.CONTACTS'
7162 include 'COMMON.TORSION'
7163 include 'COMMON.VAR'
7164 include 'COMMON.GEO'
7165 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7167 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7169 C Parallel Antiparallel C
7175 C j|/k\| / |/k\|l / C
7180 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7182 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7183 C energy moment and not to the cluster cumulant.
7184 iti=itortyp(itype(i))
7185 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7186 itj1=itortyp(itype(j+1))
7190 itk=itortyp(itype(k))
7191 itk1=itortyp(itype(k+1))
7192 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7193 itl1=itortyp(itype(l+1))
7198 s1=dip(4,jj,i)*dip(4,kk,k)
7200 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7201 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7202 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7203 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7204 call transpose2(EE(1,1,itk),auxmat(1,1))
7205 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7206 vv(1)=pizda(1,1)+pizda(2,2)
7207 vv(2)=pizda(2,1)-pizda(1,2)
7208 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7209 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7211 eello6_graph3=-(s1+s2+s3+s4)
7213 eello6_graph3=-(s2+s3+s4)
7216 if (.not. calc_grad) return
7217 C Derivatives in gamma(k-1)
7218 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7219 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7220 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7221 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7222 C Derivatives in gamma(l-1)
7223 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7224 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7225 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7226 vv(1)=pizda(1,1)+pizda(2,2)
7227 vv(2)=pizda(2,1)-pizda(1,2)
7228 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7229 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7230 C Cartesian derivatives.
7236 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7238 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7241 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7243 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7244 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7246 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7247 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7249 vv(1)=pizda(1,1)+pizda(2,2)
7250 vv(2)=pizda(2,1)-pizda(1,2)
7251 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7253 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7255 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7258 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7260 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7262 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7268 c----------------------------------------------------------------------------
7269 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7270 implicit real*8 (a-h,o-z)
7271 include 'DIMENSIONS'
7272 include 'DIMENSIONS.ZSCOPT'
7273 include 'COMMON.IOUNITS'
7274 include 'COMMON.CHAIN'
7275 include 'COMMON.DERIV'
7276 include 'COMMON.INTERACT'
7277 include 'COMMON.CONTACTS'
7278 include 'COMMON.TORSION'
7279 include 'COMMON.VAR'
7280 include 'COMMON.GEO'
7281 include 'COMMON.FFIELD'
7282 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7283 & auxvec1(2),auxmat1(2,2)
7285 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7287 C Parallel Antiparallel C
7293 C \ j|/k\| \ |/k\|l C
7298 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7300 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7301 C energy moment and not to the cluster cumulant.
7302 cd write (2,*) 'eello_graph4: wturn6',wturn6
7303 iti=itortyp(itype(i))
7304 itj=itortyp(itype(j))
7305 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7306 itj1=itortyp(itype(j+1))
7310 itk=itortyp(itype(k))
7311 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7312 itk1=itortyp(itype(k+1))
7316 itl=itortyp(itype(l))
7317 if (l.lt.nres-1) then
7318 itl1=itortyp(itype(l+1))
7322 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7323 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7324 cd & ' itl',itl,' itl1',itl1
7327 s1=dip(3,jj,i)*dip(3,kk,k)
7329 s1=dip(2,jj,j)*dip(2,kk,l)
7332 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7333 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7335 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7336 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7338 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7339 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7341 call transpose2(EUg(1,1,k),auxmat(1,1))
7342 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7343 vv(1)=pizda(1,1)-pizda(2,2)
7344 vv(2)=pizda(2,1)+pizda(1,2)
7345 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7346 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7348 eello6_graph4=-(s1+s2+s3+s4)
7350 eello6_graph4=-(s2+s3+s4)
7352 if (.not. calc_grad) return
7353 C Derivatives in gamma(i-1)
7357 s1=dipderg(2,jj,i)*dip(3,kk,k)
7359 s1=dipderg(4,jj,j)*dip(2,kk,l)
7362 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7364 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7365 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7367 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7368 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7370 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7371 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7372 cd write (2,*) 'turn6 derivatives'
7374 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7376 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7380 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7382 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7386 C Derivatives in gamma(k-1)
7389 s1=dip(3,jj,i)*dipderg(2,kk,k)
7391 s1=dip(2,jj,j)*dipderg(4,kk,l)
7394 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7395 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7397 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7398 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7400 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7401 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7403 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7404 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7405 vv(1)=pizda(1,1)-pizda(2,2)
7406 vv(2)=pizda(2,1)+pizda(1,2)
7407 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7408 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7410 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7412 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7416 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7418 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7421 C Derivatives in gamma(j-1) or gamma(l-1)
7422 if (l.eq.j+1 .and. l.gt.1) then
7423 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7424 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7425 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7426 vv(1)=pizda(1,1)-pizda(2,2)
7427 vv(2)=pizda(2,1)+pizda(1,2)
7428 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7429 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7430 else if (j.gt.1) then
7431 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7432 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7433 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7434 vv(1)=pizda(1,1)-pizda(2,2)
7435 vv(2)=pizda(2,1)+pizda(1,2)
7436 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7437 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7438 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7440 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7443 C Cartesian derivatives.
7450 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7452 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7456 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7458 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7462 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7464 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7466 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7467 & b1(1,itj1),auxvec(1))
7468 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7470 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7471 & b1(1,itl1),auxvec(1))
7472 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7474 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7476 vv(1)=pizda(1,1)-pizda(2,2)
7477 vv(2)=pizda(2,1)+pizda(1,2)
7478 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7480 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7482 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7485 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7488 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7491 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7493 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7495 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7499 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7501 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7504 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7506 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7514 c----------------------------------------------------------------------------
7515 double precision function eello_turn6(i,jj,kk)
7516 implicit real*8 (a-h,o-z)
7517 include 'DIMENSIONS'
7518 include 'DIMENSIONS.ZSCOPT'
7519 include 'COMMON.IOUNITS'
7520 include 'COMMON.CHAIN'
7521 include 'COMMON.DERIV'
7522 include 'COMMON.INTERACT'
7523 include 'COMMON.CONTACTS'
7524 include 'COMMON.TORSION'
7525 include 'COMMON.VAR'
7526 include 'COMMON.GEO'
7527 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7528 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7530 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7531 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7532 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7533 C the respective energy moment and not to the cluster cumulant.
7538 iti=itortyp(itype(i))
7539 itk=itortyp(itype(k))
7540 itk1=itortyp(itype(k+1))
7541 itl=itortyp(itype(l))
7542 itj=itortyp(itype(j))
7543 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7544 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7545 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7550 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7552 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7556 derx_turn(lll,kkk,iii)=0.0d0
7563 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7565 cd write (2,*) 'eello6_5',eello6_5
7567 call transpose2(AEA(1,1,1),auxmat(1,1))
7568 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7569 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7570 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7574 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7575 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7576 s2 = scalar2(b1(1,itk),vtemp1(1))
7578 call transpose2(AEA(1,1,2),atemp(1,1))
7579 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7580 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7581 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7585 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7586 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7587 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7589 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7590 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7591 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7592 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7593 ss13 = scalar2(b1(1,itk),vtemp4(1))
7594 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7598 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7604 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7606 C Derivatives in gamma(i+2)
7608 call transpose2(AEA(1,1,1),auxmatd(1,1))
7609 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7610 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7611 call transpose2(AEAderg(1,1,2),atempd(1,1))
7612 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7613 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7617 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7618 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7619 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7625 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7626 C Derivatives in gamma(i+3)
7628 call transpose2(AEA(1,1,1),auxmatd(1,1))
7629 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7630 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7631 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7635 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7636 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7637 s2d = scalar2(b1(1,itk),vtemp1d(1))
7639 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7640 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7642 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7644 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7645 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7646 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7656 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7657 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7659 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7660 & -0.5d0*ekont*(s2d+s12d)
7662 C Derivatives in gamma(i+4)
7663 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7664 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7665 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7667 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7668 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7669 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7679 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7681 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7683 C Derivatives in gamma(i+5)
7685 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7686 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7687 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7691 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7692 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7693 s2d = scalar2(b1(1,itk),vtemp1d(1))
7695 call transpose2(AEA(1,1,2),atempd(1,1))
7696 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7697 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7701 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7702 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7704 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7705 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7706 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7716 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7717 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7719 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7720 & -0.5d0*ekont*(s2d+s12d)
7722 C Cartesian derivatives
7727 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7728 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7729 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7733 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7734 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7736 s2d = scalar2(b1(1,itk),vtemp1d(1))
7738 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7739 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7740 s8d = -(atempd(1,1)+atempd(2,2))*
7741 & scalar2(cc(1,1,itl),vtemp2(1))
7745 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7747 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7748 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7755 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7758 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7762 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7763 & - 0.5d0*(s8d+s12d)
7765 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7774 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7776 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7777 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7778 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7779 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7780 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7782 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7783 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7784 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7788 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7789 cd & 16*eel_turn6_num
7791 if (j.lt.nres-1) then
7798 if (l.lt.nres-1) then
7806 ggg1(ll)=eel_turn6*g_contij(ll,1)
7807 ggg2(ll)=eel_turn6*g_contij(ll,2)
7808 ghalf=0.5d0*ggg1(ll)
7810 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7811 & +ekont*derx_turn(ll,2,1)
7812 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7813 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7814 & +ekont*derx_turn(ll,4,1)
7815 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7816 ghalf=0.5d0*ggg2(ll)
7818 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7819 & +ekont*derx_turn(ll,2,2)
7820 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7821 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7822 & +ekont*derx_turn(ll,4,2)
7823 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7828 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7833 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7839 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7844 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7848 cd write (2,*) iii,g_corr6_loc(iii)
7851 eello_turn6=ekont*eel_turn6
7852 cd write (2,*) 'ekont',ekont
7853 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7856 crc-------------------------------------------------
7857 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7858 subroutine Eliptransfer(eliptran)
7859 implicit real*8 (a-h,o-z)
7860 include 'DIMENSIONS'
7861 include 'COMMON.GEO'
7862 include 'COMMON.VAR'
7863 include 'COMMON.LOCAL'
7864 include 'COMMON.CHAIN'
7865 include 'COMMON.DERIV'
7866 include 'COMMON.INTERACT'
7867 include 'COMMON.IOUNITS'
7868 include 'COMMON.CALC'
7869 include 'COMMON.CONTROL'
7870 include 'COMMON.SPLITELE'
7871 include 'COMMON.SBRIDGE'
7872 C this is done by Adasko
7876 C--bordliptop-- buffore starts
7877 C--bufliptop--- here true lipid starts
7879 C--buflipbot--- lipid ends buffore starts
7880 C--bordlipbot--buffore ends
7884 if (itype(i).eq.ntyp1) cycle
7886 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
7887 if (positi.le.0) positi=positi+boxzsize
7889 C first for peptide groups
7890 c for each residue check if it is in lipid or lipid water border area
7891 if ((positi.gt.bordlipbot)
7892 &.and.(positi.lt.bordliptop)) then
7893 C the energy transfer exist
7894 if (positi.lt.buflipbot) then
7895 C what fraction I am in
7897 & ((positi-bordlipbot)/lipbufthick)
7898 C lipbufthick is thickenes of lipid buffore
7899 sslip=sscalelip(fracinbuf)
7900 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7901 eliptran=eliptran+sslip*pepliptran
7902 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7903 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7904 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7905 elseif (positi.gt.bufliptop) then
7906 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
7907 sslip=sscalelip(fracinbuf)
7908 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7909 eliptran=eliptran+sslip*pepliptran
7910 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7911 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7912 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7913 C print *, "doing sscalefor top part"
7914 C print *,i,sslip,fracinbuf,ssgradlip
7916 eliptran=eliptran+pepliptran
7917 C print *,"I am in true lipid"
7920 C eliptran=elpitran+0.0 ! I am in water
7923 C print *, "nic nie bylo w lipidzie?"
7924 C now multiply all by the peptide group transfer factor
7925 C eliptran=eliptran*pepliptran
7926 C now the same for side chains
7929 if (itype(i).eq.ntyp1) cycle
7930 positi=(mod(c(3,i+nres),boxzsize))
7931 if (positi.le.0) positi=positi+boxzsize
7932 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
7933 c for each residue check if it is in lipid or lipid water border area
7934 C respos=mod(c(3,i+nres),boxzsize)
7935 C print *,positi,bordlipbot,buflipbot
7936 if ((positi.gt.bordlipbot)
7937 & .and.(positi.lt.bordliptop)) then
7938 C the energy transfer exist
7939 if (positi.lt.buflipbot) then
7941 & ((positi-bordlipbot)/lipbufthick)
7942 C lipbufthick is thickenes of lipid buffore
7943 sslip=sscalelip(fracinbuf)
7944 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7945 eliptran=eliptran+sslip*liptranene(itype(i))
7946 gliptranx(3,i)=gliptranx(3,i)
7947 &+ssgradlip*liptranene(itype(i))
7948 gliptranc(3,i-1)= gliptranc(3,i-1)
7949 &+ssgradlip*liptranene(itype(i))
7950 C print *,"doing sccale for lower part"
7951 elseif (positi.gt.bufliptop) then
7953 &((bordliptop-positi)/lipbufthick)
7954 sslip=sscalelip(fracinbuf)
7955 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7956 eliptran=eliptran+sslip*liptranene(itype(i))
7957 gliptranx(3,i)=gliptranx(3,i)
7958 &+ssgradlip*liptranene(itype(i))
7959 gliptranc(3,i-1)= gliptranc(3,i-1)
7960 &+ssgradlip*liptranene(itype(i))
7961 C print *, "doing sscalefor top part",sslip,fracinbuf
7963 eliptran=eliptran+liptranene(itype(i))
7964 C print *,"I am in true lipid"
7966 endif ! if in lipid or buffor
7968 C eliptran=elpitran+0.0 ! I am in water
7974 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7976 SUBROUTINE MATVEC2(A1,V1,V2)
7977 implicit real*8 (a-h,o-z)
7978 include 'DIMENSIONS'
7979 DIMENSION A1(2,2),V1(2),V2(2)
7983 c 3 VI=VI+A1(I,K)*V1(K)
7987 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7988 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7993 C---------------------------------------
7994 SUBROUTINE MATMAT2(A1,A2,A3)
7995 implicit real*8 (a-h,o-z)
7996 include 'DIMENSIONS'
7997 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7998 c DIMENSION AI3(2,2)
8002 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8008 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8009 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8010 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8011 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8019 c-------------------------------------------------------------------------
8020 double precision function scalar2(u,v)
8022 double precision u(2),v(2)
8025 scalar2=u(1)*v(1)+u(2)*v(2)
8029 C-----------------------------------------------------------------------------
8031 subroutine transpose2(a,at)
8033 double precision a(2,2),at(2,2)
8040 c--------------------------------------------------------------------------
8041 subroutine transpose(n,a,at)
8044 double precision a(n,n),at(n,n)
8052 C---------------------------------------------------------------------------
8053 subroutine prodmat3(a1,a2,kk,transp,prod)
8056 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8058 crc double precision auxmat(2,2),prod_(2,2)
8061 crc call transpose2(kk(1,1),auxmat(1,1))
8062 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8063 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8065 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8066 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8067 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8068 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8069 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8070 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8071 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8072 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8075 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8076 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8078 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8079 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8080 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8081 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8082 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8083 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8084 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8085 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8088 c call transpose2(a2(1,1),a2t(1,1))
8091 crc print *,((prod_(i,j),i=1,2),j=1,2)
8092 crc print *,((prod(i,j),i=1,2),j=1,2)
8096 C-----------------------------------------------------------------------------
8097 double precision function scalar(u,v)
8099 double precision u(3),v(3)
8109 C-----------------------------------------------------------------------
8110 double precision function sscale(r)
8111 double precision r,gamm
8112 include "COMMON.SPLITELE"
8113 if(r.lt.r_cut-rlamb) then
8115 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8116 gamm=(r-(r_cut-rlamb))/rlamb
8117 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8123 C-----------------------------------------------------------------------
8124 C-----------------------------------------------------------------------
8125 double precision function sscagrad(r)
8126 double precision r,gamm
8127 include "COMMON.SPLITELE"
8128 if(r.lt.r_cut-rlamb) then
8130 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8131 gamm=(r-(r_cut-rlamb))/rlamb
8132 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8138 C-----------------------------------------------------------------------
8139 C-----------------------------------------------------------------------
8140 double precision function sscalelip(r)
8141 double precision r,gamm
8142 include "COMMON.SPLITELE"
8143 C if(r.lt.r_cut-rlamb) then
8145 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8146 C gamm=(r-(r_cut-rlamb))/rlamb
8147 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8153 C-----------------------------------------------------------------------
8154 double precision function sscagradlip(r)
8155 double precision r,gamm
8156 include "COMMON.SPLITELE"
8157 C if(r.lt.r_cut-rlamb) then
8159 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8160 C gamm=(r-(r_cut-rlamb))/rlamb
8161 sscagradlip=r*(6*r-6.0d0)
8168 C-----------------------------------------------------------------------