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.
828 C write(iout,*) i,"i",iatsc_s,iatsc_e
830 if (itypi.eq.ntyp1) cycle
831 itypi1=iabs(itype(i+1))
835 C returning the ith atom to box
837 if (xi.lt.0) xi=xi+boxxsize
839 if (yi.lt.0) yi=yi+boxysize
841 if (zi.lt.0) zi=zi+boxzsize
842 if ((zi.gt.bordlipbot)
843 &.and.(zi.lt.bordliptop)) then
844 C the energy transfer exist
845 if (zi.lt.buflipbot) then
846 C what fraction I am in
848 & ((zi-bordlipbot)/lipbufthick)
849 C lipbufthick is thickenes of lipid buffore
850 sslipi=sscalelip(fracinbuf)
851 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
852 elseif (zi.gt.bufliptop) then
853 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
854 sslipi=sscalelip(fracinbuf)
855 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
865 dxi=dc_norm(1,nres+i)
866 dyi=dc_norm(2,nres+i)
867 dzi=dc_norm(3,nres+i)
868 dsci_inv=vbld_inv(i+nres)
870 C Calculate SC interaction energy.
873 do j=istart(i,iint),iend(i,iint)
874 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
875 call dyn_ssbond_ene(i,j,evdwij)
877 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
878 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
879 C triple bond artifac removal
880 do k=j+1,iend(i,iint)
881 C search over all next residues
882 if (dyn_ss_mask(k)) then
883 C check if they are cysteins
884 C write(iout,*) 'k=',k
885 call triple_ssbond_ene(i,j,k,evdwij)
886 C call the energy function that removes the artifical triple disulfide
887 C bond the soubroutine is located in ssMD.F
889 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
890 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
895 C write(iout,*) j,"j",istart(i,iint),iend(i,iint)
898 if (itypj.eq.ntyp1) cycle
899 dscj_inv=vbld_inv(j+nres)
900 sig0ij=sigma(itypi,itypj)
901 chi1=chi(itypi,itypj)
902 chi2=chi(itypj,itypi)
909 alf12=0.5D0*(alf1+alf2)
910 C For diagnostics only!!!
923 C returning jth atom to box
925 if (xj.lt.0) xj=xj+boxxsize
927 if (yj.lt.0) yj=yj+boxysize
929 if (zj.lt.0) zj=zj+boxzsize
930 if ((zj.gt.bordlipbot)
931 &.and.(zj.lt.bordliptop)) then
932 C the energy transfer exist
933 if (zj.lt.buflipbot) then
934 C what fraction I am in
936 & ((zj-bordlipbot)/lipbufthick)
937 C lipbufthick is thickenes of lipid buffore
938 sslipj=sscalelip(fracinbuf)
939 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
940 elseif (zj.gt.bufliptop) then
941 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
942 sslipj=sscalelip(fracinbuf)
943 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
952 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
953 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
954 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
955 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
956 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
957 C checking the distance
958 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
963 C finding the closest
967 xj=xj_safe+xshift*boxxsize
968 yj=yj_safe+yshift*boxysize
969 zj=zj_safe+zshift*boxzsize
970 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
971 if(dist_temp.lt.dist_init) then
981 if (subchap.eq.1) then
991 dxj=dc_norm(1,nres+j)
992 dyj=dc_norm(2,nres+j)
993 dzj=dc_norm(3,nres+j)
994 c write (iout,*) i,j,xj,yj,zj
995 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
997 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
998 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
999 if (sss.le.0.0) cycle
1000 C Calculate angle-dependent terms of energy and contributions to their
1005 sig=sig0ij*dsqrt(sigsq)
1006 rij_shift=1.0D0/rij-sig+sig0ij
1007 C I hate to put IF's in the loops, but here don't have another choice!!!!
1008 if (rij_shift.le.0.0D0) then
1013 c---------------------------------------------------------------
1014 rij_shift=1.0D0/rij_shift
1015 fac=rij_shift**expon
1018 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1019 eps2der=evdwij*eps3rt
1020 eps3der=evdwij*eps2rt
1021 evdwij=evdwij*eps2rt*eps3rt
1023 evdw=evdw+evdwij*sss
1025 evdw_t=evdw_t+evdwij*sss
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1029 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1030 & /dabs(eps(itypi,itypj))
1031 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1032 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1033 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1034 c & aux*e2/eps(itypi,itypj)
1036 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1039 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1040 & restyp(itypi),i,restyp(itypj),j,
1041 & epsi,sigm,chi1,chi2,chip1,chip2,
1042 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1043 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1045 write (iout,*) "partial sum", evdw, evdw_t
1049 C Calculate gradient components.
1050 e1=e1*eps1*eps2rt**2*eps3rt**2
1051 fac=-expon*(e1+evdwij)*rij_shift
1054 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1055 C Calculate the radial part of the gradient
1059 C Calculate angular part of the gradient.
1062 C write(iout,*) "partial sum", evdw, evdw_t
1069 C-----------------------------------------------------------------------------
1070 subroutine egbv(evdw,evdw_t)
1072 C This subroutine calculates the interaction energy of nonbonded side chains
1073 C assuming the Gay-Berne-Vorobjev potential of interaction.
1075 implicit real*8 (a-h,o-z)
1076 include 'DIMENSIONS'
1077 include 'DIMENSIONS.ZSCOPT'
1078 include "DIMENSIONS.COMPAR"
1079 include 'COMMON.GEO'
1080 include 'COMMON.VAR'
1081 include 'COMMON.LOCAL'
1082 include 'COMMON.CHAIN'
1083 include 'COMMON.DERIV'
1084 include 'COMMON.NAMES'
1085 include 'COMMON.INTERACT'
1086 include 'COMMON.ENEPS'
1087 include 'COMMON.IOUNITS'
1088 include 'COMMON.CALC'
1089 common /srutu/ icall
1095 eneps_temp(j,i)=0.0d0
1100 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1103 c if (icall.gt.0) lprn=.true.
1105 do i=iatsc_s,iatsc_e
1106 itypi=iabs(itype(i))
1107 if (itypi.eq.ntyp1) cycle
1108 itypi1=iabs(itype(i+1))
1112 dxi=dc_norm(1,nres+i)
1113 dyi=dc_norm(2,nres+i)
1114 dzi=dc_norm(3,nres+i)
1115 dsci_inv=vbld_inv(i+nres)
1117 C Calculate SC interaction energy.
1119 do iint=1,nint_gr(i)
1120 do j=istart(i,iint),iend(i,iint)
1122 itypj=iabs(itype(j))
1123 if (itypj.eq.ntyp1) cycle
1124 dscj_inv=vbld_inv(j+nres)
1125 sig0ij=sigma(itypi,itypj)
1126 r0ij=r0(itypi,itypj)
1127 chi1=chi(itypi,itypj)
1128 chi2=chi(itypj,itypi)
1135 alf12=0.5D0*(alf1+alf2)
1136 C For diagnostics only!!!
1149 dxj=dc_norm(1,nres+j)
1150 dyj=dc_norm(2,nres+j)
1151 dzj=dc_norm(3,nres+j)
1152 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1154 C Calculate angle-dependent terms of energy and contributions to their
1158 sig=sig0ij*dsqrt(sigsq)
1159 rij_shift=1.0D0/rij-sig+r0ij
1160 C I hate to put IF's in the loops, but here don't have another choice!!!!
1161 if (rij_shift.le.0.0D0) then
1166 c---------------------------------------------------------------
1167 rij_shift=1.0D0/rij_shift
1168 fac=rij_shift**expon
1171 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1172 eps2der=evdwij*eps3rt
1173 eps3der=evdwij*eps2rt
1174 fac_augm=rrij**expon
1175 e_augm=augm(itypi,itypj)*fac_augm
1176 evdwij=evdwij*eps2rt*eps3rt
1177 if (bb.gt.0.0d0) then
1178 evdw=evdw+evdwij+e_augm
1180 evdw_t=evdw_t+evdwij+e_augm
1182 ij=icant(itypi,itypj)
1183 aux=eps1*eps2rt**2*eps3rt**2
1184 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1185 & /dabs(eps(itypi,itypj))
1186 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1187 c eneps_temp(ij)=eneps_temp(ij)
1188 c & +(evdwij+e_augm)/eps(itypi,itypj)
1190 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1191 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1192 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1193 c & restyp(itypi),i,restyp(itypj),j,
1194 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1195 c & chi1,chi2,chip1,chip2,
1196 c & eps1,eps2rt**2,eps3rt**2,
1197 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1201 C Calculate gradient components.
1202 e1=e1*eps1*eps2rt**2*eps3rt**2
1203 fac=-expon*(e1+evdwij)*rij_shift
1205 fac=rij*fac-2*expon*rrij*e_augm
1206 C Calculate the radial part of the gradient
1210 C Calculate angular part of the gradient.
1218 C-----------------------------------------------------------------------------
1219 subroutine sc_angular
1220 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1221 C om12. Called by ebp, egb, and egbv.
1223 include 'COMMON.CALC'
1227 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1228 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1229 om12=dxi*dxj+dyi*dyj+dzi*dzj
1231 C Calculate eps1(om12) and its derivative in om12
1232 faceps1=1.0D0-om12*chiom12
1233 faceps1_inv=1.0D0/faceps1
1234 eps1=dsqrt(faceps1_inv)
1235 C Following variable is eps1*deps1/dom12
1236 eps1_om12=faceps1_inv*chiom12
1237 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1242 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1243 sigsq=1.0D0-facsig*faceps1_inv
1244 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1245 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1246 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1247 C Calculate eps2 and its derivatives in om1, om2, and om12.
1250 chipom12=chip12*om12
1251 facp=1.0D0-om12*chipom12
1253 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1254 C Following variable is the square root of eps2
1255 eps2rt=1.0D0-facp1*facp_inv
1256 C Following three variables are the derivatives of the square root of eps
1257 C in om1, om2, and om12.
1258 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1259 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1260 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1261 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1262 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1263 C Calculate whole angle-dependent part of epsilon and contributions
1264 C to its derivatives
1267 C----------------------------------------------------------------------------
1269 implicit real*8 (a-h,o-z)
1270 include 'DIMENSIONS'
1271 include 'DIMENSIONS.ZSCOPT'
1272 include 'COMMON.CHAIN'
1273 include 'COMMON.DERIV'
1274 include 'COMMON.CALC'
1275 double precision dcosom1(3),dcosom2(3)
1276 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1277 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1278 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1279 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1281 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1282 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1285 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1288 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1289 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1290 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1291 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1292 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1293 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1296 C Calculate the components of the gradient in DC and X
1300 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1305 c------------------------------------------------------------------------------
1306 subroutine vec_and_deriv
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1309 include 'DIMENSIONS.ZSCOPT'
1310 include 'COMMON.IOUNITS'
1311 include 'COMMON.GEO'
1312 include 'COMMON.VAR'
1313 include 'COMMON.LOCAL'
1314 include 'COMMON.CHAIN'
1315 include 'COMMON.VECTORS'
1316 include 'COMMON.DERIV'
1317 include 'COMMON.INTERACT'
1318 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1319 C Compute the local reference systems. For reference system (i), the
1320 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1321 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1323 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1324 if (i.eq.nres-1) then
1325 C Case of the last full residue
1326 C Compute the Z-axis
1327 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1328 costh=dcos(pi-theta(nres))
1329 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1334 C Compute the derivatives of uz
1336 uzder(2,1,1)=-dc_norm(3,i-1)
1337 uzder(3,1,1)= dc_norm(2,i-1)
1338 uzder(1,2,1)= dc_norm(3,i-1)
1340 uzder(3,2,1)=-dc_norm(1,i-1)
1341 uzder(1,3,1)=-dc_norm(2,i-1)
1342 uzder(2,3,1)= dc_norm(1,i-1)
1345 uzder(2,1,2)= dc_norm(3,i)
1346 uzder(3,1,2)=-dc_norm(2,i)
1347 uzder(1,2,2)=-dc_norm(3,i)
1349 uzder(3,2,2)= dc_norm(1,i)
1350 uzder(1,3,2)= dc_norm(2,i)
1351 uzder(2,3,2)=-dc_norm(1,i)
1354 C Compute the Y-axis
1357 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1360 C Compute the derivatives of uy
1363 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1364 & -dc_norm(k,i)*dc_norm(j,i-1)
1365 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1367 uyder(j,j,1)=uyder(j,j,1)-costh
1368 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1373 uygrad(l,k,j,i)=uyder(l,k,j)
1374 uzgrad(l,k,j,i)=uzder(l,k,j)
1378 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1379 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1380 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1381 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1385 C Compute the Z-axis
1386 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1387 costh=dcos(pi-theta(i+2))
1388 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1393 C Compute the derivatives of uz
1395 uzder(2,1,1)=-dc_norm(3,i+1)
1396 uzder(3,1,1)= dc_norm(2,i+1)
1397 uzder(1,2,1)= dc_norm(3,i+1)
1399 uzder(3,2,1)=-dc_norm(1,i+1)
1400 uzder(1,3,1)=-dc_norm(2,i+1)
1401 uzder(2,3,1)= dc_norm(1,i+1)
1404 uzder(2,1,2)= dc_norm(3,i)
1405 uzder(3,1,2)=-dc_norm(2,i)
1406 uzder(1,2,2)=-dc_norm(3,i)
1408 uzder(3,2,2)= dc_norm(1,i)
1409 uzder(1,3,2)= dc_norm(2,i)
1410 uzder(2,3,2)=-dc_norm(1,i)
1413 C Compute the Y-axis
1416 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1419 C Compute the derivatives of uy
1422 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1423 & -dc_norm(k,i)*dc_norm(j,i+1)
1424 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1426 uyder(j,j,1)=uyder(j,j,1)-costh
1427 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1432 uygrad(l,k,j,i)=uyder(l,k,j)
1433 uzgrad(l,k,j,i)=uzder(l,k,j)
1437 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1438 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1439 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1440 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1446 vbld_inv_temp(1)=vbld_inv(i+1)
1447 if (i.lt.nres-1) then
1448 vbld_inv_temp(2)=vbld_inv(i+2)
1450 vbld_inv_temp(2)=vbld_inv(i)
1455 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1456 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1464 C-----------------------------------------------------------------------------
1465 subroutine vec_and_deriv_test
1466 implicit real*8 (a-h,o-z)
1467 include 'DIMENSIONS'
1468 include 'DIMENSIONS.ZSCOPT'
1469 include 'COMMON.IOUNITS'
1470 include 'COMMON.GEO'
1471 include 'COMMON.VAR'
1472 include 'COMMON.LOCAL'
1473 include 'COMMON.CHAIN'
1474 include 'COMMON.VECTORS'
1475 dimension uyder(3,3,2),uzder(3,3,2)
1476 C Compute the local reference systems. For reference system (i), the
1477 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1478 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1480 if (i.eq.nres-1) then
1481 C Case of the last full residue
1482 C Compute the Z-axis
1483 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1484 costh=dcos(pi-theta(nres))
1485 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1486 c write (iout,*) 'fac',fac,
1487 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1488 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1492 C Compute the derivatives of uz
1494 uzder(2,1,1)=-dc_norm(3,i-1)
1495 uzder(3,1,1)= dc_norm(2,i-1)
1496 uzder(1,2,1)= dc_norm(3,i-1)
1498 uzder(3,2,1)=-dc_norm(1,i-1)
1499 uzder(1,3,1)=-dc_norm(2,i-1)
1500 uzder(2,3,1)= dc_norm(1,i-1)
1503 uzder(2,1,2)= dc_norm(3,i)
1504 uzder(3,1,2)=-dc_norm(2,i)
1505 uzder(1,2,2)=-dc_norm(3,i)
1507 uzder(3,2,2)= dc_norm(1,i)
1508 uzder(1,3,2)= dc_norm(2,i)
1509 uzder(2,3,2)=-dc_norm(1,i)
1511 C Compute the Y-axis
1513 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1516 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1517 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1518 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1520 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1523 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1524 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1527 c write (iout,*) 'facy',facy,
1528 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1529 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1531 uy(k,i)=facy*uy(k,i)
1533 C Compute the derivatives of uy
1536 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1537 & -dc_norm(k,i)*dc_norm(j,i-1)
1538 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1540 c uyder(j,j,1)=uyder(j,j,1)-costh
1541 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1542 uyder(j,j,1)=uyder(j,j,1)
1543 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1544 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1550 uygrad(l,k,j,i)=uyder(l,k,j)
1551 uzgrad(l,k,j,i)=uzder(l,k,j)
1555 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1556 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1557 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1558 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1561 C Compute the Z-axis
1562 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1563 costh=dcos(pi-theta(i+2))
1564 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1565 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1569 C Compute the derivatives of uz
1571 uzder(2,1,1)=-dc_norm(3,i+1)
1572 uzder(3,1,1)= dc_norm(2,i+1)
1573 uzder(1,2,1)= dc_norm(3,i+1)
1575 uzder(3,2,1)=-dc_norm(1,i+1)
1576 uzder(1,3,1)=-dc_norm(2,i+1)
1577 uzder(2,3,1)= dc_norm(1,i+1)
1580 uzder(2,1,2)= dc_norm(3,i)
1581 uzder(3,1,2)=-dc_norm(2,i)
1582 uzder(1,2,2)=-dc_norm(3,i)
1584 uzder(3,2,2)= dc_norm(1,i)
1585 uzder(1,3,2)= dc_norm(2,i)
1586 uzder(2,3,2)=-dc_norm(1,i)
1588 C Compute the Y-axis
1590 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1591 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1592 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1594 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1597 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1598 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1601 c write (iout,*) 'facy',facy,
1602 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1603 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1605 uy(k,i)=facy*uy(k,i)
1607 C Compute the derivatives of uy
1610 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1611 & -dc_norm(k,i)*dc_norm(j,i+1)
1612 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1614 c uyder(j,j,1)=uyder(j,j,1)-costh
1615 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1616 uyder(j,j,1)=uyder(j,j,1)
1617 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1618 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1624 uygrad(l,k,j,i)=uyder(l,k,j)
1625 uzgrad(l,k,j,i)=uzder(l,k,j)
1629 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1630 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1631 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1632 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1639 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1640 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1647 C-----------------------------------------------------------------------------
1648 subroutine check_vecgrad
1649 implicit real*8 (a-h,o-z)
1650 include 'DIMENSIONS'
1651 include 'DIMENSIONS.ZSCOPT'
1652 include 'COMMON.IOUNITS'
1653 include 'COMMON.GEO'
1654 include 'COMMON.VAR'
1655 include 'COMMON.LOCAL'
1656 include 'COMMON.CHAIN'
1657 include 'COMMON.VECTORS'
1658 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1659 dimension uyt(3,maxres),uzt(3,maxres)
1660 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1661 double precision delta /1.0d-7/
1664 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1665 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1666 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1667 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1668 cd & (dc_norm(if90,i),if90=1,3)
1669 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1670 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1671 cd write(iout,'(a)')
1677 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1678 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1691 cd write (iout,*) 'i=',i
1693 erij(k)=dc_norm(k,i)
1697 dc_norm(k,i)=erij(k)
1699 dc_norm(j,i)=dc_norm(j,i)+delta
1700 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1702 c dc_norm(k,i)=dc_norm(k,i)/fac
1704 c write (iout,*) (dc_norm(k,i),k=1,3)
1705 c write (iout,*) (erij(k),k=1,3)
1708 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1709 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1710 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1711 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1713 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1714 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1715 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1718 dc_norm(k,i)=erij(k)
1721 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1722 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1723 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1724 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1725 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1726 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1727 cd write (iout,'(a)')
1732 C--------------------------------------------------------------------------
1733 subroutine set_matrices
1734 implicit real*8 (a-h,o-z)
1735 include 'DIMENSIONS'
1736 include 'DIMENSIONS.ZSCOPT'
1737 include 'COMMON.IOUNITS'
1738 include 'COMMON.GEO'
1739 include 'COMMON.VAR'
1740 include 'COMMON.LOCAL'
1741 include 'COMMON.CHAIN'
1742 include 'COMMON.DERIV'
1743 include 'COMMON.INTERACT'
1744 include 'COMMON.CONTACTS'
1745 include 'COMMON.TORSION'
1746 include 'COMMON.VECTORS'
1747 include 'COMMON.FFIELD'
1748 double precision auxvec(2),auxmat(2,2)
1750 C Compute the virtual-bond-torsional-angle dependent quantities needed
1751 C to calculate the el-loc multibody terms of various order.
1754 if (i .lt. nres+1) then
1791 if (i .gt. 3 .and. i .lt. nres+1) then
1792 obrot_der(1,i-2)=-sin1
1793 obrot_der(2,i-2)= cos1
1794 Ugder(1,1,i-2)= sin1
1795 Ugder(1,2,i-2)=-cos1
1796 Ugder(2,1,i-2)=-cos1
1797 Ugder(2,2,i-2)=-sin1
1800 obrot2_der(1,i-2)=-dwasin2
1801 obrot2_der(2,i-2)= dwacos2
1802 Ug2der(1,1,i-2)= dwasin2
1803 Ug2der(1,2,i-2)=-dwacos2
1804 Ug2der(2,1,i-2)=-dwacos2
1805 Ug2der(2,2,i-2)=-dwasin2
1807 obrot_der(1,i-2)=0.0d0
1808 obrot_der(2,i-2)=0.0d0
1809 Ugder(1,1,i-2)=0.0d0
1810 Ugder(1,2,i-2)=0.0d0
1811 Ugder(2,1,i-2)=0.0d0
1812 Ugder(2,2,i-2)=0.0d0
1813 obrot2_der(1,i-2)=0.0d0
1814 obrot2_der(2,i-2)=0.0d0
1815 Ug2der(1,1,i-2)=0.0d0
1816 Ug2der(1,2,i-2)=0.0d0
1817 Ug2der(2,1,i-2)=0.0d0
1818 Ug2der(2,2,i-2)=0.0d0
1820 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1821 if (itype(i-2).le.ntyp) then
1822 iti = itortyp(itype(i-2))
1829 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1830 if (itype(i-1).le.ntyp) then
1831 iti1 = itortyp(itype(i-1))
1838 cd write (iout,*) '*******i',i,' iti1',iti
1839 cd write (iout,*) 'b1',b1(:,iti)
1840 cd write (iout,*) 'b2',b2(:,iti)
1841 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1842 c print *,"itilde1 i iti iti1",i,iti,iti1
1843 if (i .gt. iatel_s+2) then
1844 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1845 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1846 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1847 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1848 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1849 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1850 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1860 DtUg2(l,k,i-2)=0.0d0
1864 c print *,"itilde2 i iti iti1",i,iti,iti1
1865 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1866 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1867 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1868 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1869 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1870 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1871 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1872 c print *,"itilde3 i iti iti1",i,iti,iti1
1874 muder(k,i-2)=Ub2der(k,i-2)
1876 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1877 if (itype(i-1).le.ntyp) then
1878 iti1 = itortyp(itype(i-1))
1886 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1888 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
1890 C Vectors and matrices dependent on a single virtual-bond dihedral.
1891 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1892 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1893 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1894 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1895 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1896 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1897 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1898 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1899 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1900 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1901 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1903 C Matrices dependent on two consecutive virtual-bond dihedrals.
1904 C The order of matrices is from left to right.
1906 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1907 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1908 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1909 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1910 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1911 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1912 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1913 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1916 cd iti = itortyp(itype(i))
1919 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1920 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1925 C--------------------------------------------------------------------------
1926 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1928 C This subroutine calculates the average interaction energy and its gradient
1929 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1930 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1931 C The potential depends both on the distance of peptide-group centers and on
1932 C the orientation of the CA-CA virtual bonds.
1934 implicit real*8 (a-h,o-z)
1935 include 'DIMENSIONS'
1936 include 'DIMENSIONS.ZSCOPT'
1937 include 'COMMON.CONTROL'
1938 include 'COMMON.IOUNITS'
1939 include 'COMMON.GEO'
1940 include 'COMMON.VAR'
1941 include 'COMMON.LOCAL'
1942 include 'COMMON.CHAIN'
1943 include 'COMMON.DERIV'
1944 include 'COMMON.INTERACT'
1945 include 'COMMON.CONTACTS'
1946 include 'COMMON.TORSION'
1947 include 'COMMON.VECTORS'
1948 include 'COMMON.FFIELD'
1949 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1950 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1951 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1952 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1953 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1954 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1955 double precision scal_el /0.5d0/
1957 C 13-go grudnia roku pamietnego...
1958 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1959 & 0.0d0,1.0d0,0.0d0,
1960 & 0.0d0,0.0d0,1.0d0/
1961 write(iout,*) 'In EELEC'
1963 cd write(iout,*) 'Type',i
1964 cd write(iout,*) 'B1',B1(:,i)
1965 cd write(iout,*) 'B2',B2(:,i)
1966 cd write(iout,*) 'CC',CC(:,:,i)
1967 cd write(iout,*) 'DD',DD(:,:,i)
1968 cd write(iout,*) 'EE',EE(:,:,i)
1970 cd call check_vecgrad
1972 if (icheckgrad.eq.1) then
1974 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1976 dc_norm(k,i)=dc(k,i)*fac
1978 c write (iout,*) 'i',i,' fac',fac
1981 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1982 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1983 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1984 cd if (wel_loc.gt.0.0d0) then
1985 if (icheckgrad.eq.1) then
1986 call vec_and_deriv_test
1993 cd write (iout,*) 'i=',i
1995 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1998 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1999 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2012 C print '(a)','Enter EELEC'
2013 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2015 gel_loc_loc(i)=0.0d0
2018 do i=iatel_s,iatel_e
2019 C write (iout,*) i,"i2",itype(i)
2021 C if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2022 C & .or. itype(i+2).eq.ntyp1) cycle
2024 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2025 & .or. itype(i+2).eq.ntyp1
2026 & .or. itype(i-1).eq.ntyp1
2029 if (itel(i).eq.0) goto 1215
2033 dx_normi=dc_norm(1,i)
2034 dy_normi=dc_norm(2,i)
2035 dz_normi=dc_norm(3,i)
2036 xmedi=c(1,i)+0.5d0*dxi
2037 ymedi=c(2,i)+0.5d0*dyi
2038 zmedi=c(3,i)+0.5d0*dzi
2039 xmedi=mod(xmedi,boxxsize)
2040 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2041 ymedi=mod(ymedi,boxysize)
2042 if (ymedi.lt.0) ymedi=ymedi+boxysize
2043 zmedi=mod(zmedi,boxzsize)
2044 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2046 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2047 do j=ielstart(i),ielend(i)
2048 C write(iout,*) j,"j2"
2051 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2052 & .or.itype(j+2).eq.ntyp1
2055 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2056 & .or.itype(j+2).eq.ntyp1
2057 & .or.itype(j-1).eq.ntyp1
2060 C write(iout,*) j,"j2"
2063 if (itel(j).eq.0) goto 1216
2067 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2068 aaa=app(iteli,itelj)
2069 bbb=bpp(iteli,itelj)
2070 C Diagnostics only!!!
2076 ael6i=ael6(iteli,itelj)
2077 ael3i=ael3(iteli,itelj)
2081 dx_normj=dc_norm(1,j)
2082 dy_normj=dc_norm(2,j)
2083 dz_normj=dc_norm(3,j)
2088 if (xj.lt.0) xj=xj+boxxsize
2090 if (yj.lt.0) yj=yj+boxysize
2092 if (zj.lt.0) zj=zj+boxzsize
2093 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2101 xj=xj_safe+xshift*boxxsize
2102 yj=yj_safe+yshift*boxysize
2103 zj=zj_safe+zshift*boxzsize
2104 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2105 if(dist_temp.lt.dist_init) then
2115 if (isubchap.eq.1) then
2124 rij=xj*xj+yj*yj+zj*zj
2125 sss=sscale(sqrt(rij))
2126 sssgrad=sscagrad(sqrt(rij))
2132 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2133 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2134 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2135 fac=cosa-3.0D0*cosb*cosg
2137 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2138 if (j.eq.i+2) ev1=scal_el*ev1
2143 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2146 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2147 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2148 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2150 evdw1=evdw1+evdwij*sss
2151 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2152 c &'evdw1',i,j,evdwij
2153 c &,iteli,itelj,aaa,evdw1
2155 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2156 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2157 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2158 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2159 c & xmedi,ymedi,zmedi,xj,yj,zj
2161 C Calculate contributions to the Cartesian gradient.
2164 facvdw=-6*rrmij*(ev1+evdwij)*sss
2165 facel=-3*rrmij*(el1+eesij)
2172 * Radial derivatives. First process both termini of the fragment (i,j)
2179 gelc(k,i)=gelc(k,i)+ghalf
2180 gelc(k,j)=gelc(k,j)+ghalf
2183 * Loop over residues i+1 thru j-1.
2187 gelc(l,k)=gelc(l,k)+ggg(l)
2193 if (sss.gt.0.0) then
2194 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2195 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2196 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2204 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2205 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2208 * Loop over residues i+1 thru j-1.
2212 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2216 facvdw=(ev1+evdwij)*sss
2219 fac=-3*rrmij*(facvdw+facvdw+facel)
2225 * Radial derivatives. First process both termini of the fragment (i,j)
2232 gelc(k,i)=gelc(k,i)+ghalf
2233 gelc(k,j)=gelc(k,j)+ghalf
2236 * Loop over residues i+1 thru j-1.
2240 gelc(l,k)=gelc(l,k)+ggg(l)
2247 ecosa=2.0D0*fac3*fac1+fac4
2250 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2251 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2253 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2254 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2256 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2257 cd & (dcosg(k),k=1,3)
2259 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2263 gelc(k,i)=gelc(k,i)+ghalf
2264 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2265 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2266 gelc(k,j)=gelc(k,j)+ghalf
2267 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2268 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2272 gelc(l,k)=gelc(l,k)+ggg(l)
2277 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2278 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2279 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2281 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2282 C energy of a peptide unit is assumed in the form of a second-order
2283 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2284 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2285 C are computed for EVERY pair of non-contiguous peptide groups.
2287 if (j.lt.nres-1) then
2298 muij(kkk)=mu(k,i)*mu(l,j)
2301 cd write (iout,*) 'EELEC: i',i,' j',j
2302 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2303 cd write(iout,*) 'muij',muij
2304 ury=scalar(uy(1,i),erij)
2305 urz=scalar(uz(1,i),erij)
2306 vry=scalar(uy(1,j),erij)
2307 vrz=scalar(uz(1,j),erij)
2308 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2309 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2310 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2311 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2312 C For diagnostics only
2317 fac=dsqrt(-ael6i)*r3ij
2318 cd write (2,*) 'fac=',fac
2319 C For diagnostics only
2325 cd write (iout,'(4i5,4f10.5)')
2326 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2327 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2328 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2329 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2330 cd write (iout,'(4f10.5)')
2331 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2332 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2333 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2334 cd write (iout,'(2i3,9f10.5/)') i,j,
2335 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2337 C Derivatives of the elements of A in virtual-bond vectors
2338 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2345 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2346 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2347 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2348 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2349 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2350 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2351 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2352 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2353 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2354 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2355 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2356 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2366 C Compute radial contributions to the gradient
2388 C Add the contributions coming from er
2391 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2392 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2393 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2394 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2397 C Derivatives in DC(i)
2398 ghalf1=0.5d0*agg(k,1)
2399 ghalf2=0.5d0*agg(k,2)
2400 ghalf3=0.5d0*agg(k,3)
2401 ghalf4=0.5d0*agg(k,4)
2402 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2403 & -3.0d0*uryg(k,2)*vry)+ghalf1
2404 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2405 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2406 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2407 & -3.0d0*urzg(k,2)*vry)+ghalf3
2408 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2409 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2410 C Derivatives in DC(i+1)
2411 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2412 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2413 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2414 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2415 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2416 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2417 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2418 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2419 C Derivatives in DC(j)
2420 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2421 & -3.0d0*vryg(k,2)*ury)+ghalf1
2422 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2423 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2424 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2425 & -3.0d0*vryg(k,2)*urz)+ghalf3
2426 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2427 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2428 C Derivatives in DC(j+1) or DC(nres-1)
2429 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2430 & -3.0d0*vryg(k,3)*ury)
2431 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2432 & -3.0d0*vrzg(k,3)*ury)
2433 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2434 & -3.0d0*vryg(k,3)*urz)
2435 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2436 & -3.0d0*vrzg(k,3)*urz)
2441 C Derivatives in DC(i+1)
2442 cd aggi1(k,1)=agg(k,1)
2443 cd aggi1(k,2)=agg(k,2)
2444 cd aggi1(k,3)=agg(k,3)
2445 cd aggi1(k,4)=agg(k,4)
2446 C Derivatives in DC(j)
2451 C Derivatives in DC(j+1)
2456 if (j.eq.nres-1 .and. i.lt.j-2) then
2458 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2459 cd aggj1(k,l)=agg(k,l)
2465 C Check the loc-el terms by numerical integration
2475 aggi(k,l)=-aggi(k,l)
2476 aggi1(k,l)=-aggi1(k,l)
2477 aggj(k,l)=-aggj(k,l)
2478 aggj1(k,l)=-aggj1(k,l)
2481 if (j.lt.nres-1) then
2487 aggi(k,l)=-aggi(k,l)
2488 aggi1(k,l)=-aggi1(k,l)
2489 aggj(k,l)=-aggj(k,l)
2490 aggj1(k,l)=-aggj1(k,l)
2501 aggi(k,l)=-aggi(k,l)
2502 aggi1(k,l)=-aggi1(k,l)
2503 aggj(k,l)=-aggj(k,l)
2504 aggj1(k,l)=-aggj1(k,l)
2510 IF (wel_loc.gt.0.0d0) THEN
2511 C Contribution to the local-electrostatic energy coming from the i-j pair
2512 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2514 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2515 C write (iout,'(a6,2i5,0pf7.3)')
2516 C & 'eelloc',i,j,eel_loc_ij
2517 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2518 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2519 eel_loc=eel_loc+eel_loc_ij
2520 C Partial derivatives in virtual-bond dihedral angles gamma
2523 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2524 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2525 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2526 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2527 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2528 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2529 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2530 cd write(iout,*) 'agg ',agg
2531 cd write(iout,*) 'aggi ',aggi
2532 cd write(iout,*) 'aggi1',aggi1
2533 cd write(iout,*) 'aggj ',aggj
2534 cd write(iout,*) 'aggj1',aggj1
2536 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2538 ggg(l)=agg(l,1)*muij(1)+
2539 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2543 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2546 C Remaining derivatives of eello
2548 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2549 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2550 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2551 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2552 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2553 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2554 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2555 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2559 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2560 C Contributions from turns
2565 call eturn34(i,j,eello_turn3,eello_turn4)
2567 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2568 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2570 C Calculate the contact function. The ith column of the array JCONT will
2571 C contain the numbers of atoms that make contacts with the atom I (of numbers
2572 C greater than I). The arrays FACONT and GACONT will contain the values of
2573 C the contact function and its derivative.
2574 c r0ij=1.02D0*rpp(iteli,itelj)
2575 c r0ij=1.11D0*rpp(iteli,itelj)
2576 r0ij=2.20D0*rpp(iteli,itelj)
2577 c r0ij=1.55D0*rpp(iteli,itelj)
2578 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2579 if (fcont.gt.0.0D0) then
2580 num_conti=num_conti+1
2581 if (num_conti.gt.maxconts) then
2582 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2583 & ' will skip next contacts for this conf.'
2585 jcont_hb(num_conti,i)=j
2586 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2587 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2588 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2590 d_cont(num_conti,i)=rij
2591 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2592 C --- Electrostatic-interaction matrix ---
2593 a_chuj(1,1,num_conti,i)=a22
2594 a_chuj(1,2,num_conti,i)=a23
2595 a_chuj(2,1,num_conti,i)=a32
2596 a_chuj(2,2,num_conti,i)=a33
2597 C --- Gradient of rij
2599 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2602 c a_chuj(1,1,num_conti,i)=-0.61d0
2603 c a_chuj(1,2,num_conti,i)= 0.4d0
2604 c a_chuj(2,1,num_conti,i)= 0.65d0
2605 c a_chuj(2,2,num_conti,i)= 0.50d0
2606 c else if (i.eq.2) then
2607 c a_chuj(1,1,num_conti,i)= 0.0d0
2608 c a_chuj(1,2,num_conti,i)= 0.0d0
2609 c a_chuj(2,1,num_conti,i)= 0.0d0
2610 c a_chuj(2,2,num_conti,i)= 0.0d0
2612 C --- and its gradients
2613 cd write (iout,*) 'i',i,' j',j
2615 cd write (iout,*) 'iii 1 kkk',kkk
2616 cd write (iout,*) agg(kkk,:)
2619 cd write (iout,*) 'iii 2 kkk',kkk
2620 cd write (iout,*) aggi(kkk,:)
2623 cd write (iout,*) 'iii 3 kkk',kkk
2624 cd write (iout,*) aggi1(kkk,:)
2627 cd write (iout,*) 'iii 4 kkk',kkk
2628 cd write (iout,*) aggj(kkk,:)
2631 cd write (iout,*) 'iii 5 kkk',kkk
2632 cd write (iout,*) aggj1(kkk,:)
2639 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2640 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2641 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2642 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2643 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2645 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2651 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2652 C Calculate contact energies
2654 wij=cosa-3.0D0*cosb*cosg
2657 c fac3=dsqrt(-ael6i)/r0ij**3
2658 fac3=dsqrt(-ael6i)*r3ij
2659 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2660 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2662 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2663 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2664 C Diagnostics. Comment out or remove after debugging!
2665 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2666 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2667 c ees0m(num_conti,i)=0.0D0
2669 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2670 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2671 facont_hb(num_conti,i)=fcont
2673 C Angular derivatives of the contact function
2674 ees0pij1=fac3/ees0pij
2675 ees0mij1=fac3/ees0mij
2676 fac3p=-3.0D0*fac3*rrmij
2677 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2678 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2680 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2681 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2682 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2683 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2684 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2685 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2686 ecosap=ecosa1+ecosa2
2687 ecosbp=ecosb1+ecosb2
2688 ecosgp=ecosg1+ecosg2
2689 ecosam=ecosa1-ecosa2
2690 ecosbm=ecosb1-ecosb2
2691 ecosgm=ecosg1-ecosg2
2700 fprimcont=fprimcont/rij
2701 cd facont_hb(num_conti,i)=1.0D0
2702 C Following line is for diagnostics.
2705 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2706 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2709 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2710 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2712 gggp(1)=gggp(1)+ees0pijp*xj
2713 gggp(2)=gggp(2)+ees0pijp*yj
2714 gggp(3)=gggp(3)+ees0pijp*zj
2715 gggm(1)=gggm(1)+ees0mijp*xj
2716 gggm(2)=gggm(2)+ees0mijp*yj
2717 gggm(3)=gggm(3)+ees0mijp*zj
2718 C Derivatives due to the contact function
2719 gacont_hbr(1,num_conti,i)=fprimcont*xj
2720 gacont_hbr(2,num_conti,i)=fprimcont*yj
2721 gacont_hbr(3,num_conti,i)=fprimcont*zj
2723 ghalfp=0.5D0*gggp(k)
2724 ghalfm=0.5D0*gggm(k)
2725 gacontp_hb1(k,num_conti,i)=ghalfp
2726 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2727 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2728 gacontp_hb2(k,num_conti,i)=ghalfp
2729 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2730 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2731 gacontp_hb3(k,num_conti,i)=gggp(k)
2732 gacontm_hb1(k,num_conti,i)=ghalfm
2733 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2734 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2735 gacontm_hb2(k,num_conti,i)=ghalfm
2736 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2737 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2738 gacontm_hb3(k,num_conti,i)=gggm(k)
2741 C Diagnostics. Comment out or remove after debugging!
2743 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2744 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2745 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2746 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2747 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2748 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2751 endif ! num_conti.le.maxconts
2756 num_cont_hb(i)=num_conti
2760 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2761 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2763 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2764 ccc eel_loc=eel_loc+eello_turn3
2767 C-----------------------------------------------------------------------------
2768 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2769 C Third- and fourth-order contributions from turns
2770 implicit real*8 (a-h,o-z)
2771 include 'DIMENSIONS'
2772 include 'DIMENSIONS.ZSCOPT'
2773 include 'COMMON.IOUNITS'
2774 include 'COMMON.GEO'
2775 include 'COMMON.VAR'
2776 include 'COMMON.LOCAL'
2777 include 'COMMON.CHAIN'
2778 include 'COMMON.DERIV'
2779 include 'COMMON.INTERACT'
2780 include 'COMMON.CONTACTS'
2781 include 'COMMON.TORSION'
2782 include 'COMMON.VECTORS'
2783 include 'COMMON.FFIELD'
2785 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2786 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2787 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2788 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2789 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2790 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2792 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2794 C Third-order contributions
2801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2802 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2803 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2804 call transpose2(auxmat(1,1),auxmat1(1,1))
2805 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2806 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2807 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2808 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2809 cd & ' eello_turn3_num',4*eello_turn3_num
2811 C Derivatives in gamma(i)
2812 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2813 call transpose2(auxmat2(1,1),pizda(1,1))
2814 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2815 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2816 C Derivatives in gamma(i+1)
2817 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2818 call transpose2(auxmat2(1,1),pizda(1,1))
2819 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2820 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2821 & +0.5d0*(pizda(1,1)+pizda(2,2))
2822 C Cartesian derivatives
2824 a_temp(1,1)=aggi(l,1)
2825 a_temp(1,2)=aggi(l,2)
2826 a_temp(2,1)=aggi(l,3)
2827 a_temp(2,2)=aggi(l,4)
2828 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2829 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2830 & +0.5d0*(pizda(1,1)+pizda(2,2))
2831 a_temp(1,1)=aggi1(l,1)
2832 a_temp(1,2)=aggi1(l,2)
2833 a_temp(2,1)=aggi1(l,3)
2834 a_temp(2,2)=aggi1(l,4)
2835 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2836 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2837 & +0.5d0*(pizda(1,1)+pizda(2,2))
2838 a_temp(1,1)=aggj(l,1)
2839 a_temp(1,2)=aggj(l,2)
2840 a_temp(2,1)=aggj(l,3)
2841 a_temp(2,2)=aggj(l,4)
2842 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2843 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2844 & +0.5d0*(pizda(1,1)+pizda(2,2))
2845 a_temp(1,1)=aggj1(l,1)
2846 a_temp(1,2)=aggj1(l,2)
2847 a_temp(2,1)=aggj1(l,3)
2848 a_temp(2,2)=aggj1(l,4)
2849 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2850 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2851 & +0.5d0*(pizda(1,1)+pizda(2,2))
2854 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1.and.(i.gt.1)) then
2855 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2856 C changes suggested by Ana to avoid out of bounds
2857 & .or.((i+5).gt.nres)
2859 C end of changes suggested by Ana
2860 & .or. itype(i+3).eq.ntyp1
2861 & .or. itype(i+4).eq.ntyp1
2862 & .or. itype(i+5).eq.ntyp1
2863 & .or. itype(i).eq.ntyp1
2864 & .or. itype(i-1).eq.ntyp1) goto 178
2865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2867 C Fourth-order contributions
2875 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2876 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2877 iti1=itortyp(itype(i+1))
2878 iti2=itortyp(itype(i+2))
2879 iti3=itortyp(itype(i+3))
2880 call transpose2(EUg(1,1,i+1),e1t(1,1))
2881 call transpose2(Eug(1,1,i+2),e2t(1,1))
2882 call transpose2(Eug(1,1,i+3),e3t(1,1))
2883 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2884 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2885 s1=scalar2(b1(1,iti2),auxvec(1))
2886 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2887 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2888 s2=scalar2(b1(1,iti1),auxvec(1))
2889 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2890 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2891 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2892 eello_turn4=eello_turn4-(s1+s2+s3)
2893 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2894 cd & ' eello_turn4_num',8*eello_turn4_num
2895 C Derivatives in gamma(i)
2897 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2898 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2899 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2900 s1=scalar2(b1(1,iti2),auxvec(1))
2901 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2903 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2904 C Derivatives in gamma(i+1)
2905 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2906 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2907 s2=scalar2(b1(1,iti1),auxvec(1))
2908 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2909 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2910 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2911 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2912 C Derivatives in gamma(i+2)
2913 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2914 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2915 s1=scalar2(b1(1,iti2),auxvec(1))
2916 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2917 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2918 s2=scalar2(b1(1,iti1),auxvec(1))
2919 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2920 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2922 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2923 C Cartesian derivatives
2924 C Derivatives of this turn contributions in DC(i+2)
2925 if (j.lt.nres-1) then
2927 a_temp(1,1)=agg(l,1)
2928 a_temp(1,2)=agg(l,2)
2929 a_temp(2,1)=agg(l,3)
2930 a_temp(2,2)=agg(l,4)
2931 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2932 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2933 s1=scalar2(b1(1,iti2),auxvec(1))
2934 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2935 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2936 s2=scalar2(b1(1,iti1),auxvec(1))
2937 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2938 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2939 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2941 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2944 C Remaining derivatives of this turn contribution
2946 a_temp(1,1)=aggi(l,1)
2947 a_temp(1,2)=aggi(l,2)
2948 a_temp(2,1)=aggi(l,3)
2949 a_temp(2,2)=aggi(l,4)
2950 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2951 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2952 s1=scalar2(b1(1,iti2),auxvec(1))
2953 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2954 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2955 s2=scalar2(b1(1,iti1),auxvec(1))
2956 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2957 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2958 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2959 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2960 a_temp(1,1)=aggi1(l,1)
2961 a_temp(1,2)=aggi1(l,2)
2962 a_temp(2,1)=aggi1(l,3)
2963 a_temp(2,2)=aggi1(l,4)
2964 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2965 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2966 s1=scalar2(b1(1,iti2),auxvec(1))
2967 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2968 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2969 s2=scalar2(b1(1,iti1),auxvec(1))
2970 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2971 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2972 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2973 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2974 a_temp(1,1)=aggj(l,1)
2975 a_temp(1,2)=aggj(l,2)
2976 a_temp(2,1)=aggj(l,3)
2977 a_temp(2,2)=aggj(l,4)
2978 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2979 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2980 s1=scalar2(b1(1,iti2),auxvec(1))
2981 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2982 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2983 s2=scalar2(b1(1,iti1),auxvec(1))
2984 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2985 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2986 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2987 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2988 a_temp(1,1)=aggj1(l,1)
2989 a_temp(1,2)=aggj1(l,2)
2990 a_temp(2,1)=aggj1(l,3)
2991 a_temp(2,2)=aggj1(l,4)
2992 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2993 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2994 s1=scalar2(b1(1,iti2),auxvec(1))
2995 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2996 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2997 s2=scalar2(b1(1,iti1),auxvec(1))
2998 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2999 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3000 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3001 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3008 C-----------------------------------------------------------------------------
3009 subroutine vecpr(u,v,w)
3010 implicit real*8(a-h,o-z)
3011 dimension u(3),v(3),w(3)
3012 w(1)=u(2)*v(3)-u(3)*v(2)
3013 w(2)=-u(1)*v(3)+u(3)*v(1)
3014 w(3)=u(1)*v(2)-u(2)*v(1)
3017 C-----------------------------------------------------------------------------
3018 subroutine unormderiv(u,ugrad,unorm,ungrad)
3019 C This subroutine computes the derivatives of a normalized vector u, given
3020 C the derivatives computed without normalization conditions, ugrad. Returns
3023 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3024 double precision vec(3)
3025 double precision scalar
3027 c write (2,*) 'ugrad',ugrad
3030 vec(i)=scalar(ugrad(1,i),u(1))
3032 c write (2,*) 'vec',vec
3035 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3038 c write (2,*) 'ungrad',ungrad
3041 C-----------------------------------------------------------------------------
3042 subroutine escp(evdw2,evdw2_14)
3044 C This subroutine calculates the excluded-volume interaction energy between
3045 C peptide-group centers and side chains and its gradient in virtual-bond and
3046 C side-chain vectors.
3048 implicit real*8 (a-h,o-z)
3049 include 'DIMENSIONS'
3050 include 'DIMENSIONS.ZSCOPT'
3051 include 'COMMON.GEO'
3052 include 'COMMON.VAR'
3053 include 'COMMON.LOCAL'
3054 include 'COMMON.CHAIN'
3055 include 'COMMON.DERIV'
3056 include 'COMMON.INTERACT'
3057 include 'COMMON.FFIELD'
3058 include 'COMMON.IOUNITS'
3062 cd print '(a)','Enter ESCP'
3063 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3064 c & ' scal14',scal14
3065 do i=iatscp_s,iatscp_e
3066 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3068 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3069 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3070 if (iteli.eq.0) goto 1225
3071 xi=0.5D0*(c(1,i)+c(1,i+1))
3072 yi=0.5D0*(c(2,i)+c(2,i+1))
3073 zi=0.5D0*(c(3,i)+c(3,i+1))
3074 C Returning the ith atom to box
3076 if (xi.lt.0) xi=xi+boxxsize
3078 if (yi.lt.0) yi=yi+boxysize
3080 if (zi.lt.0) zi=zi+boxzsize
3081 do iint=1,nscp_gr(i)
3083 do j=iscpstart(i,iint),iscpend(i,iint)
3084 itypj=iabs(itype(j))
3085 if (itypj.eq.ntyp1) cycle
3086 C Uncomment following three lines for SC-p interactions
3090 C Uncomment following three lines for Ca-p interactions
3094 C returning the jth atom to box
3096 if (xj.lt.0) xj=xj+boxxsize
3098 if (yj.lt.0) yj=yj+boxysize
3100 if (zj.lt.0) zj=zj+boxzsize
3101 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3106 C Finding the closest jth atom
3110 xj=xj_safe+xshift*boxxsize
3111 yj=yj_safe+yshift*boxysize
3112 zj=zj_safe+zshift*boxzsize
3113 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3114 if(dist_temp.lt.dist_init) then
3124 if (subchap.eq.1) then
3133 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3134 C sss is scaling function for smoothing the cutoff gradient otherwise
3135 C the gradient would not be continuouse
3136 sss=sscale(1.0d0/(dsqrt(rrij)))
3137 if (sss.le.0.0d0) cycle
3138 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3140 e1=fac*fac*aad(itypj,iteli)
3141 e2=fac*bad(itypj,iteli)
3142 if (iabs(j-i) .le. 2) then
3145 evdw2_14=evdw2_14+(e1+e2)*sss
3148 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3149 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3150 c & bad(itypj,iteli)
3151 evdw2=evdw2+evdwij*sss
3154 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3156 fac=-(evdwij+e1)*rrij*sss
3157 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3162 cd write (iout,*) 'j<i'
3163 C Uncomment following three lines for SC-p interactions
3165 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3168 cd write (iout,*) 'j>i'
3171 C Uncomment following line for SC-p interactions
3172 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3176 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3180 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3181 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3184 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3194 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3195 gradx_scp(j,i)=expon*gradx_scp(j,i)
3198 C******************************************************************************
3202 C To save time the factor EXPON has been extracted from ALL components
3203 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3206 C******************************************************************************
3209 C--------------------------------------------------------------------------
3210 subroutine edis(ehpb)
3212 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3214 implicit real*8 (a-h,o-z)
3215 include 'DIMENSIONS'
3216 include 'DIMENSIONS.ZSCOPT'
3217 include 'COMMON.SBRIDGE'
3218 include 'COMMON.CHAIN'
3219 include 'COMMON.DERIV'
3220 include 'COMMON.VAR'
3221 include 'COMMON.INTERACT'
3222 include 'COMMON.CONTROL'
3223 include 'COMMON.IOUNITS'
3226 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3227 cd print *,'link_start=',link_start,' link_end=',link_end
3228 C write(iout,*) link_end, "link_end"
3229 if (link_end.eq.0) return
3230 do i=link_start,link_end
3231 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3232 C CA-CA distance used in regularization of structure.
3235 C iii and jjj point to the residues for which the distance is assigned.
3236 if (ii.gt.nres) then
3243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3244 C distance and angle dependent SS bond potential.
3245 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3246 C & iabs(itype(jjj)).eq.1) then
3247 C write(iout,*) constr_dist,"const"
3248 if (.not.dyn_ss .and. i.le.nss) then
3249 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3250 & iabs(itype(jjj)).eq.1) then
3251 call ssbond_ene(iii,jjj,eij)
3254 else if (ii.gt.nres .and. jj.gt.nres) then
3255 c Restraints from contact prediction
3257 if (constr_dist.eq.11) then
3258 C ehpb=ehpb+fordepth(i)**4.0d0
3259 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3260 ehpb=ehpb+fordepth(i)**4.0d0
3261 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3262 fac=fordepth(i)**4.0d0
3263 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3264 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3265 C & ehpb,fordepth(i),dd
3266 C write(iout,*) ehpb,"atu?"
3268 C fac=fordepth(i)**4.0d0
3269 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3271 if (dhpb1(i).gt.0.0d0) then
3272 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3273 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3274 c write (iout,*) "beta nmr",
3275 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3279 C Get the force constant corresponding to this distance.
3281 C Calculate the contribution to energy.
3282 ehpb=ehpb+waga*rdis*rdis
3283 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3285 C Evaluate gradient.
3288 endif !end dhpb1(i).gt.0
3289 endif !end const_dist=11
3291 ggg(j)=fac*(c(j,jj)-c(j,ii))
3294 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3295 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3298 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3299 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3302 C write(iout,*) "before"
3304 C write(iout,*) "after",dd
3305 if (constr_dist.eq.11) then
3306 ehpb=ehpb+fordepth(i)**4.0d0
3307 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3308 fac=fordepth(i)**4.0d0
3309 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3310 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3311 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3312 C print *,ehpb,"tu?"
3313 C write(iout,*) ehpb,"btu?",
3314 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3315 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3316 C & ehpb,fordepth(i),dd
3318 if (dhpb1(i).gt.0.0d0) then
3319 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3320 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3321 c write (iout,*) "alph nmr",
3322 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3325 C Get the force constant corresponding to this distance.
3327 C Calculate the contribution to energy.
3328 ehpb=ehpb+waga*rdis*rdis
3329 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3331 C Evaluate gradient.
3338 ggg(j)=fac*(c(j,jj)-c(j,ii))
3340 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3341 C If this is a SC-SC distance, we need to calculate the contributions to the
3342 C Cartesian gradient in the SC vectors (ghpbx).
3345 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3346 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3351 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3356 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3359 C--------------------------------------------------------------------------
3360 subroutine ssbond_ene(i,j,eij)
3362 C Calculate the distance and angle dependent SS-bond potential energy
3363 C using a free-energy function derived based on RHF/6-31G** ab initio
3364 C calculations of diethyl disulfide.
3366 C A. Liwo and U. Kozlowska, 11/24/03
3368 implicit real*8 (a-h,o-z)
3369 include 'DIMENSIONS'
3370 include 'DIMENSIONS.ZSCOPT'
3371 include 'COMMON.SBRIDGE'
3372 include 'COMMON.CHAIN'
3373 include 'COMMON.DERIV'
3374 include 'COMMON.LOCAL'
3375 include 'COMMON.INTERACT'
3376 include 'COMMON.VAR'
3377 include 'COMMON.IOUNITS'
3378 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3379 itypi=iabs(itype(i))
3383 dxi=dc_norm(1,nres+i)
3384 dyi=dc_norm(2,nres+i)
3385 dzi=dc_norm(3,nres+i)
3386 dsci_inv=dsc_inv(itypi)
3387 itypj=iabs(itype(j))
3388 dscj_inv=dsc_inv(itypj)
3392 dxj=dc_norm(1,nres+j)
3393 dyj=dc_norm(2,nres+j)
3394 dzj=dc_norm(3,nres+j)
3395 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3400 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3401 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3402 om12=dxi*dxj+dyi*dyj+dzi*dzj
3404 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3405 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3411 deltat12=om2-om1+2.0d0
3413 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3414 & +akct*deltad*deltat12
3415 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3416 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3417 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3418 c & " deltat12",deltat12," eij",eij
3419 ed=2*akcm*deltad+akct*deltat12
3421 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3422 eom1=-2*akth*deltat1-pom1-om2*pom2
3423 eom2= 2*akth*deltat2+pom1-om1*pom2
3426 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3429 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3430 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3431 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3432 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3435 C Calculate the components of the gradient in DC and X
3439 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3444 C--------------------------------------------------------------------------
3445 subroutine ebond(estr)
3447 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3449 implicit real*8 (a-h,o-z)
3450 include 'DIMENSIONS'
3451 include 'DIMENSIONS.ZSCOPT'
3452 include 'COMMON.LOCAL'
3453 include 'COMMON.GEO'
3454 include 'COMMON.INTERACT'
3455 include 'COMMON.DERIV'
3456 include 'COMMON.VAR'
3457 include 'COMMON.CHAIN'
3458 include 'COMMON.IOUNITS'
3459 include 'COMMON.NAMES'
3460 include 'COMMON.FFIELD'
3461 include 'COMMON.CONTROL'
3462 logical energy_dec /.false./
3463 double precision u(3),ud(3)
3466 c write (iout,*) "distchainmax",distchainmax
3468 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3469 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3471 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3472 C & *dc(j,i-1)/vbld(i)
3474 C if (energy_dec) write(iout,*)
3475 C & "estr1",i,vbld(i),distchainmax,
3476 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3478 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3479 diff = vbld(i)-vbldpDUM
3481 diff = vbld(i)-vbldp0
3482 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3486 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3489 C write (iout,'(a7,i5,4f7.3)')
3490 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3492 estr=0.5d0*AKP*estr+estr1
3494 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3498 if (iti.ne.10 .and. iti.ne.ntyp1) then
3501 diff=vbld(i+nres)-vbldsc0(1,iti)
3502 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3503 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3504 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3506 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3510 diff=vbld(i+nres)-vbldsc0(j,iti)
3511 ud(j)=aksc(j,iti)*diff
3512 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3526 uprod2=uprod2*u(k)*u(k)
3530 usumsqder=usumsqder+ud(j)*uprod2
3532 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3533 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3534 estr=estr+uprod/usum
3536 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3544 C--------------------------------------------------------------------------
3545 subroutine ebend(etheta,ethetacnstr)
3547 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3548 C angles gamma and its derivatives in consecutive thetas and gammas.
3550 implicit real*8 (a-h,o-z)
3551 include 'DIMENSIONS'
3552 include 'DIMENSIONS.ZSCOPT'
3553 include 'COMMON.LOCAL'
3554 include 'COMMON.GEO'
3555 include 'COMMON.INTERACT'
3556 include 'COMMON.DERIV'
3557 include 'COMMON.VAR'
3558 include 'COMMON.CHAIN'
3559 include 'COMMON.IOUNITS'
3560 include 'COMMON.NAMES'
3561 include 'COMMON.FFIELD'
3562 include 'COMMON.TORCNSTR'
3563 common /calcthet/ term1,term2,termm,diffak,ratak,
3564 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3565 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3566 double precision y(2),z(2)
3568 c time11=dexp(-2*time)
3571 c write (iout,*) "nres",nres
3572 c write (*,'(a,i2)') 'EBEND ICG=',icg
3573 c write (iout,*) ithet_start,ithet_end
3574 do i=ithet_start,ithet_end
3575 C if (itype(i-1).eq.ntyp1) cycle
3577 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3578 & .or.itype(i).eq.ntyp1) cycle
3579 C Zero the energy function and its derivative at 0 or pi.
3580 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3582 ichir1=isign(1,itype(i-2))
3583 ichir2=isign(1,itype(i))
3584 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3585 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3586 if (itype(i-1).eq.10) then
3587 itype1=isign(10,itype(i-2))
3588 ichir11=isign(1,itype(i-2))
3589 ichir12=isign(1,itype(i-2))
3590 itype2=isign(10,itype(i))
3591 ichir21=isign(1,itype(i))
3592 ichir22=isign(1,itype(i))
3599 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3603 c call proc_proc(phii,icrc)
3604 if (icrc.eq.1) phii=150.0
3615 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3619 c call proc_proc(phii1,icrc)
3620 if (icrc.eq.1) phii1=150.0
3632 C Calculate the "mean" value of theta from the part of the distribution
3633 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3634 C In following comments this theta will be referred to as t_c.
3635 thet_pred_mean=0.0d0
3637 athetk=athet(k,it,ichir1,ichir2)
3638 bthetk=bthet(k,it,ichir1,ichir2)
3640 athetk=athet(k,itype1,ichir11,ichir12)
3641 bthetk=bthet(k,itype2,ichir21,ichir22)
3643 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3645 c write (iout,*) "thet_pred_mean",thet_pred_mean
3646 dthett=thet_pred_mean*ssd
3647 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3648 c write (iout,*) "thet_pred_mean",thet_pred_mean
3649 C Derivatives of the "mean" values in gamma1 and gamma2.
3650 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3651 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3652 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3653 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3655 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3656 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3657 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3658 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3660 if (theta(i).gt.pi-delta) then
3661 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3663 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3664 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3665 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3667 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3669 else if (theta(i).lt.delta) then
3670 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3671 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3672 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3674 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3675 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3678 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3681 etheta=etheta+ethetai
3682 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3683 c & 'ebend',i,ethetai,theta(i),itype(i)
3684 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3685 c & rad2deg*phii,rad2deg*phii1,ethetai
3686 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3687 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3688 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3692 print *,ntheta_constr,"TU"
3693 do i=1,ntheta_constr
3694 itheta=itheta_constr(i)
3695 thetiii=theta(itheta)
3696 difi=pinorm(thetiii-theta_constr0(i))
3697 if (difi.gt.theta_drange(i)) then
3698 difi=difi-theta_drange(i)
3699 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3700 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3701 & +for_thet_constr(i)*difi**3
3702 else if (difi.lt.-drange(i)) then
3704 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3705 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3706 & +for_thet_constr(i)*difi**3
3710 C if (energy_dec) then
3711 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3712 C & i,itheta,rad2deg*thetiii,
3713 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3714 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3715 C & gloc(itheta+nphi-2,icg)
3718 C Ufff.... We've done all this!!!
3721 C---------------------------------------------------------------------------
3722 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3724 implicit real*8 (a-h,o-z)
3725 include 'DIMENSIONS'
3726 include 'COMMON.LOCAL'
3727 include 'COMMON.IOUNITS'
3728 common /calcthet/ term1,term2,termm,diffak,ratak,
3729 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3730 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3731 C Calculate the contributions to both Gaussian lobes.
3732 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3733 C The "polynomial part" of the "standard deviation" of this part of
3737 sig=sig*thet_pred_mean+polthet(j,it)
3739 C Derivative of the "interior part" of the "standard deviation of the"
3740 C gamma-dependent Gaussian lobe in t_c.
3741 sigtc=3*polthet(3,it)
3743 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3746 C Set the parameters of both Gaussian lobes of the distribution.
3747 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3748 fac=sig*sig+sigc0(it)
3751 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3752 sigsqtc=-4.0D0*sigcsq*sigtc
3753 c print *,i,sig,sigtc,sigsqtc
3754 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3755 sigtc=-sigtc/(fac*fac)
3756 C Following variable is sigma(t_c)**(-2)
3757 sigcsq=sigcsq*sigcsq
3759 sig0inv=1.0D0/sig0i**2
3760 delthec=thetai-thet_pred_mean
3761 delthe0=thetai-theta0i
3762 term1=-0.5D0*sigcsq*delthec*delthec
3763 term2=-0.5D0*sig0inv*delthe0*delthe0
3764 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3765 C NaNs in taking the logarithm. We extract the largest exponent which is added
3766 C to the energy (this being the log of the distribution) at the end of energy
3767 C term evaluation for this virtual-bond angle.
3768 if (term1.gt.term2) then
3770 term2=dexp(term2-termm)
3774 term1=dexp(term1-termm)
3777 C The ratio between the gamma-independent and gamma-dependent lobes of
3778 C the distribution is a Gaussian function of thet_pred_mean too.
3779 diffak=gthet(2,it)-thet_pred_mean
3780 ratak=diffak/gthet(3,it)**2
3781 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3782 C Let's differentiate it in thet_pred_mean NOW.
3784 C Now put together the distribution terms to make complete distribution.
3785 termexp=term1+ak*term2
3786 termpre=sigc+ak*sig0i
3787 C Contribution of the bending energy from this theta is just the -log of
3788 C the sum of the contributions from the two lobes and the pre-exponential
3789 C factor. Simple enough, isn't it?
3790 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3791 C NOW the derivatives!!!
3792 C 6/6/97 Take into account the deformation.
3793 E_theta=(delthec*sigcsq*term1
3794 & +ak*delthe0*sig0inv*term2)/termexp
3795 E_tc=((sigtc+aktc*sig0i)/termpre
3796 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3797 & aktc*term2)/termexp)
3800 c-----------------------------------------------------------------------------
3801 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3802 implicit real*8 (a-h,o-z)
3803 include 'DIMENSIONS'
3804 include 'COMMON.LOCAL'
3805 include 'COMMON.IOUNITS'
3806 common /calcthet/ term1,term2,termm,diffak,ratak,
3807 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3808 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3809 delthec=thetai-thet_pred_mean
3810 delthe0=thetai-theta0i
3811 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3812 t3 = thetai-thet_pred_mean
3816 t14 = t12+t6*sigsqtc
3818 t21 = thetai-theta0i
3824 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3825 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3826 & *(-t12*t9-ak*sig0inv*t27)
3830 C--------------------------------------------------------------------------
3831 subroutine ebend(etheta,ethetacnstr)
3833 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3834 C angles gamma and its derivatives in consecutive thetas and gammas.
3835 C ab initio-derived potentials from
3836 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3838 implicit real*8 (a-h,o-z)
3839 include 'DIMENSIONS'
3840 include 'DIMENSIONS.ZSCOPT'
3841 include 'COMMON.LOCAL'
3842 include 'COMMON.GEO'
3843 include 'COMMON.INTERACT'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.VAR'
3846 include 'COMMON.CHAIN'
3847 include 'COMMON.IOUNITS'
3848 include 'COMMON.NAMES'
3849 include 'COMMON.FFIELD'
3850 include 'COMMON.CONTROL'
3851 include 'COMMON.TORCNSTR'
3852 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3853 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3854 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3855 & sinph1ph2(maxdouble,maxdouble)
3856 logical lprn /.false./, lprn1 /.false./
3858 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3859 do i=ithet_start,ithet_end
3861 C if (itype(i-1).eq.ntyp1) cycle
3863 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3864 & .or.itype(i).eq.ntyp1) cycle
3865 if (iabs(itype(i+1)).eq.20) iblock=2
3866 if (iabs(itype(i+1)).ne.20) iblock=1
3870 theti2=0.5d0*theta(i)
3871 ityp2=ithetyp((itype(i-1)))
3873 coskt(k)=dcos(k*theti2)
3874 sinkt(k)=dsin(k*theti2)
3884 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3887 if (phii.ne.phii) phii=150.0
3891 ityp1=ithetyp((itype(i-2)))
3893 cosph1(k)=dcos(k*phii)
3894 sinph1(k)=dsin(k*phii)
3900 ityp1=ithetyp((itype(i-2)))
3906 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3909 if (phii1.ne.phii1) phii1=150.0
3914 ityp3=ithetyp((itype(i)))
3916 cosph2(k)=dcos(k*phii1)
3917 sinph2(k)=dsin(k*phii1)
3922 ityp3=ithetyp((itype(i)))
3928 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3929 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3931 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3934 ccl=cosph1(l)*cosph2(k-l)
3935 ssl=sinph1(l)*sinph2(k-l)
3936 scl=sinph1(l)*cosph2(k-l)
3937 csl=cosph1(l)*sinph2(k-l)
3938 cosph1ph2(l,k)=ccl-ssl
3939 cosph1ph2(k,l)=ccl+ssl
3940 sinph1ph2(l,k)=scl+csl
3941 sinph1ph2(k,l)=scl-csl
3945 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3946 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3947 write (iout,*) "coskt and sinkt"
3949 write (iout,*) k,coskt(k),sinkt(k)
3953 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3954 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3957 & write (iout,*) "k",k,"
3958 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3959 & " ethetai",ethetai
3962 write (iout,*) "cosph and sinph"
3964 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3966 write (iout,*) "cosph1ph2 and sinph2ph2"
3969 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3970 & sinph1ph2(l,k),sinph1ph2(k,l)
3973 write(iout,*) "ethetai",ethetai
3977 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3978 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3979 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3980 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3981 ethetai=ethetai+sinkt(m)*aux
3982 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3983 dephii=dephii+k*sinkt(m)*(
3984 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3985 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3986 dephii1=dephii1+k*sinkt(m)*(
3987 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3988 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3990 & write (iout,*) "m",m," k",k," bbthet",
3991 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3992 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3993 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3994 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3998 & write(iout,*) "ethetai",ethetai
4002 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4003 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4004 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4005 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4006 ethetai=ethetai+sinkt(m)*aux
4007 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4008 dephii=dephii+l*sinkt(m)*(
4009 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4010 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4011 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4012 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4013 dephii1=dephii1+(k-l)*sinkt(m)*(
4014 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4015 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4016 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4017 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4019 write (iout,*) "m",m," k",k," l",l," ffthet",
4020 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4021 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4022 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4023 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4024 & " ethetai",ethetai
4025 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4026 & cosph1ph2(k,l)*sinkt(m),
4027 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4033 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4034 & i,theta(i)*rad2deg,phii*rad2deg,
4035 & phii1*rad2deg,ethetai
4036 etheta=etheta+ethetai
4037 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4038 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4039 c gloc(nphi+i-2,icg)=wang*dethetai
4040 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4044 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4045 do i=1,ntheta_constr
4046 itheta=itheta_constr(i)
4047 thetiii=theta(itheta)
4048 difi=pinorm(thetiii-theta_constr0(i))
4049 if (difi.gt.theta_drange(i)) then
4050 difi=difi-theta_drange(i)
4051 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4052 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4053 & +for_thet_constr(i)*difi**3
4054 else if (difi.lt.-drange(i)) then
4056 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4057 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4058 & +for_thet_constr(i)*difi**3
4062 C if (energy_dec) then
4063 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4064 C & i,itheta,rad2deg*thetiii,
4065 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4066 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4067 C & gloc(itheta+nphi-2,icg)
4074 c-----------------------------------------------------------------------------
4075 subroutine esc(escloc)
4076 C Calculate the local energy of a side chain and its derivatives in the
4077 C corresponding virtual-bond valence angles THETA and the spherical angles
4079 implicit real*8 (a-h,o-z)
4080 include 'DIMENSIONS'
4081 include 'DIMENSIONS.ZSCOPT'
4082 include 'COMMON.GEO'
4083 include 'COMMON.LOCAL'
4084 include 'COMMON.VAR'
4085 include 'COMMON.INTERACT'
4086 include 'COMMON.DERIV'
4087 include 'COMMON.CHAIN'
4088 include 'COMMON.IOUNITS'
4089 include 'COMMON.NAMES'
4090 include 'COMMON.FFIELD'
4091 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4092 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4093 common /sccalc/ time11,time12,time112,theti,it,nlobit
4096 C write (iout,*) 'ESC'
4097 do i=loc_start,loc_end
4099 if (it.eq.ntyp1) cycle
4100 if (it.eq.10) goto 1
4101 nlobit=nlob(iabs(it))
4102 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4103 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4104 theti=theta(i+1)-pipol
4108 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4110 if (x(2).gt.pi-delta) then
4114 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4116 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4117 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4119 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4120 & ddersc0(1),dersc(1))
4121 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4122 & ddersc0(3),dersc(3))
4124 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4126 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4127 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4128 & dersc0(2),esclocbi,dersc02)
4129 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4131 call splinthet(x(2),0.5d0*delta,ss,ssd)
4136 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4138 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4139 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4141 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4143 c write (iout,*) escloci
4144 else if (x(2).lt.delta) then
4148 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4150 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4151 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4153 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4154 & ddersc0(1),dersc(1))
4155 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4156 & ddersc0(3),dersc(3))
4158 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4160 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4161 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4162 & dersc0(2),esclocbi,dersc02)
4163 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4168 call splinthet(x(2),0.5d0*delta,ss,ssd)
4170 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4172 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4173 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4175 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4176 C write (iout,*) 'i=',i, escloci
4178 call enesc(x,escloci,dersc,ddummy,.false.)
4181 escloc=escloc+escloci
4182 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4183 write (iout,'(a6,i5,0pf7.3)')
4184 & 'escloc',i,escloci
4186 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4188 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4189 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4194 C---------------------------------------------------------------------------
4195 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4196 implicit real*8 (a-h,o-z)
4197 include 'DIMENSIONS'
4198 include 'COMMON.GEO'
4199 include 'COMMON.LOCAL'
4200 include 'COMMON.IOUNITS'
4201 common /sccalc/ time11,time12,time112,theti,it,nlobit
4202 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4203 double precision contr(maxlob,-1:1)
4205 c write (iout,*) 'it=',it,' nlobit=',nlobit
4209 if (mixed) ddersc(j)=0.0d0
4213 C Because of periodicity of the dependence of the SC energy in omega we have
4214 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4215 C To avoid underflows, first compute & store the exponents.
4223 z(k)=x(k)-censc(k,j,it)
4228 Axk=Axk+gaussc(l,k,j,it)*z(l)
4234 expfac=expfac+Ax(k,j,iii)*z(k)
4242 C As in the case of ebend, we want to avoid underflows in exponentiation and
4243 C subsequent NaNs and INFs in energy calculation.
4244 C Find the largest exponent
4248 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4252 cd print *,'it=',it,' emin=',emin
4254 C Compute the contribution to SC energy and derivatives
4258 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4259 cd print *,'j=',j,' expfac=',expfac
4260 escloc_i=escloc_i+expfac
4262 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4266 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4267 & +gaussc(k,2,j,it))*expfac
4274 dersc(1)=dersc(1)/cos(theti)**2
4275 ddersc(1)=ddersc(1)/cos(theti)**2
4278 escloci=-(dlog(escloc_i)-emin)
4280 dersc(j)=dersc(j)/escloc_i
4284 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4289 C------------------------------------------------------------------------------
4290 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4291 implicit real*8 (a-h,o-z)
4292 include 'DIMENSIONS'
4293 include 'COMMON.GEO'
4294 include 'COMMON.LOCAL'
4295 include 'COMMON.IOUNITS'
4296 common /sccalc/ time11,time12,time112,theti,it,nlobit
4297 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4298 double precision contr(maxlob)
4309 z(k)=x(k)-censc(k,j,it)
4315 Axk=Axk+gaussc(l,k,j,it)*z(l)
4321 expfac=expfac+Ax(k,j)*z(k)
4326 C As in the case of ebend, we want to avoid underflows in exponentiation and
4327 C subsequent NaNs and INFs in energy calculation.
4328 C Find the largest exponent
4331 if (emin.gt.contr(j)) emin=contr(j)
4335 C Compute the contribution to SC energy and derivatives
4339 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4340 escloc_i=escloc_i+expfac
4342 dersc(k)=dersc(k)+Ax(k,j)*expfac
4344 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4345 & +gaussc(1,2,j,it))*expfac
4349 dersc(1)=dersc(1)/cos(theti)**2
4350 dersc12=dersc12/cos(theti)**2
4351 escloci=-(dlog(escloc_i)-emin)
4353 dersc(j)=dersc(j)/escloc_i
4355 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4359 c----------------------------------------------------------------------------------
4360 subroutine esc(escloc)
4361 C Calculate the local energy of a side chain and its derivatives in the
4362 C corresponding virtual-bond valence angles THETA and the spherical angles
4363 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4364 C added by Urszula Kozlowska. 07/11/2007
4366 implicit real*8 (a-h,o-z)
4367 include 'DIMENSIONS'
4368 include 'DIMENSIONS.ZSCOPT'
4369 include 'COMMON.GEO'
4370 include 'COMMON.LOCAL'
4371 include 'COMMON.VAR'
4372 include 'COMMON.SCROT'
4373 include 'COMMON.INTERACT'
4374 include 'COMMON.DERIV'
4375 include 'COMMON.CHAIN'
4376 include 'COMMON.IOUNITS'
4377 include 'COMMON.NAMES'
4378 include 'COMMON.FFIELD'
4379 include 'COMMON.CONTROL'
4380 include 'COMMON.VECTORS'
4381 double precision x_prime(3),y_prime(3),z_prime(3)
4382 & , sumene,dsc_i,dp2_i,x(65),
4383 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4384 & de_dxx,de_dyy,de_dzz,de_dt
4385 double precision s1_t,s1_6_t,s2_t,s2_6_t
4387 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4388 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4389 & dt_dCi(3),dt_dCi1(3)
4390 common /sccalc/ time11,time12,time112,theti,it,nlobit
4393 do i=loc_start,loc_end
4394 if (itype(i).eq.ntyp1) cycle
4395 costtab(i+1) =dcos(theta(i+1))
4396 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4397 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4398 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4399 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4400 cosfac=dsqrt(cosfac2)
4401 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4402 sinfac=dsqrt(sinfac2)
4404 if (it.eq.10) goto 1
4406 C Compute the axes of tghe local cartesian coordinates system; store in
4407 c x_prime, y_prime and z_prime
4414 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4415 C & dc_norm(3,i+nres)
4417 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4418 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4421 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4424 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4425 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4426 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4427 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4428 c & " xy",scalar(x_prime(1),y_prime(1)),
4429 c & " xz",scalar(x_prime(1),z_prime(1)),
4430 c & " yy",scalar(y_prime(1),y_prime(1)),
4431 c & " yz",scalar(y_prime(1),z_prime(1)),
4432 c & " zz",scalar(z_prime(1),z_prime(1))
4434 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4435 C to local coordinate system. Store in xx, yy, zz.
4441 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4442 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4443 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4450 C Compute the energy of the ith side cbain
4452 c write (2,*) "xx",xx," yy",yy," zz",zz
4455 x(j) = sc_parmin(j,it)
4458 Cc diagnostics - remove later
4460 yy1 = dsin(alph(2))*dcos(omeg(2))
4461 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4462 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4463 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4465 C," --- ", xx_w,yy_w,zz_w
4468 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4469 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4471 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4472 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4474 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4475 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4476 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4477 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4478 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4480 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4481 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4482 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4483 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4484 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4486 dsc_i = 0.743d0+x(61)
4488 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4489 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4490 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4491 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4492 s1=(1+x(63))/(0.1d0 + dscp1)
4493 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4494 s2=(1+x(65))/(0.1d0 + dscp2)
4495 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4496 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4497 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4498 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4500 c & dscp1,dscp2,sumene
4501 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4502 escloc = escloc + sumene
4503 c write (2,*) "escloc",escloc
4504 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4506 if (.not. calc_grad) goto 1
4509 C This section to check the numerical derivatives of the energy of ith side
4510 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4511 C #define DEBUG in the code to turn it on.
4513 write (2,*) "sumene =",sumene
4517 write (2,*) xx,yy,zz
4518 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4519 de_dxx_num=(sumenep-sumene)/aincr
4521 write (2,*) "xx+ 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_dyy_num=(sumenep-sumene)/aincr
4528 write (2,*) "yy+ sumene from enesc=",sumenep
4531 write (2,*) xx,yy,zz
4532 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4533 de_dzz_num=(sumenep-sumene)/aincr
4535 write (2,*) "zz+ sumene from enesc=",sumenep
4536 costsave=cost2tab(i+1)
4537 sintsave=sint2tab(i+1)
4538 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4539 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4540 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4541 de_dt_num=(sumenep-sumene)/aincr
4542 write (2,*) " t+ sumene from enesc=",sumenep
4543 cost2tab(i+1)=costsave
4544 sint2tab(i+1)=sintsave
4545 C End of diagnostics section.
4548 C Compute the gradient of esc
4550 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4551 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4552 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4553 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4554 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4555 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4556 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4557 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4558 pom1=(sumene3*sint2tab(i+1)+sumene1)
4559 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4560 pom2=(sumene4*cost2tab(i+1)+sumene2)
4561 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4562 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4563 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4564 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4566 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4567 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4568 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4570 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4571 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4572 & +(pom1+pom2)*pom_dx
4574 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4577 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4578 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4579 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4581 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4582 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4583 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4584 & +x(59)*zz**2 +x(60)*xx*zz
4585 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4586 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4587 & +(pom1-pom2)*pom_dy
4589 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4592 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4593 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4594 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4595 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4596 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4597 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4598 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4599 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4601 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4604 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4605 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4606 & +pom1*pom_dt1+pom2*pom_dt2
4608 write(2,*), "de_dt = ", de_dt,de_dt_num
4612 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4613 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4614 cosfac2xx=cosfac2*xx
4615 sinfac2yy=sinfac2*yy
4617 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4619 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4621 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4622 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4623 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4624 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4625 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4626 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4627 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4628 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4629 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4630 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4634 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4635 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4636 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4637 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4640 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4641 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4642 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4644 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4645 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4649 dXX_Ctab(k,i)=dXX_Ci(k)
4650 dXX_C1tab(k,i)=dXX_Ci1(k)
4651 dYY_Ctab(k,i)=dYY_Ci(k)
4652 dYY_C1tab(k,i)=dYY_Ci1(k)
4653 dZZ_Ctab(k,i)=dZZ_Ci(k)
4654 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4655 dXX_XYZtab(k,i)=dXX_XYZ(k)
4656 dYY_XYZtab(k,i)=dYY_XYZ(k)
4657 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4661 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4662 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4663 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4664 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4665 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4667 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4668 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4669 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4670 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4671 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4672 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4673 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4674 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4676 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4677 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4679 C to check gradient call subroutine check_grad
4686 c------------------------------------------------------------------------------
4687 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4689 C This procedure calculates two-body contact function g(rij) and its derivative:
4692 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4695 C where x=(rij-r0ij)/delta
4697 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4700 double precision rij,r0ij,eps0ij,fcont,fprimcont
4701 double precision x,x2,x4,delta
4705 if (x.lt.-1.0D0) then
4708 else if (x.le.1.0D0) then
4711 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4712 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4719 c------------------------------------------------------------------------------
4720 subroutine splinthet(theti,delta,ss,ssder)
4721 implicit real*8 (a-h,o-z)
4722 include 'DIMENSIONS'
4723 include 'DIMENSIONS.ZSCOPT'
4724 include 'COMMON.VAR'
4725 include 'COMMON.GEO'
4728 if (theti.gt.pipol) then
4729 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4731 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4736 c------------------------------------------------------------------------------
4737 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4739 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4740 double precision ksi,ksi2,ksi3,a1,a2,a3
4741 a1=fprim0*delta/(f1-f0)
4747 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4748 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4751 c------------------------------------------------------------------------------
4752 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4754 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4755 double precision ksi,ksi2,ksi3,a1,a2,a3
4760 a2=3*(f1x-f0x)-2*fprim0x*delta
4761 a3=fprim0x*delta-2*(f1x-f0x)
4762 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4765 C-----------------------------------------------------------------------------
4767 C-----------------------------------------------------------------------------
4768 subroutine etor(etors,edihcnstr,fact)
4769 implicit real*8 (a-h,o-z)
4770 include 'DIMENSIONS'
4771 include 'DIMENSIONS.ZSCOPT'
4772 include 'COMMON.VAR'
4773 include 'COMMON.GEO'
4774 include 'COMMON.LOCAL'
4775 include 'COMMON.TORSION'
4776 include 'COMMON.INTERACT'
4777 include 'COMMON.DERIV'
4778 include 'COMMON.CHAIN'
4779 include 'COMMON.NAMES'
4780 include 'COMMON.IOUNITS'
4781 include 'COMMON.FFIELD'
4782 include 'COMMON.TORCNSTR'
4784 C Set lprn=.true. for debugging
4788 do i=iphi_start,iphi_end
4789 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4790 & .or. itype(i).eq.ntyp1) cycle
4791 itori=itortyp(itype(i-2))
4792 itori1=itortyp(itype(i-1))
4795 C Proline-Proline pair is a special case...
4796 if (itori.eq.3 .and. itori1.eq.3) then
4797 if (phii.gt.-dwapi3) then
4799 fac=1.0D0/(1.0D0-cosphi)
4800 etorsi=v1(1,3,3)*fac
4801 etorsi=etorsi+etorsi
4802 etors=etors+etorsi-v1(1,3,3)
4803 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4806 v1ij=v1(j+1,itori,itori1)
4807 v2ij=v2(j+1,itori,itori1)
4810 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4811 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4815 v1ij=v1(j,itori,itori1)
4816 v2ij=v2(j,itori,itori1)
4819 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4820 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4824 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4825 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4826 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4827 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4828 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4830 ! 6/20/98 - dihedral angle constraints
4833 itori=idih_constr(i)
4836 if (difi.gt.drange(i)) then
4838 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4839 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4840 else if (difi.lt.-drange(i)) then
4842 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4843 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4845 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4846 C & i,itori,rad2deg*phii,
4847 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4849 ! write (iout,*) 'edihcnstr',edihcnstr
4852 c------------------------------------------------------------------------------
4854 subroutine etor(etors,edihcnstr,fact)
4855 implicit real*8 (a-h,o-z)
4856 include 'DIMENSIONS'
4857 include 'DIMENSIONS.ZSCOPT'
4858 include 'COMMON.VAR'
4859 include 'COMMON.GEO'
4860 include 'COMMON.LOCAL'
4861 include 'COMMON.TORSION'
4862 include 'COMMON.INTERACT'
4863 include 'COMMON.DERIV'
4864 include 'COMMON.CHAIN'
4865 include 'COMMON.NAMES'
4866 include 'COMMON.IOUNITS'
4867 include 'COMMON.FFIELD'
4868 include 'COMMON.TORCNSTR'
4870 C Set lprn=.true. for debugging
4874 do i=iphi_start,iphi_end
4876 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4877 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4878 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4879 C & .or. itype(i).eq.ntyp1) cycle
4880 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4881 if (iabs(itype(i)).eq.20) then
4886 itori=itortyp(itype(i-2))
4887 itori1=itortyp(itype(i-1))
4890 C Regular cosine and sine terms
4891 do j=1,nterm(itori,itori1,iblock)
4892 v1ij=v1(j,itori,itori1,iblock)
4893 v2ij=v2(j,itori,itori1,iblock)
4896 etors=etors+v1ij*cosphi+v2ij*sinphi
4897 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4901 C E = SUM ----------------------------------- - v1
4902 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4904 cosphi=dcos(0.5d0*phii)
4905 sinphi=dsin(0.5d0*phii)
4906 do j=1,nlor(itori,itori1,iblock)
4907 vl1ij=vlor1(j,itori,itori1)
4908 vl2ij=vlor2(j,itori,itori1)
4909 vl3ij=vlor3(j,itori,itori1)
4910 pom=vl2ij*cosphi+vl3ij*sinphi
4911 pom1=1.0d0/(pom*pom+1.0d0)
4912 etors=etors+vl1ij*pom1
4913 c if (energy_dec) etors_ii=etors_ii+
4916 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4918 C Subtract the constant term
4919 etors=etors-v0(itori,itori1,iblock)
4921 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4922 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4923 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4924 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4925 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4928 ! 6/20/98 - dihedral angle constraints
4931 itori=idih_constr(i)
4933 difi=pinorm(phii-phi0(i))
4935 if (difi.gt.drange(i)) then
4937 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4938 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4939 edihi=0.25d0*ftors(i)*difi**4
4940 else if (difi.lt.-drange(i)) then
4942 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4943 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4944 edihi=0.25d0*ftors(i)*difi**4
4948 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4949 & i,itori,rad2deg*phii,
4950 & rad2deg*difi,0.25d0*ftors(i)*difi**4
4951 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4953 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4954 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4956 ! write (iout,*) 'edihcnstr',edihcnstr
4959 c----------------------------------------------------------------------------
4960 subroutine etor_d(etors_d,fact2)
4961 C 6/23/01 Compute double torsional energy
4962 implicit real*8 (a-h,o-z)
4963 include 'DIMENSIONS'
4964 include 'DIMENSIONS.ZSCOPT'
4965 include 'COMMON.VAR'
4966 include 'COMMON.GEO'
4967 include 'COMMON.LOCAL'
4968 include 'COMMON.TORSION'
4969 include 'COMMON.INTERACT'
4970 include 'COMMON.DERIV'
4971 include 'COMMON.CHAIN'
4972 include 'COMMON.NAMES'
4973 include 'COMMON.IOUNITS'
4974 include 'COMMON.FFIELD'
4975 include 'COMMON.TORCNSTR'
4977 C Set lprn=.true. for debugging
4981 do i=iphi_start,iphi_end-1
4983 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4984 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4985 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4986 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4987 & (itype(i+1).eq.ntyp1)) cycle
4988 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4990 itori=itortyp(itype(i-2))
4991 itori1=itortyp(itype(i-1))
4992 itori2=itortyp(itype(i))
4998 if (iabs(itype(i+1)).eq.20) iblock=2
4999 C Regular cosine and sine terms
5000 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5001 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5002 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5003 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5004 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5005 cosphi1=dcos(j*phii)
5006 sinphi1=dsin(j*phii)
5007 cosphi2=dcos(j*phii1)
5008 sinphi2=dsin(j*phii1)
5009 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5010 & v2cij*cosphi2+v2sij*sinphi2
5011 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5012 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5014 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5016 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5017 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5018 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5019 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5020 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5021 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5022 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5023 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5024 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5025 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5026 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5027 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5028 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5029 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5032 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5033 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5039 c------------------------------------------------------------------------------
5040 subroutine eback_sc_corr(esccor)
5041 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5042 c conformational states; temporarily implemented as differences
5043 c between UNRES torsional potentials (dependent on three types of
5044 c residues) and the torsional potentials dependent on all 20 types
5045 c of residues computed from AM1 energy surfaces of terminally-blocked
5046 c amino-acid residues.
5047 implicit real*8 (a-h,o-z)
5048 include 'DIMENSIONS'
5049 include 'DIMENSIONS.ZSCOPT'
5050 include 'COMMON.VAR'
5051 include 'COMMON.GEO'
5052 include 'COMMON.LOCAL'
5053 include 'COMMON.TORSION'
5054 include 'COMMON.SCCOR'
5055 include 'COMMON.INTERACT'
5056 include 'COMMON.DERIV'
5057 include 'COMMON.CHAIN'
5058 include 'COMMON.NAMES'
5059 include 'COMMON.IOUNITS'
5060 include 'COMMON.FFIELD'
5061 include 'COMMON.CONTROL'
5063 C Set lprn=.true. for debugging
5066 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5068 do i=itau_start,itau_end
5069 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5071 isccori=isccortyp(itype(i-2))
5072 isccori1=isccortyp(itype(i-1))
5074 do intertyp=1,3 !intertyp
5075 cc Added 09 May 2012 (Adasko)
5076 cc Intertyp means interaction type of backbone mainchain correlation:
5077 c 1 = SC...Ca...Ca...Ca
5078 c 2 = Ca...Ca...Ca...SC
5079 c 3 = SC...Ca...Ca...SCi
5081 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5082 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5083 & (itype(i-1).eq.ntyp1)))
5084 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5085 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5086 & .or.(itype(i).eq.ntyp1)))
5087 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5088 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5089 & (itype(i-3).eq.ntyp1)))) cycle
5090 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5091 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5093 do j=1,nterm_sccor(isccori,isccori1)
5094 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5095 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5096 cosphi=dcos(j*tauangle(intertyp,i))
5097 sinphi=dsin(j*tauangle(intertyp,i))
5098 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5099 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5101 C write (iout,*)"EBACK_SC_COR",esccor,i
5102 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5103 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5104 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5106 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5107 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5108 & (v1sccor(j,1,itori,itori1),j=1,6)
5109 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5110 c gsccor_loc(i-3)=gloci
5115 c------------------------------------------------------------------------------
5116 subroutine multibody(ecorr)
5117 C This subroutine calculates multi-body contributions to energy following
5118 C the idea of Skolnick et al. If side chains I and J make a contact and
5119 C at the same time side chains I+1 and J+1 make a contact, an extra
5120 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5121 implicit real*8 (a-h,o-z)
5122 include 'DIMENSIONS'
5123 include 'COMMON.IOUNITS'
5124 include 'COMMON.DERIV'
5125 include 'COMMON.INTERACT'
5126 include 'COMMON.CONTACTS'
5127 double precision gx(3),gx1(3)
5130 C Set lprn=.true. for debugging
5134 write (iout,'(a)') 'Contact function values:'
5136 write (iout,'(i2,20(1x,i2,f10.5))')
5137 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5152 num_conti=num_cont(i)
5153 num_conti1=num_cont(i1)
5158 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5159 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5160 cd & ' ishift=',ishift
5161 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5162 C The system gains extra energy.
5163 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5164 endif ! j1==j+-ishift
5173 c------------------------------------------------------------------------------
5174 double precision function esccorr(i,j,k,l,jj,kk)
5175 implicit real*8 (a-h,o-z)
5176 include 'DIMENSIONS'
5177 include 'COMMON.IOUNITS'
5178 include 'COMMON.DERIV'
5179 include 'COMMON.INTERACT'
5180 include 'COMMON.CONTACTS'
5181 double precision gx(3),gx1(3)
5186 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5187 C Calculate the multi-body contribution to energy.
5188 C Calculate multi-body contributions to the gradient.
5189 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5190 cd & k,l,(gacont(m,kk,k),m=1,3)
5192 gx(m) =ekl*gacont(m,jj,i)
5193 gx1(m)=eij*gacont(m,kk,k)
5194 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5195 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5196 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5197 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5201 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5206 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5212 c------------------------------------------------------------------------------
5214 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5215 implicit real*8 (a-h,o-z)
5216 include 'DIMENSIONS'
5217 integer dimen1,dimen2,atom,indx
5218 double precision buffer(dimen1,dimen2)
5219 double precision zapas
5220 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5221 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5222 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5223 num_kont=num_cont_hb(atom)
5227 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5230 buffer(i,indx+22)=facont_hb(i,atom)
5231 buffer(i,indx+23)=ees0p(i,atom)
5232 buffer(i,indx+24)=ees0m(i,atom)
5233 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5235 buffer(1,indx+26)=dfloat(num_kont)
5238 c------------------------------------------------------------------------------
5239 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5240 implicit real*8 (a-h,o-z)
5241 include 'DIMENSIONS'
5242 integer dimen1,dimen2,atom,indx
5243 double precision buffer(dimen1,dimen2)
5244 double precision zapas
5245 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5246 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5247 & ees0m(ntyp,maxres),
5248 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5249 num_kont=buffer(1,indx+26)
5250 num_kont_old=num_cont_hb(atom)
5251 num_cont_hb(atom)=num_kont+num_kont_old
5256 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5259 facont_hb(ii,atom)=buffer(i,indx+22)
5260 ees0p(ii,atom)=buffer(i,indx+23)
5261 ees0m(ii,atom)=buffer(i,indx+24)
5262 jcont_hb(ii,atom)=buffer(i,indx+25)
5266 c------------------------------------------------------------------------------
5268 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5269 C This subroutine calculates multi-body contributions to hydrogen-bonding
5270 implicit real*8 (a-h,o-z)
5271 include 'DIMENSIONS'
5272 include 'DIMENSIONS.ZSCOPT'
5273 include 'COMMON.IOUNITS'
5275 include 'COMMON.INFO'
5277 include 'COMMON.FFIELD'
5278 include 'COMMON.DERIV'
5279 include 'COMMON.INTERACT'
5280 include 'COMMON.CONTACTS'
5282 parameter (max_cont=maxconts)
5283 parameter (max_dim=2*(8*3+2))
5284 parameter (msglen1=max_cont*max_dim*4)
5285 parameter (msglen2=2*msglen1)
5286 integer source,CorrelType,CorrelID,Error
5287 double precision buffer(max_cont,max_dim)
5289 double precision gx(3),gx1(3)
5292 C Set lprn=.true. for debugging
5297 if (fgProcs.le.1) goto 30
5299 write (iout,'(a)') 'Contact function values:'
5301 write (iout,'(2i3,50(1x,i2,f5.2))')
5302 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5303 & j=1,num_cont_hb(i))
5306 C Caution! Following code assumes that electrostatic interactions concerning
5307 C a given atom are split among at most two processors!
5317 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5320 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5321 if (MyRank.gt.0) then
5322 C Send correlation contributions to the preceding processor
5324 nn=num_cont_hb(iatel_s)
5325 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5326 cd write (iout,*) 'The BUFFER array:'
5328 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5330 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5332 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5333 C Clear the contacts of the atom passed to the neighboring processor
5334 nn=num_cont_hb(iatel_s+1)
5336 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5338 num_cont_hb(iatel_s)=0
5340 cd write (iout,*) 'Processor ',MyID,MyRank,
5341 cd & ' is sending correlation contribution to processor',MyID-1,
5342 cd & ' msglen=',msglen
5343 cd write (*,*) 'Processor ',MyID,MyRank,
5344 cd & ' is sending correlation contribution to processor',MyID-1,
5345 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5346 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5347 cd write (iout,*) 'Processor ',MyID,
5348 cd & ' has sent correlation contribution to processor',MyID-1,
5349 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5350 cd write (*,*) 'Processor ',MyID,
5351 cd & ' has sent correlation contribution to processor',MyID-1,
5352 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5354 endif ! (MyRank.gt.0)
5358 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5359 if (MyRank.lt.fgProcs-1) then
5360 C Receive correlation contributions from the next processor
5362 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5363 cd write (iout,*) 'Processor',MyID,
5364 cd & ' is receiving correlation contribution from processor',MyID+1,
5365 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5366 cd write (*,*) 'Processor',MyID,
5367 cd & ' is receiving correlation contribution from processor',MyID+1,
5368 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5370 do while (nbytes.le.0)
5371 call mp_probe(MyID+1,CorrelType,nbytes)
5373 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5374 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5375 cd write (iout,*) 'Processor',MyID,
5376 cd & ' has received correlation contribution from processor',MyID+1,
5377 cd & ' msglen=',msglen,' nbytes=',nbytes
5378 cd write (iout,*) 'The received BUFFER array:'
5380 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5382 if (msglen.eq.msglen1) then
5383 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5384 else if (msglen.eq.msglen2) then
5385 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5386 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5389 & 'ERROR!!!! message length changed while processing correlations.'
5391 & 'ERROR!!!! message length changed while processing correlations.'
5392 call mp_stopall(Error)
5393 endif ! msglen.eq.msglen1
5394 endif ! MyRank.lt.fgProcs-1
5401 write (iout,'(a)') 'Contact function values:'
5403 write (iout,'(2i3,50(1x,i2,f5.2))')
5404 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5405 & j=1,num_cont_hb(i))
5409 C Remove the loop below after debugging !!!
5416 C Calculate the local-electrostatic correlation terms
5417 do i=iatel_s,iatel_e+1
5419 num_conti=num_cont_hb(i)
5420 num_conti1=num_cont_hb(i+1)
5425 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5426 c & ' jj=',jj,' kk=',kk
5427 if (j1.eq.j+1 .or. j1.eq.j-1) then
5428 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5429 C The system gains extra energy.
5430 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5432 else if (j1.eq.j) then
5433 C Contacts I-J and I-(J+1) occur simultaneously.
5434 C The system loses extra energy.
5435 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5440 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5441 c & ' jj=',jj,' kk=',kk
5443 C Contacts I-J and (I+1)-J occur simultaneously.
5444 C The system loses extra energy.
5445 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5452 c------------------------------------------------------------------------------
5453 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5455 C This subroutine calculates multi-body contributions to hydrogen-bonding
5456 implicit real*8 (a-h,o-z)
5457 include 'DIMENSIONS'
5458 include 'DIMENSIONS.ZSCOPT'
5459 include 'COMMON.IOUNITS'
5461 include 'COMMON.INFO'
5463 include 'COMMON.FFIELD'
5464 include 'COMMON.DERIV'
5465 include 'COMMON.INTERACT'
5466 include 'COMMON.CONTACTS'
5468 parameter (max_cont=maxconts)
5469 parameter (max_dim=2*(8*3+2))
5470 parameter (msglen1=max_cont*max_dim*4)
5471 parameter (msglen2=2*msglen1)
5472 integer source,CorrelType,CorrelID,Error
5473 double precision buffer(max_cont,max_dim)
5475 double precision gx(3),gx1(3)
5478 C Set lprn=.true. for debugging
5484 if (fgProcs.le.1) goto 30
5486 write (iout,'(a)') 'Contact function values:'
5488 write (iout,'(2i3,50(1x,i2,f5.2))')
5489 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5490 & j=1,num_cont_hb(i))
5493 C Caution! Following code assumes that electrostatic interactions concerning
5494 C a given atom are split among at most two processors!
5504 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5507 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5508 if (MyRank.gt.0) then
5509 C Send correlation contributions to the preceding processor
5511 nn=num_cont_hb(iatel_s)
5512 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5513 cd write (iout,*) 'The BUFFER array:'
5515 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5517 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5519 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5520 C Clear the contacts of the atom passed to the neighboring processor
5521 nn=num_cont_hb(iatel_s+1)
5523 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5525 num_cont_hb(iatel_s)=0
5527 cd write (iout,*) 'Processor ',MyID,MyRank,
5528 cd & ' is sending correlation contribution to processor',MyID-1,
5529 cd & ' msglen=',msglen
5530 cd write (*,*) 'Processor ',MyID,MyRank,
5531 cd & ' is sending correlation contribution to processor',MyID-1,
5532 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5533 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5534 cd write (iout,*) 'Processor ',MyID,
5535 cd & ' has sent correlation contribution to processor',MyID-1,
5536 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5537 cd write (*,*) 'Processor ',MyID,
5538 cd & ' has sent correlation contribution to processor',MyID-1,
5539 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5541 endif ! (MyRank.gt.0)
5545 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5546 if (MyRank.lt.fgProcs-1) then
5547 C Receive correlation contributions from the next processor
5549 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5550 cd write (iout,*) 'Processor',MyID,
5551 cd & ' is receiving correlation contribution from processor',MyID+1,
5552 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5553 cd write (*,*) 'Processor',MyID,
5554 cd & ' is receiving correlation contribution from processor',MyID+1,
5555 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5557 do while (nbytes.le.0)
5558 call mp_probe(MyID+1,CorrelType,nbytes)
5560 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5561 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5562 cd write (iout,*) 'Processor',MyID,
5563 cd & ' has received correlation contribution from processor',MyID+1,
5564 cd & ' msglen=',msglen,' nbytes=',nbytes
5565 cd write (iout,*) 'The received BUFFER array:'
5567 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5569 if (msglen.eq.msglen1) then
5570 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5571 else if (msglen.eq.msglen2) then
5572 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5573 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5576 & 'ERROR!!!! message length changed while processing correlations.'
5578 & 'ERROR!!!! message length changed while processing correlations.'
5579 call mp_stopall(Error)
5580 endif ! msglen.eq.msglen1
5581 endif ! MyRank.lt.fgProcs-1
5588 write (iout,'(a)') 'Contact function values:'
5590 write (iout,'(2i3,50(1x,i2,f5.2))')
5591 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5592 & j=1,num_cont_hb(i))
5598 C Remove the loop below after debugging !!!
5605 C Calculate the dipole-dipole interaction energies
5606 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5607 do i=iatel_s,iatel_e+1
5608 num_conti=num_cont_hb(i)
5615 C Calculate the local-electrostatic correlation terms
5616 do i=iatel_s,iatel_e+1
5618 num_conti=num_cont_hb(i)
5619 num_conti1=num_cont_hb(i+1)
5624 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5625 c & ' jj=',jj,' kk=',kk
5626 if (j1.eq.j+1 .or. j1.eq.j-1) then
5627 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5628 C The system gains extra energy.
5630 sqd1=dsqrt(d_cont(jj,i))
5631 sqd2=dsqrt(d_cont(kk,i1))
5632 sred_geom = sqd1*sqd2
5633 IF (sred_geom.lt.cutoff_corr) THEN
5634 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5636 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5637 c & ' jj=',jj,' kk=',kk
5638 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5639 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5641 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5642 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5645 cd write (iout,*) 'sred_geom=',sred_geom,
5646 cd & ' ekont=',ekont,' fprim=',fprimcont
5647 call calc_eello(i,j,i+1,j1,jj,kk)
5648 if (wcorr4.gt.0.0d0)
5649 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5650 if (wcorr5.gt.0.0d0)
5651 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5652 c print *,"wcorr5",ecorr5
5653 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5654 cd write(2,*)'ijkl',i,j,i+1,j1
5655 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5656 & .or. wturn6.eq.0.0d0))then
5657 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5658 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5659 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5660 cd & 'ecorr6=',ecorr6
5661 cd write (iout,'(4e15.5)') sred_geom,
5662 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5663 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5664 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5665 else if (wturn6.gt.0.0d0
5666 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5667 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5668 eturn6=eturn6+eello_turn6(i,jj,kk)
5669 cd write (2,*) 'multibody_eello:eturn6',eturn6
5673 else if (j1.eq.j) then
5674 C Contacts I-J and I-(J+1) occur simultaneously.
5675 C The system loses extra energy.
5676 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5681 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5682 c & ' jj=',jj,' kk=',kk
5684 C Contacts I-J and (I+1)-J occur simultaneously.
5685 C The system loses extra energy.
5686 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5693 c------------------------------------------------------------------------------
5694 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5695 implicit real*8 (a-h,o-z)
5696 include 'DIMENSIONS'
5697 include 'COMMON.IOUNITS'
5698 include 'COMMON.DERIV'
5699 include 'COMMON.INTERACT'
5700 include 'COMMON.CONTACTS'
5701 double precision gx(3),gx1(3)
5711 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5712 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5713 C Following 4 lines for diagnostics.
5718 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5720 c write (iout,*)'Contacts have occurred for peptide groups',
5721 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5722 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5723 C Calculate the multi-body contribution to energy.
5724 ecorr=ecorr+ekont*ees
5726 C Calculate multi-body contributions to the gradient.
5728 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5729 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5730 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5731 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5732 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5733 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5734 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5735 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5736 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5737 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5738 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5739 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5740 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5741 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5745 gradcorr(ll,m)=gradcorr(ll,m)+
5746 & ees*ekl*gacont_hbr(ll,jj,i)-
5747 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5748 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5753 gradcorr(ll,m)=gradcorr(ll,m)+
5754 & ees*eij*gacont_hbr(ll,kk,k)-
5755 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5756 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5763 C---------------------------------------------------------------------------
5764 subroutine dipole(i,j,jj)
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'DIMENSIONS.ZSCOPT'
5768 include 'COMMON.IOUNITS'
5769 include 'COMMON.CHAIN'
5770 include 'COMMON.FFIELD'
5771 include 'COMMON.DERIV'
5772 include 'COMMON.INTERACT'
5773 include 'COMMON.CONTACTS'
5774 include 'COMMON.TORSION'
5775 include 'COMMON.VAR'
5776 include 'COMMON.GEO'
5777 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5779 iti1 = itortyp(itype(i+1))
5780 if (j.lt.nres-1) then
5781 if (itype(j).le.ntyp) then
5782 itj1 = itortyp(itype(j+1))
5790 dipi(iii,1)=Ub2(iii,i)
5791 dipderi(iii)=Ub2der(iii,i)
5792 dipi(iii,2)=b1(iii,iti1)
5793 dipj(iii,1)=Ub2(iii,j)
5794 dipderj(iii)=Ub2der(iii,j)
5795 dipj(iii,2)=b1(iii,itj1)
5799 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5802 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5805 if (.not.calc_grad) return
5810 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5814 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5819 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5820 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5822 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5824 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5826 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5830 C---------------------------------------------------------------------------
5831 subroutine calc_eello(i,j,k,l,jj,kk)
5833 C This subroutine computes matrices and vectors needed to calculate
5834 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5836 implicit real*8 (a-h,o-z)
5837 include 'DIMENSIONS'
5838 include 'DIMENSIONS.ZSCOPT'
5839 include 'COMMON.IOUNITS'
5840 include 'COMMON.CHAIN'
5841 include 'COMMON.DERIV'
5842 include 'COMMON.INTERACT'
5843 include 'COMMON.CONTACTS'
5844 include 'COMMON.TORSION'
5845 include 'COMMON.VAR'
5846 include 'COMMON.GEO'
5847 include 'COMMON.FFIELD'
5848 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5849 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5852 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5853 cd & ' jj=',jj,' kk=',kk
5854 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5857 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5858 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5861 call transpose2(aa1(1,1),aa1t(1,1))
5862 call transpose2(aa2(1,1),aa2t(1,1))
5865 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5866 & aa1tder(1,1,lll,kkk))
5867 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5868 & aa2tder(1,1,lll,kkk))
5872 C parallel orientation of the two CA-CA-CA frames.
5873 if (i.gt.1 .and. itype(i).le.ntyp) then
5874 iti=itortyp(itype(i))
5878 itk1=itortyp(itype(k+1))
5879 itj=itortyp(itype(j))
5880 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5881 itl1=itortyp(itype(l+1))
5885 C A1 kernel(j+1) A2T
5887 cd write (iout,'(3f10.5,5x,3f10.5)')
5888 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5890 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5891 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5892 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5893 C Following matrices are needed only for 6-th order cumulants
5894 IF (wcorr6.gt.0.0d0) THEN
5895 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5896 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5897 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5898 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5899 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5900 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5901 & ADtEAderx(1,1,1,1,1,1))
5903 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5904 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5905 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5906 & ADtEA1derx(1,1,1,1,1,1))
5908 C End 6-th order cumulants
5911 cd write (2,*) 'In calc_eello6'
5913 cd write (2,*) 'iii=',iii
5915 cd write (2,*) 'kkk=',kkk
5917 cd write (2,'(3(2f10.5),5x)')
5918 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5923 call transpose2(EUgder(1,1,k),auxmat(1,1))
5924 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5925 call transpose2(EUg(1,1,k),auxmat(1,1))
5926 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5927 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5931 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5932 & EAEAderx(1,1,lll,kkk,iii,1))
5936 C A1T kernel(i+1) A2
5937 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5938 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5939 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5940 C Following matrices are needed only for 6-th order cumulants
5941 IF (wcorr6.gt.0.0d0) THEN
5942 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5943 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5944 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5945 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5946 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5947 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5948 & ADtEAderx(1,1,1,1,1,2))
5949 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5950 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5951 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5952 & ADtEA1derx(1,1,1,1,1,2))
5954 C End 6-th order cumulants
5955 call transpose2(EUgder(1,1,l),auxmat(1,1))
5956 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5957 call transpose2(EUg(1,1,l),auxmat(1,1))
5958 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5959 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5963 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5964 & EAEAderx(1,1,lll,kkk,iii,2))
5969 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5970 C They are needed only when the fifth- or the sixth-order cumulants are
5972 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5973 call transpose2(AEA(1,1,1),auxmat(1,1))
5974 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5975 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5976 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5977 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5978 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5979 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5980 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5981 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5982 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5983 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5984 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5985 call transpose2(AEA(1,1,2),auxmat(1,1))
5986 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5987 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5988 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5989 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5990 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5991 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5992 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5993 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5994 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5995 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5996 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5997 C Calculate the Cartesian derivatives of the vectors.
6001 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6002 call matvec2(auxmat(1,1),b1(1,iti),
6003 & AEAb1derx(1,lll,kkk,iii,1,1))
6004 call matvec2(auxmat(1,1),Ub2(1,i),
6005 & AEAb2derx(1,lll,kkk,iii,1,1))
6006 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6007 & AEAb1derx(1,lll,kkk,iii,2,1))
6008 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6009 & AEAb2derx(1,lll,kkk,iii,2,1))
6010 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6011 call matvec2(auxmat(1,1),b1(1,itj),
6012 & AEAb1derx(1,lll,kkk,iii,1,2))
6013 call matvec2(auxmat(1,1),Ub2(1,j),
6014 & AEAb2derx(1,lll,kkk,iii,1,2))
6015 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6016 & AEAb1derx(1,lll,kkk,iii,2,2))
6017 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6018 & AEAb2derx(1,lll,kkk,iii,2,2))
6025 C Antiparallel orientation of the two CA-CA-CA frames.
6026 if (i.gt.1 .and. itype(i).le.ntyp) then
6027 iti=itortyp(itype(i))
6031 itk1=itortyp(itype(k+1))
6032 itl=itortyp(itype(l))
6033 itj=itortyp(itype(j))
6034 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6035 itj1=itortyp(itype(j+1))
6039 C A2 kernel(j-1)T A1T
6040 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6041 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6042 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6043 C Following matrices are needed only for 6-th order cumulants
6044 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6045 & j.eq.i+4 .and. l.eq.i+3)) THEN
6046 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6047 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6048 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6049 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6050 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6051 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6052 & ADtEAderx(1,1,1,1,1,1))
6053 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6054 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6055 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6056 & ADtEA1derx(1,1,1,1,1,1))
6058 C End 6-th order cumulants
6059 call transpose2(EUgder(1,1,k),auxmat(1,1))
6060 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6061 call transpose2(EUg(1,1,k),auxmat(1,1))
6062 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6063 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6067 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6068 & EAEAderx(1,1,lll,kkk,iii,1))
6072 C A2T kernel(i+1)T A1
6073 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6074 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6075 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6076 C Following matrices are needed only for 6-th order cumulants
6077 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6078 & j.eq.i+4 .and. l.eq.i+3)) THEN
6079 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6080 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6081 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6082 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6083 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6084 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6085 & ADtEAderx(1,1,1,1,1,2))
6086 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6087 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6088 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6089 & ADtEA1derx(1,1,1,1,1,2))
6091 C End 6-th order cumulants
6092 call transpose2(EUgder(1,1,j),auxmat(1,1))
6093 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6094 call transpose2(EUg(1,1,j),auxmat(1,1))
6095 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6096 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6100 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6101 & EAEAderx(1,1,lll,kkk,iii,2))
6106 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6107 C They are needed only when the fifth- or the sixth-order cumulants are
6109 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6110 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6111 call transpose2(AEA(1,1,1),auxmat(1,1))
6112 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6113 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6114 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6115 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6116 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6117 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6118 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6119 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6120 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6121 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6122 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6123 call transpose2(AEA(1,1,2),auxmat(1,1))
6124 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6125 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6126 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6127 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6128 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6129 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6130 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6131 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6132 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6133 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6134 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6135 C Calculate the Cartesian derivatives of the vectors.
6139 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6140 call matvec2(auxmat(1,1),b1(1,iti),
6141 & AEAb1derx(1,lll,kkk,iii,1,1))
6142 call matvec2(auxmat(1,1),Ub2(1,i),
6143 & AEAb2derx(1,lll,kkk,iii,1,1))
6144 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6145 & AEAb1derx(1,lll,kkk,iii,2,1))
6146 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6147 & AEAb2derx(1,lll,kkk,iii,2,1))
6148 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6149 call matvec2(auxmat(1,1),b1(1,itl),
6150 & AEAb1derx(1,lll,kkk,iii,1,2))
6151 call matvec2(auxmat(1,1),Ub2(1,l),
6152 & AEAb2derx(1,lll,kkk,iii,1,2))
6153 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6154 & AEAb1derx(1,lll,kkk,iii,2,2))
6155 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6156 & AEAb2derx(1,lll,kkk,iii,2,2))
6165 C---------------------------------------------------------------------------
6166 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6167 & KK,KKderg,AKA,AKAderg,AKAderx)
6171 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6172 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6173 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6178 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6180 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6183 cd if (lprn) write (2,*) 'In kernel'
6185 cd if (lprn) write (2,*) 'kkk=',kkk
6187 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6188 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6190 cd write (2,*) 'lll=',lll
6191 cd write (2,*) 'iii=1'
6193 cd write (2,'(3(2f10.5),5x)')
6194 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6197 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6198 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6200 cd write (2,*) 'lll=',lll
6201 cd write (2,*) 'iii=2'
6203 cd write (2,'(3(2f10.5),5x)')
6204 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6211 C---------------------------------------------------------------------------
6212 double precision function eello4(i,j,k,l,jj,kk)
6213 implicit real*8 (a-h,o-z)
6214 include 'DIMENSIONS'
6215 include 'DIMENSIONS.ZSCOPT'
6216 include 'COMMON.IOUNITS'
6217 include 'COMMON.CHAIN'
6218 include 'COMMON.DERIV'
6219 include 'COMMON.INTERACT'
6220 include 'COMMON.CONTACTS'
6221 include 'COMMON.TORSION'
6222 include 'COMMON.VAR'
6223 include 'COMMON.GEO'
6224 double precision pizda(2,2),ggg1(3),ggg2(3)
6225 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6229 cd print *,'eello4:',i,j,k,l,jj,kk
6230 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6231 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6232 cold eij=facont_hb(jj,i)
6233 cold ekl=facont_hb(kk,k)
6235 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6237 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6238 gcorr_loc(k-1)=gcorr_loc(k-1)
6239 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6241 gcorr_loc(l-1)=gcorr_loc(l-1)
6242 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6244 gcorr_loc(j-1)=gcorr_loc(j-1)
6245 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6250 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6251 & -EAEAderx(2,2,lll,kkk,iii,1)
6252 cd derx(lll,kkk,iii)=0.0d0
6256 cd gcorr_loc(l-1)=0.0d0
6257 cd gcorr_loc(j-1)=0.0d0
6258 cd gcorr_loc(k-1)=0.0d0
6260 cd write (iout,*)'Contacts have occurred for peptide groups',
6261 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6262 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6263 if (j.lt.nres-1) then
6270 if (l.lt.nres-1) then
6278 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6279 ggg1(ll)=eel4*g_contij(ll,1)
6280 ggg2(ll)=eel4*g_contij(ll,2)
6281 ghalf=0.5d0*ggg1(ll)
6283 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6284 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6285 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6286 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6287 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6288 ghalf=0.5d0*ggg2(ll)
6290 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6291 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6292 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6293 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6298 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6299 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6304 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6305 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6311 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6316 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6320 cd write (2,*) iii,gcorr_loc(iii)
6324 cd write (2,*) 'ekont',ekont
6325 cd write (iout,*) 'eello4',ekont*eel4
6328 C---------------------------------------------------------------------------
6329 double precision function eello5(i,j,k,l,jj,kk)
6330 implicit real*8 (a-h,o-z)
6331 include 'DIMENSIONS'
6332 include 'DIMENSIONS.ZSCOPT'
6333 include 'COMMON.IOUNITS'
6334 include 'COMMON.CHAIN'
6335 include 'COMMON.DERIV'
6336 include 'COMMON.INTERACT'
6337 include 'COMMON.CONTACTS'
6338 include 'COMMON.TORSION'
6339 include 'COMMON.VAR'
6340 include 'COMMON.GEO'
6341 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6342 double precision ggg1(3),ggg2(3)
6343 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6348 C /l\ / \ \ / \ / \ / C
6349 C / \ / \ \ / \ / \ / C
6350 C j| o |l1 | o | o| o | | o |o C
6351 C \ |/k\| |/ \| / |/ \| |/ \| C
6352 C \i/ \ / \ / / \ / \ C
6354 C (I) (II) (III) (IV) C
6356 C eello5_1 eello5_2 eello5_3 eello5_4 C
6358 C Antiparallel chains C
6361 C /j\ / \ \ / \ / \ / C
6362 C / \ / \ \ / \ / \ / C
6363 C j1| o |l | o | o| o | | o |o C
6364 C \ |/k\| |/ \| / |/ \| |/ \| C
6365 C \i/ \ / \ / / \ / \ C
6367 C (I) (II) (III) (IV) C
6369 C eello5_1 eello5_2 eello5_3 eello5_4 C
6371 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6374 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6379 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6381 itk=itortyp(itype(k))
6382 itl=itortyp(itype(l))
6383 itj=itortyp(itype(j))
6388 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6389 cd & eel5_3_num,eel5_4_num)
6393 derx(lll,kkk,iii)=0.0d0
6397 cd eij=facont_hb(jj,i)
6398 cd ekl=facont_hb(kk,k)
6400 cd write (iout,*)'Contacts have occurred for peptide groups',
6401 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6403 C Contribution from the graph I.
6404 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6405 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6406 call transpose2(EUg(1,1,k),auxmat(1,1))
6407 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6408 vv(1)=pizda(1,1)-pizda(2,2)
6409 vv(2)=pizda(1,2)+pizda(2,1)
6410 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6411 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6413 C Explicit gradient in virtual-dihedral angles.
6414 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6415 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6416 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6417 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6418 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6419 vv(1)=pizda(1,1)-pizda(2,2)
6420 vv(2)=pizda(1,2)+pizda(2,1)
6421 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6422 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6423 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6424 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6425 vv(1)=pizda(1,1)-pizda(2,2)
6426 vv(2)=pizda(1,2)+pizda(2,1)
6428 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6429 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6430 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6432 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6433 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6434 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6436 C Cartesian gradient
6440 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6442 vv(1)=pizda(1,1)-pizda(2,2)
6443 vv(2)=pizda(1,2)+pizda(2,1)
6444 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6445 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6446 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6453 C Contribution from graph II
6454 call transpose2(EE(1,1,itk),auxmat(1,1))
6455 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6456 vv(1)=pizda(1,1)+pizda(2,2)
6457 vv(2)=pizda(2,1)-pizda(1,2)
6458 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6459 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6461 C Explicit gradient in virtual-dihedral angles.
6462 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6463 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6464 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6465 vv(1)=pizda(1,1)+pizda(2,2)
6466 vv(2)=pizda(2,1)-pizda(1,2)
6468 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6469 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6470 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6472 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6473 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6474 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6476 C Cartesian gradient
6480 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6482 vv(1)=pizda(1,1)+pizda(2,2)
6483 vv(2)=pizda(2,1)-pizda(1,2)
6484 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6485 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6486 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6495 C Parallel orientation
6496 C Contribution from graph III
6497 call transpose2(EUg(1,1,l),auxmat(1,1))
6498 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6499 vv(1)=pizda(1,1)-pizda(2,2)
6500 vv(2)=pizda(1,2)+pizda(2,1)
6501 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6502 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6504 C Explicit gradient in virtual-dihedral angles.
6505 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6506 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6507 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6508 call matmat2(AEAderg(1,1,2),auxmat(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(k-1)=g_corr5_loc(k-1)
6512 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6513 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6514 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6515 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6516 vv(1)=pizda(1,1)-pizda(2,2)
6517 vv(2)=pizda(1,2)+pizda(2,1)
6518 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6519 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6520 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6521 C Cartesian gradient
6525 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6527 vv(1)=pizda(1,1)-pizda(2,2)
6528 vv(2)=pizda(1,2)+pizda(2,1)
6529 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6530 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6531 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6537 C Contribution from graph IV
6539 call transpose2(EE(1,1,itl),auxmat(1,1))
6540 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6541 vv(1)=pizda(1,1)+pizda(2,2)
6542 vv(2)=pizda(2,1)-pizda(1,2)
6543 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6544 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6546 C Explicit gradient in virtual-dihedral angles.
6547 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6548 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6549 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6550 vv(1)=pizda(1,1)+pizda(2,2)
6551 vv(2)=pizda(2,1)-pizda(1,2)
6552 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6553 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6554 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6555 C Cartesian gradient
6559 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6561 vv(1)=pizda(1,1)+pizda(2,2)
6562 vv(2)=pizda(2,1)-pizda(1,2)
6563 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6564 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6565 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6571 C Antiparallel orientation
6572 C Contribution from graph III
6574 call transpose2(EUg(1,1,j),auxmat(1,1))
6575 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6576 vv(1)=pizda(1,1)-pizda(2,2)
6577 vv(2)=pizda(1,2)+pizda(2,1)
6578 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6579 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6581 C Explicit gradient in virtual-dihedral angles.
6582 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6583 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6584 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6585 call matmat2(AEAderg(1,1,2),auxmat(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(k-1)=g_corr5_loc(k-1)
6589 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6590 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6591 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6592 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6593 vv(1)=pizda(1,1)-pizda(2,2)
6594 vv(2)=pizda(1,2)+pizda(2,1)
6595 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6596 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6597 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6598 C Cartesian gradient
6602 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6604 vv(1)=pizda(1,1)-pizda(2,2)
6605 vv(2)=pizda(1,2)+pizda(2,1)
6606 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6607 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6608 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6614 C Contribution from graph IV
6616 call transpose2(EE(1,1,itj),auxmat(1,1))
6617 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6618 vv(1)=pizda(1,1)+pizda(2,2)
6619 vv(2)=pizda(2,1)-pizda(1,2)
6620 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6621 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6623 C Explicit gradient in virtual-dihedral angles.
6624 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6625 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6626 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6627 vv(1)=pizda(1,1)+pizda(2,2)
6628 vv(2)=pizda(2,1)-pizda(1,2)
6629 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6630 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6631 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6632 C Cartesian gradient
6636 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6638 vv(1)=pizda(1,1)+pizda(2,2)
6639 vv(2)=pizda(2,1)-pizda(1,2)
6640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6641 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6642 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6649 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6650 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6651 cd write (2,*) 'ijkl',i,j,k,l
6652 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6653 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6655 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6656 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6657 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6658 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6660 if (j.lt.nres-1) then
6667 if (l.lt.nres-1) then
6677 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6679 ggg1(ll)=eel5*g_contij(ll,1)
6680 ggg2(ll)=eel5*g_contij(ll,2)
6681 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6682 ghalf=0.5d0*ggg1(ll)
6684 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6685 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6686 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6687 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6688 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6689 ghalf=0.5d0*ggg2(ll)
6691 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6692 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6693 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6694 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6699 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6700 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6705 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6706 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6712 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6717 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6721 cd write (2,*) iii,g_corr5_loc(iii)
6725 cd write (2,*) 'ekont',ekont
6726 cd write (iout,*) 'eello5',ekont*eel5
6729 c--------------------------------------------------------------------------
6730 double precision function eello6(i,j,k,l,jj,kk)
6731 implicit real*8 (a-h,o-z)
6732 include 'DIMENSIONS'
6733 include 'DIMENSIONS.ZSCOPT'
6734 include 'COMMON.IOUNITS'
6735 include 'COMMON.CHAIN'
6736 include 'COMMON.DERIV'
6737 include 'COMMON.INTERACT'
6738 include 'COMMON.CONTACTS'
6739 include 'COMMON.TORSION'
6740 include 'COMMON.VAR'
6741 include 'COMMON.GEO'
6742 include 'COMMON.FFIELD'
6743 double precision ggg1(3),ggg2(3)
6744 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6749 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6757 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6758 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6762 derx(lll,kkk,iii)=0.0d0
6766 cd eij=facont_hb(jj,i)
6767 cd ekl=facont_hb(kk,k)
6773 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6774 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6775 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6776 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6777 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6778 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6780 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6781 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6782 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6783 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6784 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6785 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6789 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6791 C If turn contributions are considered, they will be handled separately.
6792 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6793 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6794 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6795 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6796 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6797 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6798 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6801 if (j.lt.nres-1) then
6808 if (l.lt.nres-1) then
6816 ggg1(ll)=eel6*g_contij(ll,1)
6817 ggg2(ll)=eel6*g_contij(ll,2)
6818 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6819 ghalf=0.5d0*ggg1(ll)
6821 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6822 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6823 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6824 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6825 ghalf=0.5d0*ggg2(ll)
6826 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6828 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6829 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6830 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6831 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6836 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6837 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6842 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6843 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6849 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6854 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6858 cd write (2,*) iii,g_corr6_loc(iii)
6862 cd write (2,*) 'ekont',ekont
6863 cd write (iout,*) 'eello6',ekont*eel6
6866 c--------------------------------------------------------------------------
6867 double precision function eello6_graph1(i,j,k,l,imat,swap)
6868 implicit real*8 (a-h,o-z)
6869 include 'DIMENSIONS'
6870 include 'DIMENSIONS.ZSCOPT'
6871 include 'COMMON.IOUNITS'
6872 include 'COMMON.CHAIN'
6873 include 'COMMON.DERIV'
6874 include 'COMMON.INTERACT'
6875 include 'COMMON.CONTACTS'
6876 include 'COMMON.TORSION'
6877 include 'COMMON.VAR'
6878 include 'COMMON.GEO'
6879 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6883 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6885 C Parallel Antiparallel C
6891 C \ j|/k\| / \ |/k\|l / C
6896 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6897 itk=itortyp(itype(k))
6898 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6899 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6900 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6901 call transpose2(EUgC(1,1,k),auxmat(1,1))
6902 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6903 vv1(1)=pizda1(1,1)-pizda1(2,2)
6904 vv1(2)=pizda1(1,2)+pizda1(2,1)
6905 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6906 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6907 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6908 s5=scalar2(vv(1),Dtobr2(1,i))
6909 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6910 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6911 if (.not. calc_grad) return
6912 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6913 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6914 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6915 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6916 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6917 & +scalar2(vv(1),Dtobr2der(1,i)))
6918 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6919 vv1(1)=pizda1(1,1)-pizda1(2,2)
6920 vv1(2)=pizda1(1,2)+pizda1(2,1)
6921 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6922 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6924 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6925 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6926 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6927 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6928 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6930 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6931 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6932 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6933 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6934 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6936 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6937 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6938 vv1(1)=pizda1(1,1)-pizda1(2,2)
6939 vv1(2)=pizda1(1,2)+pizda1(2,1)
6940 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6941 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6942 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6943 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6952 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6953 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6954 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6955 call transpose2(EUgC(1,1,k),auxmat(1,1))
6956 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6958 vv1(1)=pizda1(1,1)-pizda1(2,2)
6959 vv1(2)=pizda1(1,2)+pizda1(2,1)
6960 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6961 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6962 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6963 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6964 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6965 s5=scalar2(vv(1),Dtobr2(1,i))
6966 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6972 c----------------------------------------------------------------------------
6973 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'DIMENSIONS.ZSCOPT'
6977 include 'COMMON.IOUNITS'
6978 include 'COMMON.CHAIN'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6986 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6987 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6990 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6992 C Parallel Antiparallel C
6998 C \ j|/k\| \ |/k\|l C
7003 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7004 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7005 C AL 7/4/01 s1 would occur in the sixth-order moment,
7006 C but not in a cluster cumulant
7008 s1=dip(1,jj,i)*dip(1,kk,k)
7010 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7011 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7012 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7013 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7014 call transpose2(EUg(1,1,k),auxmat(1,1))
7015 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7016 vv(1)=pizda(1,1)-pizda(2,2)
7017 vv(2)=pizda(1,2)+pizda(2,1)
7018 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7019 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7021 eello6_graph2=-(s1+s2+s3+s4)
7023 eello6_graph2=-(s2+s3+s4)
7026 if (.not. calc_grad) return
7027 C Derivatives in gamma(i-1)
7030 s1=dipderg(1,jj,i)*dip(1,kk,k)
7032 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7033 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7034 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7035 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7037 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7039 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7041 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7043 C Derivatives in gamma(k-1)
7045 s1=dip(1,jj,i)*dipderg(1,kk,k)
7047 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7048 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7049 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7050 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7051 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7052 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7053 vv(1)=pizda(1,1)-pizda(2,2)
7054 vv(2)=pizda(1,2)+pizda(2,1)
7055 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7057 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7059 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7061 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7062 C Derivatives in gamma(j-1) or gamma(l-1)
7065 s1=dipderg(3,jj,i)*dip(1,kk,k)
7067 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7068 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7069 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7070 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7071 vv(1)=pizda(1,1)-pizda(2,2)
7072 vv(2)=pizda(1,2)+pizda(2,1)
7073 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7076 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7078 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7081 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7082 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7084 C Derivatives in gamma(l-1) or gamma(j-1)
7087 s1=dip(1,jj,i)*dipderg(3,kk,k)
7089 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7090 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7091 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7092 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7093 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7094 vv(1)=pizda(1,1)-pizda(2,2)
7095 vv(2)=pizda(1,2)+pizda(2,1)
7096 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7099 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7101 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7104 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7105 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7107 C Cartesian derivatives.
7109 write (2,*) 'In eello6_graph2'
7111 write (2,*) 'iii=',iii
7113 write (2,*) 'kkk=',kkk
7115 write (2,'(3(2f10.5),5x)')
7116 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7126 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7128 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7131 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7133 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7134 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7136 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7137 call transpose2(EUg(1,1,k),auxmat(1,1))
7138 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7140 vv(1)=pizda(1,1)-pizda(2,2)
7141 vv(2)=pizda(1,2)+pizda(2,1)
7142 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7143 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7145 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7147 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7150 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7152 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7159 c----------------------------------------------------------------------------
7160 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7161 implicit real*8 (a-h,o-z)
7162 include 'DIMENSIONS'
7163 include 'DIMENSIONS.ZSCOPT'
7164 include 'COMMON.IOUNITS'
7165 include 'COMMON.CHAIN'
7166 include 'COMMON.DERIV'
7167 include 'COMMON.INTERACT'
7168 include 'COMMON.CONTACTS'
7169 include 'COMMON.TORSION'
7170 include 'COMMON.VAR'
7171 include 'COMMON.GEO'
7172 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7174 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7176 C Parallel Antiparallel C
7182 C j|/k\| / |/k\|l / C
7187 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7189 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7190 C energy moment and not to the cluster cumulant.
7191 iti=itortyp(itype(i))
7192 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7193 itj1=itortyp(itype(j+1))
7197 itk=itortyp(itype(k))
7198 itk1=itortyp(itype(k+1))
7199 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7200 itl1=itortyp(itype(l+1))
7205 s1=dip(4,jj,i)*dip(4,kk,k)
7207 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7208 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7209 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7210 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7211 call transpose2(EE(1,1,itk),auxmat(1,1))
7212 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7213 vv(1)=pizda(1,1)+pizda(2,2)
7214 vv(2)=pizda(2,1)-pizda(1,2)
7215 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7216 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7218 eello6_graph3=-(s1+s2+s3+s4)
7220 eello6_graph3=-(s2+s3+s4)
7223 if (.not. calc_grad) return
7224 C Derivatives in gamma(k-1)
7225 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7226 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7227 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7228 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7229 C Derivatives in gamma(l-1)
7230 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7231 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7232 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7233 vv(1)=pizda(1,1)+pizda(2,2)
7234 vv(2)=pizda(2,1)-pizda(1,2)
7235 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7236 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7237 C Cartesian derivatives.
7243 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7245 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7248 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7250 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7251 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7253 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7254 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7256 vv(1)=pizda(1,1)+pizda(2,2)
7257 vv(2)=pizda(2,1)-pizda(1,2)
7258 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7260 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7262 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7265 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7267 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7269 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7275 c----------------------------------------------------------------------------
7276 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7277 implicit real*8 (a-h,o-z)
7278 include 'DIMENSIONS'
7279 include 'DIMENSIONS.ZSCOPT'
7280 include 'COMMON.IOUNITS'
7281 include 'COMMON.CHAIN'
7282 include 'COMMON.DERIV'
7283 include 'COMMON.INTERACT'
7284 include 'COMMON.CONTACTS'
7285 include 'COMMON.TORSION'
7286 include 'COMMON.VAR'
7287 include 'COMMON.GEO'
7288 include 'COMMON.FFIELD'
7289 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7290 & auxvec1(2),auxmat1(2,2)
7292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7294 C Parallel Antiparallel C
7300 C \ j|/k\| \ |/k\|l C
7305 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7307 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7308 C energy moment and not to the cluster cumulant.
7309 cd write (2,*) 'eello_graph4: wturn6',wturn6
7310 iti=itortyp(itype(i))
7311 itj=itortyp(itype(j))
7312 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7313 itj1=itortyp(itype(j+1))
7317 itk=itortyp(itype(k))
7318 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7319 itk1=itortyp(itype(k+1))
7323 itl=itortyp(itype(l))
7324 if (l.lt.nres-1) then
7325 itl1=itortyp(itype(l+1))
7329 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7330 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7331 cd & ' itl',itl,' itl1',itl1
7334 s1=dip(3,jj,i)*dip(3,kk,k)
7336 s1=dip(2,jj,j)*dip(2,kk,l)
7339 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7340 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7342 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7343 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7345 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7346 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7348 call transpose2(EUg(1,1,k),auxmat(1,1))
7349 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7350 vv(1)=pizda(1,1)-pizda(2,2)
7351 vv(2)=pizda(2,1)+pizda(1,2)
7352 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7353 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7355 eello6_graph4=-(s1+s2+s3+s4)
7357 eello6_graph4=-(s2+s3+s4)
7359 if (.not. calc_grad) return
7360 C Derivatives in gamma(i-1)
7364 s1=dipderg(2,jj,i)*dip(3,kk,k)
7366 s1=dipderg(4,jj,j)*dip(2,kk,l)
7369 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7371 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7372 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7374 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7375 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7377 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7378 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7379 cd write (2,*) 'turn6 derivatives'
7381 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7383 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7387 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7389 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7393 C Derivatives in gamma(k-1)
7396 s1=dip(3,jj,i)*dipderg(2,kk,k)
7398 s1=dip(2,jj,j)*dipderg(4,kk,l)
7401 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7402 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7404 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7405 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7407 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7408 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7410 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7411 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7412 vv(1)=pizda(1,1)-pizda(2,2)
7413 vv(2)=pizda(2,1)+pizda(1,2)
7414 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7415 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7417 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7419 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7423 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7425 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7428 C Derivatives in gamma(j-1) or gamma(l-1)
7429 if (l.eq.j+1 .and. l.gt.1) then
7430 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7431 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7432 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7433 vv(1)=pizda(1,1)-pizda(2,2)
7434 vv(2)=pizda(2,1)+pizda(1,2)
7435 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7436 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7437 else if (j.gt.1) then
7438 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7439 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7440 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7441 vv(1)=pizda(1,1)-pizda(2,2)
7442 vv(2)=pizda(2,1)+pizda(1,2)
7443 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7444 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7445 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7447 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7450 C Cartesian derivatives.
7457 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7459 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7463 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7465 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7469 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7471 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7473 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7474 & b1(1,itj1),auxvec(1))
7475 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7477 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7478 & b1(1,itl1),auxvec(1))
7479 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7481 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7483 vv(1)=pizda(1,1)-pizda(2,2)
7484 vv(2)=pizda(2,1)+pizda(1,2)
7485 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7487 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7489 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7492 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7495 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7498 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7500 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7502 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7506 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7508 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7511 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7513 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7521 c----------------------------------------------------------------------------
7522 double precision function eello_turn6(i,jj,kk)
7523 implicit real*8 (a-h,o-z)
7524 include 'DIMENSIONS'
7525 include 'DIMENSIONS.ZSCOPT'
7526 include 'COMMON.IOUNITS'
7527 include 'COMMON.CHAIN'
7528 include 'COMMON.DERIV'
7529 include 'COMMON.INTERACT'
7530 include 'COMMON.CONTACTS'
7531 include 'COMMON.TORSION'
7532 include 'COMMON.VAR'
7533 include 'COMMON.GEO'
7534 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7535 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7537 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7538 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7539 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7540 C the respective energy moment and not to the cluster cumulant.
7545 iti=itortyp(itype(i))
7546 itk=itortyp(itype(k))
7547 itk1=itortyp(itype(k+1))
7548 itl=itortyp(itype(l))
7549 itj=itortyp(itype(j))
7550 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7551 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7552 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7557 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7559 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7563 derx_turn(lll,kkk,iii)=0.0d0
7570 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7572 cd write (2,*) 'eello6_5',eello6_5
7574 call transpose2(AEA(1,1,1),auxmat(1,1))
7575 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7576 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7577 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7581 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7582 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7583 s2 = scalar2(b1(1,itk),vtemp1(1))
7585 call transpose2(AEA(1,1,2),atemp(1,1))
7586 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7587 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7588 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7592 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7593 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7594 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7596 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7597 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7598 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7599 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7600 ss13 = scalar2(b1(1,itk),vtemp4(1))
7601 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7605 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7611 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7613 C Derivatives in gamma(i+2)
7615 call transpose2(AEA(1,1,1),auxmatd(1,1))
7616 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7617 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7618 call transpose2(AEAderg(1,1,2),atempd(1,1))
7619 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7620 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7624 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7625 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7626 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7632 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7633 C Derivatives in gamma(i+3)
7635 call transpose2(AEA(1,1,1),auxmatd(1,1))
7636 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7637 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7638 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7642 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7643 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7644 s2d = scalar2(b1(1,itk),vtemp1d(1))
7646 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7647 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7649 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7651 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7652 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7653 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7663 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7664 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7666 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7667 & -0.5d0*ekont*(s2d+s12d)
7669 C Derivatives in gamma(i+4)
7670 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7671 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7672 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7674 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7675 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7676 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7686 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7688 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7690 C Derivatives in gamma(i+5)
7692 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7693 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7694 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7698 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7699 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7700 s2d = scalar2(b1(1,itk),vtemp1d(1))
7702 call transpose2(AEA(1,1,2),atempd(1,1))
7703 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7704 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7708 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7709 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7711 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7712 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7713 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7723 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7724 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7726 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7727 & -0.5d0*ekont*(s2d+s12d)
7729 C Cartesian derivatives
7734 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7735 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7736 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7740 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7741 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7743 s2d = scalar2(b1(1,itk),vtemp1d(1))
7745 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7746 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7747 s8d = -(atempd(1,1)+atempd(2,2))*
7748 & scalar2(cc(1,1,itl),vtemp2(1))
7752 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7754 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7755 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7762 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7765 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7769 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7770 & - 0.5d0*(s8d+s12d)
7772 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7781 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7783 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7784 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7785 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7786 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7787 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7789 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7790 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7791 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7795 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7796 cd & 16*eel_turn6_num
7798 if (j.lt.nres-1) then
7805 if (l.lt.nres-1) then
7813 ggg1(ll)=eel_turn6*g_contij(ll,1)
7814 ggg2(ll)=eel_turn6*g_contij(ll,2)
7815 ghalf=0.5d0*ggg1(ll)
7817 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7818 & +ekont*derx_turn(ll,2,1)
7819 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7820 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7821 & +ekont*derx_turn(ll,4,1)
7822 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7823 ghalf=0.5d0*ggg2(ll)
7825 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7826 & +ekont*derx_turn(ll,2,2)
7827 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7828 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7829 & +ekont*derx_turn(ll,4,2)
7830 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7835 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7840 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7846 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7851 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7855 cd write (2,*) iii,g_corr6_loc(iii)
7858 eello_turn6=ekont*eel_turn6
7859 cd write (2,*) 'ekont',ekont
7860 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7863 crc-------------------------------------------------
7864 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7865 subroutine Eliptransfer(eliptran)
7866 implicit real*8 (a-h,o-z)
7867 include 'DIMENSIONS'
7868 include 'COMMON.GEO'
7869 include 'COMMON.VAR'
7870 include 'COMMON.LOCAL'
7871 include 'COMMON.CHAIN'
7872 include 'COMMON.DERIV'
7873 include 'COMMON.INTERACT'
7874 include 'COMMON.IOUNITS'
7875 include 'COMMON.CALC'
7876 include 'COMMON.CONTROL'
7877 include 'COMMON.SPLITELE'
7878 include 'COMMON.SBRIDGE'
7879 C this is done by Adasko
7883 C--bordliptop-- buffore starts
7884 C--bufliptop--- here true lipid starts
7886 C--buflipbot--- lipid ends buffore starts
7887 C--bordlipbot--buffore ends
7891 if (itype(i).eq.ntyp1) cycle
7893 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
7894 if (positi.le.0) positi=positi+boxzsize
7896 C first for peptide groups
7897 c for each residue check if it is in lipid or lipid water border area
7898 if ((positi.gt.bordlipbot)
7899 &.and.(positi.lt.bordliptop)) then
7900 C the energy transfer exist
7901 if (positi.lt.buflipbot) then
7902 C what fraction I am in
7904 & ((positi-bordlipbot)/lipbufthick)
7905 C lipbufthick is thickenes of lipid buffore
7906 sslip=sscalelip(fracinbuf)
7907 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7908 eliptran=eliptran+sslip*pepliptran
7909 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7910 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7911 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7912 elseif (positi.gt.bufliptop) then
7913 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
7914 sslip=sscalelip(fracinbuf)
7915 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7916 eliptran=eliptran+sslip*pepliptran
7917 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7918 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7919 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7920 C print *, "doing sscalefor top part"
7921 C print *,i,sslip,fracinbuf,ssgradlip
7923 eliptran=eliptran+pepliptran
7924 C print *,"I am in true lipid"
7927 C eliptran=elpitran+0.0 ! I am in water
7930 C print *, "nic nie bylo w lipidzie?"
7931 C now multiply all by the peptide group transfer factor
7932 C eliptran=eliptran*pepliptran
7933 C now the same for side chains
7936 if (itype(i).eq.ntyp1) cycle
7937 positi=(mod(c(3,i+nres),boxzsize))
7938 if (positi.le.0) positi=positi+boxzsize
7939 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
7940 c for each residue check if it is in lipid or lipid water border area
7941 C respos=mod(c(3,i+nres),boxzsize)
7942 C print *,positi,bordlipbot,buflipbot
7943 if ((positi.gt.bordlipbot)
7944 & .and.(positi.lt.bordliptop)) then
7945 C the energy transfer exist
7946 if (positi.lt.buflipbot) then
7948 & ((positi-bordlipbot)/lipbufthick)
7949 C lipbufthick is thickenes of lipid buffore
7950 sslip=sscalelip(fracinbuf)
7951 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7952 eliptran=eliptran+sslip*liptranene(itype(i))
7953 gliptranx(3,i)=gliptranx(3,i)
7954 &+ssgradlip*liptranene(itype(i))
7955 gliptranc(3,i-1)= gliptranc(3,i-1)
7956 &+ssgradlip*liptranene(itype(i))
7957 C print *,"doing sccale for lower part"
7958 elseif (positi.gt.bufliptop) then
7960 &((bordliptop-positi)/lipbufthick)
7961 sslip=sscalelip(fracinbuf)
7962 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7963 eliptran=eliptran+sslip*liptranene(itype(i))
7964 gliptranx(3,i)=gliptranx(3,i)
7965 &+ssgradlip*liptranene(itype(i))
7966 gliptranc(3,i-1)= gliptranc(3,i-1)
7967 &+ssgradlip*liptranene(itype(i))
7968 C print *, "doing sscalefor top part",sslip,fracinbuf
7970 eliptran=eliptran+liptranene(itype(i))
7971 C print *,"I am in true lipid"
7973 endif ! if in lipid or buffor
7975 C eliptran=elpitran+0.0 ! I am in water
7981 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7983 SUBROUTINE MATVEC2(A1,V1,V2)
7984 implicit real*8 (a-h,o-z)
7985 include 'DIMENSIONS'
7986 DIMENSION A1(2,2),V1(2),V2(2)
7990 c 3 VI=VI+A1(I,K)*V1(K)
7994 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7995 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8000 C---------------------------------------
8001 SUBROUTINE MATMAT2(A1,A2,A3)
8002 implicit real*8 (a-h,o-z)
8003 include 'DIMENSIONS'
8004 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8005 c DIMENSION AI3(2,2)
8009 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8015 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8016 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8017 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8018 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8026 c-------------------------------------------------------------------------
8027 double precision function scalar2(u,v)
8029 double precision u(2),v(2)
8032 scalar2=u(1)*v(1)+u(2)*v(2)
8036 C-----------------------------------------------------------------------------
8038 subroutine transpose2(a,at)
8040 double precision a(2,2),at(2,2)
8047 c--------------------------------------------------------------------------
8048 subroutine transpose(n,a,at)
8051 double precision a(n,n),at(n,n)
8059 C---------------------------------------------------------------------------
8060 subroutine prodmat3(a1,a2,kk,transp,prod)
8063 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8065 crc double precision auxmat(2,2),prod_(2,2)
8068 crc call transpose2(kk(1,1),auxmat(1,1))
8069 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8070 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8072 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8073 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8074 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8075 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8076 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8077 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8078 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8079 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8082 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8083 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8085 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8086 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8087 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8088 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8089 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8090 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8091 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8092 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8095 c call transpose2(a2(1,1),a2t(1,1))
8098 crc print *,((prod_(i,j),i=1,2),j=1,2)
8099 crc print *,((prod(i,j),i=1,2),j=1,2)
8103 C-----------------------------------------------------------------------------
8104 double precision function scalar(u,v)
8106 double precision u(3),v(3)
8116 C-----------------------------------------------------------------------
8117 double precision function sscale(r)
8118 double precision r,gamm
8119 include "COMMON.SPLITELE"
8120 if(r.lt.r_cut-rlamb) then
8122 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8123 gamm=(r-(r_cut-rlamb))/rlamb
8124 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8130 C-----------------------------------------------------------------------
8131 C-----------------------------------------------------------------------
8132 double precision function sscagrad(r)
8133 double precision r,gamm
8134 include "COMMON.SPLITELE"
8135 if(r.lt.r_cut-rlamb) then
8137 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8138 gamm=(r-(r_cut-rlamb))/rlamb
8139 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8145 C-----------------------------------------------------------------------
8146 C-----------------------------------------------------------------------
8147 double precision function sscalelip(r)
8148 double precision r,gamm
8149 include "COMMON.SPLITELE"
8150 C if(r.lt.r_cut-rlamb) then
8152 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8153 C gamm=(r-(r_cut-rlamb))/rlamb
8154 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8160 C-----------------------------------------------------------------------
8161 double precision function sscagradlip(r)
8162 double precision r,gamm
8163 include "COMMON.SPLITELE"
8164 C if(r.lt.r_cut-rlamb) then
8166 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8167 C gamm=(r-(r_cut-rlamb))/rlamb
8168 sscagradlip=r*(6*r-6.0d0)
8175 C-----------------------------------------------------------------------