1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 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)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
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
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 c & +wsccor*fact(1)*gsccor_loc(i)
235 if (dyn_ss) call dyn_set_nss
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'sizesclu.dat'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'sizesclu.dat'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.SBRIDGE'
357 include 'COMMON.NAMES'
358 include 'COMMON.IOUNITS'
359 include 'COMMON.CONTACTS'
363 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
364 c ROZNICA DODANE Z WHAM
367 c eneps_temp(j,i)=0.0d0
376 if (itypi.eq.ntyp1) cycle
377 itypi1=iabs(itype(i+1))
384 C Calculate SC interaction energy.
387 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
388 cd & 'iend=',iend(i,iint)
389 do j=istart(i,iint),iend(i,iint)
391 if (itypj.eq.ntyp1) cycle
395 C Change 12/1/95 to calculate four-body interactions
396 rij=xj*xj+yj*yj+zj*zj
398 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
399 eps0ij=eps(itypi,itypj)
401 e1=fac*fac*aa(itypi,itypj)
402 e2=fac*bb(itypi,itypj)
404 ij=icant(itypi,itypj)
406 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
407 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
410 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
411 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
412 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
413 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
414 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
415 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
416 if (bb(itypi,itypj).gt.0.0d0) then
423 C Calculate the components of the gradient in DC and X
425 fac=-rrij*(e1+evdwij)
430 gvdwx(k,i)=gvdwx(k,i)-gg(k)
431 gvdwx(k,j)=gvdwx(k,j)+gg(k)
435 gvdwc(l,k)=gvdwc(l,k)+gg(l)
440 C 12/1/95, revised on 5/20/97
442 C Calculate the contact function. The ith column of the array JCONT will
443 C contain the numbers of atoms that make contacts with the atom I (of numbers
444 C greater than I). The arrays FACONT and GACONT will contain the values of
445 C the contact function and its derivative.
447 C Uncomment next line, if the correlation interactions include EVDW explicitly.
448 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
449 C Uncomment next line, if the correlation interactions are contact function only
450 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
452 sigij=sigma(itypi,itypj)
453 r0ij=rs0(itypi,itypj)
455 C Check whether the SC's are not too far to make a contact.
458 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
459 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
461 if (fcont.gt.0.0D0) then
462 C If the SC-SC distance if close to sigma, apply spline.
463 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
464 cAdam & fcont1,fprimcont1)
465 cAdam fcont1=1.0d0-fcont1
466 cAdam if (fcont1.gt.0.0d0) then
467 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
468 cAdam fcont=fcont*fcont1
470 C Uncomment following 4 lines to have the geometric average of the epsilon0's
471 cga eps0ij=1.0d0/dsqrt(eps0ij)
473 cga gg(k)=gg(k)*eps0ij
475 cga eps0ij=-evdwij*eps0ij
476 C Uncomment for AL's type of SC correlation interactions.
478 num_conti=num_conti+1
480 facont(num_conti,i)=fcont*eps0ij
481 fprimcont=eps0ij*fprimcont/rij
483 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
484 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
485 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
486 C Uncomment following 3 lines for Skolnick's type of SC correlation.
487 gacont(1,num_conti,i)=-fprimcont*xj
488 gacont(2,num_conti,i)=-fprimcont*yj
489 gacont(3,num_conti,i)=-fprimcont*zj
490 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
491 cd write (iout,'(2i3,3f10.5)')
492 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
498 num_cont(i)=num_conti
503 gvdwc(j,i)=expon*gvdwc(j,i)
504 gvdwx(j,i)=expon*gvdwx(j,i)
508 C******************************************************************************
512 C To save time, the factor of EXPON has been extracted from ALL components
513 C of GVDWC and GRADX. Remember to multiply them by this factor before further
516 C******************************************************************************
519 C-----------------------------------------------------------------------------
520 subroutine eljk(evdw,evdw_t)
522 C This subroutine calculates the interaction energy of nonbonded side chains
523 C assuming the LJK potential of interaction.
525 implicit real*8 (a-h,o-z)
527 include 'sizesclu.dat'
528 include "DIMENSIONS.COMPAR"
531 include 'COMMON.LOCAL'
532 include 'COMMON.CHAIN'
533 include 'COMMON.DERIV'
534 include 'COMMON.INTERACT'
535 include 'COMMON.IOUNITS'
536 include 'COMMON.NAMES'
541 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
546 if (itypi.eq.ntyp1) cycle
547 itypi1=iabs(itype(i+1))
552 C Calculate SC interaction energy.
555 do j=istart(i,iint),iend(i,iint)
557 if (itypj.eq.ntyp1) cycle
561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
563 e_augm=augm(itypi,itypj)*fac_augm
566 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
567 fac=r_shift_inv**expon
568 e1=fac*fac*aa(itypi,itypj)
569 e2=fac*bb(itypi,itypj)
571 ij=icant(itypi,itypj)
572 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
573 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
574 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
575 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
576 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
577 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
578 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
579 if (bb(itypi,itypj).gt.0.0d0) then
586 C Calculate the components of the gradient in DC and X
588 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
593 gvdwx(k,i)=gvdwx(k,i)-gg(k)
594 gvdwx(k,j)=gvdwx(k,j)+gg(k)
598 gvdwc(l,k)=gvdwc(l,k)+gg(l)
608 gvdwc(j,i)=expon*gvdwc(j,i)
609 gvdwx(j,i)=expon*gvdwx(j,i)
615 C-----------------------------------------------------------------------------
616 subroutine ebp(evdw,evdw_t)
618 C This subroutine calculates the interaction energy of nonbonded side chains
619 C assuming the Berne-Pechukas potential of interaction.
621 implicit real*8 (a-h,o-z)
623 include 'sizesclu.dat'
624 include "DIMENSIONS.COMPAR"
627 include 'COMMON.LOCAL'
628 include 'COMMON.CHAIN'
629 include 'COMMON.DERIV'
630 include 'COMMON.NAMES'
631 include 'COMMON.INTERACT'
632 include 'COMMON.IOUNITS'
633 include 'COMMON.CALC'
635 c double precision rrsave(maxdim)
641 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
642 c if (icall.eq.0) then
650 if (itypi.eq.ntyp1) cycle
651 itypi1=iabs(itype(i+1))
655 dxi=dc_norm(1,nres+i)
656 dyi=dc_norm(2,nres+i)
657 dzi=dc_norm(3,nres+i)
658 dsci_inv=vbld_inv(i+nres)
660 C Calculate SC interaction energy.
663 do j=istart(i,iint),iend(i,iint)
666 if (itypj.eq.ntyp1) cycle
667 dscj_inv=vbld_inv(j+nres)
668 chi1=chi(itypi,itypj)
669 chi2=chi(itypj,itypi)
676 alf12=0.5D0*(alf1+alf2)
677 C For diagnostics only!!!
690 dxj=dc_norm(1,nres+j)
691 dyj=dc_norm(2,nres+j)
692 dzj=dc_norm(3,nres+j)
693 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
694 cd if (icall.eq.0) then
700 C Calculate the angle-dependent terms of energy & contributions to derivatives.
702 C Calculate whole angle-dependent part of epsilon and contributions
704 fac=(rrij*sigsq)**expon2
705 e1=fac*fac*aa(itypi,itypj)
706 e2=fac*bb(itypi,itypj)
707 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
708 eps2der=evdwij*eps3rt
709 eps3der=evdwij*eps2rt
710 evdwij=evdwij*eps2rt*eps3rt
711 ij=icant(itypi,itypj)
712 aux=eps1*eps2rt**2*eps3rt**2
713 if (bb(itypi,itypj).gt.0.0d0) then
720 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
721 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
722 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
723 cd & restyp(itypi),i,restyp(itypj),j,
724 cd & epsi,sigm,chi1,chi2,chip1,chip2,
725 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
726 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
729 C Calculate gradient components.
730 e1=e1*eps1*eps2rt**2*eps3rt**2
731 fac=-expon*(e1+evdwij)
734 C Calculate radial part of the gradient
738 C Calculate the angular part of the gradient and sum add the contributions
739 C to the appropriate components of the Cartesian gradient.
748 C-----------------------------------------------------------------------------
749 subroutine egb(evdw,evdw_t)
751 C This subroutine calculates the interaction energy of nonbonded side chains
752 C assuming the Gay-Berne potential of interaction.
754 implicit real*8 (a-h,o-z)
756 include 'sizesclu.dat'
757 include "DIMENSIONS.COMPAR"
760 include 'COMMON.LOCAL'
761 include 'COMMON.CHAIN'
762 include 'COMMON.DERIV'
763 include 'COMMON.NAMES'
764 include 'COMMON.INTERACT'
765 include 'COMMON.IOUNITS'
766 include 'COMMON.CALC'
767 include 'COMMON.SBRIDGE'
772 logical energy_dec /.true./
773 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
777 c if (icall.gt.0) lprn=.true.
781 if (itypi.eq.ntyp1) cycle
782 itypi1=iabs(itype(i+1))
786 dxi=dc_norm(1,nres+i)
787 dyi=dc_norm(2,nres+i)
788 dzi=dc_norm(3,nres+i)
789 dsci_inv=vbld_inv(i+nres)
791 C Calculate SC interaction energy.
794 do j=istart(i,iint),iend(i,iint)
795 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
797 c write(iout,*) "PRZED ZWYKLE", evdwij
798 call dyn_ssbond_ene(i,j,evdwij)
799 c write(iout,*) "PO ZWYKLE", evdwij
802 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
803 & 'evdw',i,j,evdwij,' ss'
804 C triple bond artifac removal
805 do k=j+1,iend(i,iint)
806 C search over all next residues
807 if (dyn_ss_mask(k)) then
808 C check if they are cysteins
809 C write(iout,*) 'k=',k
811 c write(iout,*) "PRZED TRI", evdwij
812 evdwij_przed_tri=evdwij
813 call triple_ssbond_ene(i,j,k,evdwij)
814 c if(evdwij_przed_tri.ne.evdwij) then
815 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
818 c write(iout,*) "PO TRI", evdwij
819 C call the energy function that removes the artifical triple disulfide
820 C bond the soubroutine is located in ssMD.F
822 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
823 & 'evdw',i,j,evdwij,'tss'
829 if (itypj.eq.ntyp1) cycle
830 dscj_inv=vbld_inv(j+nres)
831 sig0ij=sigma(itypi,itypj)
832 chi1=chi(itypi,itypj)
833 chi2=chi(itypj,itypi)
840 alf12=0.5D0*(alf1+alf2)
841 C For diagnostics only!!!
854 dxj=dc_norm(1,nres+j)
855 dyj=dc_norm(2,nres+j)
856 dzj=dc_norm(3,nres+j)
857 c write (iout,*) i,j,xj,yj,zj
858 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
860 C Calculate angle-dependent terms of energy and contributions to their
864 sig=sig0ij*dsqrt(sigsq)
865 rij_shift=1.0D0/rij-sig+sig0ij
866 C I hate to put IF's in the loops, but here don't have another choice!!!!
867 if (rij_shift.le.0.0D0) then
872 c---------------------------------------------------------------
873 rij_shift=1.0D0/rij_shift
875 e1=fac*fac*aa(itypi,itypj)
876 e2=fac*bb(itypi,itypj)
877 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
878 eps2der=evdwij*eps3rt
879 eps3der=evdwij*eps2rt
880 evdwij=evdwij*eps2rt*eps3rt
881 if (bb(itypi,itypj).gt.0) then
886 ij=icant(itypi,itypj)
887 aux=eps1*eps2rt**2*eps3rt**2
888 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
889 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
890 c & aux*e2/eps(itypi,itypj)
892 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
893 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
894 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
895 c & restyp(itypi),i,restyp(itypj),j,
896 c & epsi,sigm,chi1,chi2,chip1,chip2,
897 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
898 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
900 c write (iout,*) "pratial sum", evdw,evdw_t
903 C Calculate gradient components.
904 e1=e1*eps1*eps2rt**2*eps3rt**2
905 fac=-expon*(e1+evdwij)*rij_shift
908 C Calculate the radial part of the gradient
912 C Calculate angular part of the gradient.
921 C-----------------------------------------------------------------------------
922 subroutine egbv(evdw,evdw_t)
924 C This subroutine calculates the interaction energy of nonbonded side chains
925 C assuming the Gay-Berne-Vorobjev potential of interaction.
927 implicit real*8 (a-h,o-z)
929 include 'sizesclu.dat'
930 include "DIMENSIONS.COMPAR"
933 include 'COMMON.LOCAL'
934 include 'COMMON.CHAIN'
935 include 'COMMON.DERIV'
936 include 'COMMON.NAMES'
937 include 'COMMON.INTERACT'
938 include 'COMMON.IOUNITS'
939 include 'COMMON.CALC'
946 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
949 c if (icall.gt.0) lprn=.true.
953 if (itypi.eq.ntyp1) cycle
954 itypi1=iabs(itype(i+1))
958 dxi=dc_norm(1,nres+i)
959 dyi=dc_norm(2,nres+i)
960 dzi=dc_norm(3,nres+i)
961 dsci_inv=vbld_inv(i+nres)
963 C Calculate SC interaction energy.
966 do j=istart(i,iint),iend(i,iint)
969 if (itypj.eq.ntyp1) cycle
970 dscj_inv=vbld_inv(j+nres)
971 sig0ij=sigma(itypi,itypj)
973 chi1=chi(itypi,itypj)
974 chi2=chi(itypj,itypi)
981 alf12=0.5D0*(alf1+alf2)
982 C For diagnostics only!!!
995 dxj=dc_norm(1,nres+j)
996 dyj=dc_norm(2,nres+j)
997 dzj=dc_norm(3,nres+j)
998 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1000 C Calculate angle-dependent terms of energy and contributions to their
1004 sig=sig0ij*dsqrt(sigsq)
1005 rij_shift=1.0D0/rij-sig+r0ij
1006 C I hate to put IF's in the loops, but here don't have another choice!!!!
1007 if (rij_shift.le.0.0D0) then
1012 c---------------------------------------------------------------
1013 rij_shift=1.0D0/rij_shift
1014 fac=rij_shift**expon
1015 e1=fac*fac*aa(itypi,itypj)
1016 e2=fac*bb(itypi,itypj)
1017 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1018 eps2der=evdwij*eps3rt
1019 eps3der=evdwij*eps2rt
1020 fac_augm=rrij**expon
1021 e_augm=augm(itypi,itypj)*fac_augm
1022 evdwij=evdwij*eps2rt*eps3rt
1023 if (bb(itypi,itypj).gt.0.0d0) then
1024 evdw=evdw+evdwij+e_augm
1026 evdw_t=evdw_t+evdwij+e_augm
1028 ij=icant(itypi,itypj)
1029 aux=eps1*eps2rt**2*eps3rt**2
1031 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1032 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1033 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1034 c & restyp(itypi),i,restyp(itypj),j,
1035 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1036 c & chi1,chi2,chip1,chip2,
1037 c & eps1,eps2rt**2,eps3rt**2,
1038 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1042 C Calculate gradient components.
1043 e1=e1*eps1*eps2rt**2*eps3rt**2
1044 fac=-expon*(e1+evdwij)*rij_shift
1046 fac=rij*fac-2*expon*rrij*e_augm
1047 C Calculate the radial part of the gradient
1051 C Calculate angular part of the gradient.
1059 C-----------------------------------------------------------------------------
1060 subroutine sc_angular
1061 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1062 C om12. Called by ebp, egb, and egbv.
1064 include 'COMMON.CALC'
1068 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1069 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1070 om12=dxi*dxj+dyi*dyj+dzi*dzj
1072 C Calculate eps1(om12) and its derivative in om12
1073 faceps1=1.0D0-om12*chiom12
1074 faceps1_inv=1.0D0/faceps1
1075 eps1=dsqrt(faceps1_inv)
1076 C Following variable is eps1*deps1/dom12
1077 eps1_om12=faceps1_inv*chiom12
1078 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1083 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1084 sigsq=1.0D0-facsig*faceps1_inv
1085 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1086 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1087 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1088 C Calculate eps2 and its derivatives in om1, om2, and om12.
1091 chipom12=chip12*om12
1092 facp=1.0D0-om12*chipom12
1094 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1095 C Following variable is the square root of eps2
1096 eps2rt=1.0D0-facp1*facp_inv
1097 C Following three variables are the derivatives of the square root of eps
1098 C in om1, om2, and om12.
1099 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1100 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1101 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1102 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1103 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1104 C Calculate whole angle-dependent part of epsilon and contributions
1105 C to its derivatives
1108 C----------------------------------------------------------------------------
1110 implicit real*8 (a-h,o-z)
1111 include 'DIMENSIONS'
1112 include 'sizesclu.dat'
1113 include 'COMMON.CHAIN'
1114 include 'COMMON.DERIV'
1115 include 'COMMON.CALC'
1116 double precision dcosom1(3),dcosom2(3)
1117 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1118 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1119 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1120 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1122 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1123 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1126 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1129 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1130 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1131 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1132 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1133 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1134 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1137 C Calculate the components of the gradient in DC and X
1141 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1146 c------------------------------------------------------------------------------
1147 subroutine vec_and_deriv
1148 implicit real*8 (a-h,o-z)
1149 include 'DIMENSIONS'
1150 include 'sizesclu.dat'
1151 include 'COMMON.IOUNITS'
1152 include 'COMMON.GEO'
1153 include 'COMMON.VAR'
1154 include 'COMMON.LOCAL'
1155 include 'COMMON.CHAIN'
1156 include 'COMMON.VECTORS'
1157 include 'COMMON.DERIV'
1158 include 'COMMON.INTERACT'
1159 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1160 C Compute the local reference systems. For reference system (i), the
1161 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1162 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1164 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1165 if (i.eq.nres-1) then
1166 C Case of the last full residue
1167 C Compute the Z-axis
1168 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1169 costh=dcos(pi-theta(nres))
1170 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1175 C Compute the derivatives of uz
1177 uzder(2,1,1)=-dc_norm(3,i-1)
1178 uzder(3,1,1)= dc_norm(2,i-1)
1179 uzder(1,2,1)= dc_norm(3,i-1)
1181 uzder(3,2,1)=-dc_norm(1,i-1)
1182 uzder(1,3,1)=-dc_norm(2,i-1)
1183 uzder(2,3,1)= dc_norm(1,i-1)
1186 uzder(2,1,2)= dc_norm(3,i)
1187 uzder(3,1,2)=-dc_norm(2,i)
1188 uzder(1,2,2)=-dc_norm(3,i)
1190 uzder(3,2,2)= dc_norm(1,i)
1191 uzder(1,3,2)= dc_norm(2,i)
1192 uzder(2,3,2)=-dc_norm(1,i)
1195 C Compute the Y-axis
1198 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1201 C Compute the derivatives of uy
1204 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1205 & -dc_norm(k,i)*dc_norm(j,i-1)
1206 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1208 uyder(j,j,1)=uyder(j,j,1)-costh
1209 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1214 uygrad(l,k,j,i)=uyder(l,k,j)
1215 uzgrad(l,k,j,i)=uzder(l,k,j)
1219 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1220 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1221 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1222 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1226 C Compute the Z-axis
1227 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1228 costh=dcos(pi-theta(i+2))
1229 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1234 C Compute the derivatives of uz
1236 uzder(2,1,1)=-dc_norm(3,i+1)
1237 uzder(3,1,1)= dc_norm(2,i+1)
1238 uzder(1,2,1)= dc_norm(3,i+1)
1240 uzder(3,2,1)=-dc_norm(1,i+1)
1241 uzder(1,3,1)=-dc_norm(2,i+1)
1242 uzder(2,3,1)= dc_norm(1,i+1)
1245 uzder(2,1,2)= dc_norm(3,i)
1246 uzder(3,1,2)=-dc_norm(2,i)
1247 uzder(1,2,2)=-dc_norm(3,i)
1249 uzder(3,2,2)= dc_norm(1,i)
1250 uzder(1,3,2)= dc_norm(2,i)
1251 uzder(2,3,2)=-dc_norm(1,i)
1254 C Compute the Y-axis
1257 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1260 C Compute the derivatives of uy
1263 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1264 & -dc_norm(k,i)*dc_norm(j,i+1)
1265 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1267 uyder(j,j,1)=uyder(j,j,1)-costh
1268 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1273 uygrad(l,k,j,i)=uyder(l,k,j)
1274 uzgrad(l,k,j,i)=uzder(l,k,j)
1278 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1279 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1280 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1281 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1287 vbld_inv_temp(1)=vbld_inv(i+1)
1288 if (i.lt.nres-1) then
1289 vbld_inv_temp(2)=vbld_inv(i+2)
1291 vbld_inv_temp(2)=vbld_inv(i)
1296 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1297 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1305 C-----------------------------------------------------------------------------
1306 subroutine vec_and_deriv_test
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1309 include 'sizesclu.dat'
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 dimension uyder(3,3,2),uzder(3,3,2)
1317 C Compute the local reference systems. For reference system (i), the
1318 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1319 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1321 if (i.eq.nres-1) then
1322 C Case of the last full residue
1323 C Compute the Z-axis
1324 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1325 costh=dcos(pi-theta(nres))
1326 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1327 c write (iout,*) 'fac',fac,
1328 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1329 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1333 C Compute the derivatives of uz
1335 uzder(2,1,1)=-dc_norm(3,i-1)
1336 uzder(3,1,1)= dc_norm(2,i-1)
1337 uzder(1,2,1)= dc_norm(3,i-1)
1339 uzder(3,2,1)=-dc_norm(1,i-1)
1340 uzder(1,3,1)=-dc_norm(2,i-1)
1341 uzder(2,3,1)= dc_norm(1,i-1)
1344 uzder(2,1,2)= dc_norm(3,i)
1345 uzder(3,1,2)=-dc_norm(2,i)
1346 uzder(1,2,2)=-dc_norm(3,i)
1348 uzder(3,2,2)= dc_norm(1,i)
1349 uzder(1,3,2)= dc_norm(2,i)
1350 uzder(2,3,2)=-dc_norm(1,i)
1352 C Compute the Y-axis
1354 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1357 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1358 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1359 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1361 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1364 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1365 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1368 c write (iout,*) 'facy',facy,
1369 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1370 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1372 uy(k,i)=facy*uy(k,i)
1374 C Compute the derivatives of uy
1377 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1378 & -dc_norm(k,i)*dc_norm(j,i-1)
1379 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1381 c uyder(j,j,1)=uyder(j,j,1)-costh
1382 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1383 uyder(j,j,1)=uyder(j,j,1)
1384 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1385 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1391 uygrad(l,k,j,i)=uyder(l,k,j)
1392 uzgrad(l,k,j,i)=uzder(l,k,j)
1396 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1397 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1398 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1399 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1402 C Compute the Z-axis
1403 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1404 costh=dcos(pi-theta(i+2))
1405 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1406 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1410 C Compute the derivatives of uz
1412 uzder(2,1,1)=-dc_norm(3,i+1)
1413 uzder(3,1,1)= dc_norm(2,i+1)
1414 uzder(1,2,1)= dc_norm(3,i+1)
1416 uzder(3,2,1)=-dc_norm(1,i+1)
1417 uzder(1,3,1)=-dc_norm(2,i+1)
1418 uzder(2,3,1)= dc_norm(1,i+1)
1421 uzder(2,1,2)= dc_norm(3,i)
1422 uzder(3,1,2)=-dc_norm(2,i)
1423 uzder(1,2,2)=-dc_norm(3,i)
1425 uzder(3,2,2)= dc_norm(1,i)
1426 uzder(1,3,2)= dc_norm(2,i)
1427 uzder(2,3,2)=-dc_norm(1,i)
1429 C Compute the Y-axis
1431 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1432 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1433 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1435 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1438 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1439 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1442 c write (iout,*) 'facy',facy,
1443 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1444 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1446 uy(k,i)=facy*uy(k,i)
1448 C Compute the derivatives of uy
1451 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1452 & -dc_norm(k,i)*dc_norm(j,i+1)
1453 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1455 c uyder(j,j,1)=uyder(j,j,1)-costh
1456 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1457 uyder(j,j,1)=uyder(j,j,1)
1458 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1459 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1465 uygrad(l,k,j,i)=uyder(l,k,j)
1466 uzgrad(l,k,j,i)=uzder(l,k,j)
1470 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1471 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1472 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1473 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1480 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1481 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1488 C-----------------------------------------------------------------------------
1489 subroutine check_vecgrad
1490 implicit real*8 (a-h,o-z)
1491 include 'DIMENSIONS'
1492 include 'sizesclu.dat'
1493 include 'COMMON.IOUNITS'
1494 include 'COMMON.GEO'
1495 include 'COMMON.VAR'
1496 include 'COMMON.LOCAL'
1497 include 'COMMON.CHAIN'
1498 include 'COMMON.VECTORS'
1499 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1500 dimension uyt(3,maxres),uzt(3,maxres)
1501 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1502 double precision delta /1.0d-7/
1505 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1506 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1507 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1508 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1509 cd & (dc_norm(if90,i),if90=1,3)
1510 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1511 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1512 cd write(iout,'(a)')
1518 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1519 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1532 cd write (iout,*) 'i=',i
1534 erij(k)=dc_norm(k,i)
1538 dc_norm(k,i)=erij(k)
1540 dc_norm(j,i)=dc_norm(j,i)+delta
1541 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1543 c dc_norm(k,i)=dc_norm(k,i)/fac
1545 c write (iout,*) (dc_norm(k,i),k=1,3)
1546 c write (iout,*) (erij(k),k=1,3)
1549 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1550 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1551 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1552 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1554 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1555 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1556 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1559 dc_norm(k,i)=erij(k)
1562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1563 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1564 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1565 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1566 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1567 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1568 cd write (iout,'(a)')
1573 C--------------------------------------------------------------------------
1574 subroutine set_matrices
1575 implicit real*8 (a-h,o-z)
1576 include 'DIMENSIONS'
1577 include 'sizesclu.dat'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.GEO'
1580 include 'COMMON.VAR'
1581 include 'COMMON.LOCAL'
1582 include 'COMMON.CHAIN'
1583 include 'COMMON.DERIV'
1584 include 'COMMON.INTERACT'
1585 include 'COMMON.CONTACTS'
1586 include 'COMMON.TORSION'
1587 include 'COMMON.VECTORS'
1588 include 'COMMON.FFIELD'
1589 double precision auxvec(2),auxmat(2,2)
1591 C Compute the virtual-bond-torsional-angle dependent quantities needed
1592 C to calculate the el-loc multibody terms of various order.
1595 if (i .lt. nres+1) then
1632 if (i .gt. 3 .and. i .lt. nres+1) then
1633 obrot_der(1,i-2)=-sin1
1634 obrot_der(2,i-2)= cos1
1635 Ugder(1,1,i-2)= sin1
1636 Ugder(1,2,i-2)=-cos1
1637 Ugder(2,1,i-2)=-cos1
1638 Ugder(2,2,i-2)=-sin1
1641 obrot2_der(1,i-2)=-dwasin2
1642 obrot2_der(2,i-2)= dwacos2
1643 Ug2der(1,1,i-2)= dwasin2
1644 Ug2der(1,2,i-2)=-dwacos2
1645 Ug2der(2,1,i-2)=-dwacos2
1646 Ug2der(2,2,i-2)=-dwasin2
1648 obrot_der(1,i-2)=0.0d0
1649 obrot_der(2,i-2)=0.0d0
1650 Ugder(1,1,i-2)=0.0d0
1651 Ugder(1,2,i-2)=0.0d0
1652 Ugder(2,1,i-2)=0.0d0
1653 Ugder(2,2,i-2)=0.0d0
1654 obrot2_der(1,i-2)=0.0d0
1655 obrot2_der(2,i-2)=0.0d0
1656 Ug2der(1,1,i-2)=0.0d0
1657 Ug2der(1,2,i-2)=0.0d0
1658 Ug2der(2,1,i-2)=0.0d0
1659 Ug2der(2,2,i-2)=0.0d0
1661 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1662 if (itype(i-2).le.ntyp) then
1663 iti = itortyp(itype(i-2))
1670 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1671 if (itype(i-1).le.ntyp) then
1672 iti1 = itortyp(itype(i-1))
1679 cd write (iout,*) '*******i',i,' iti1',iti
1680 cd write (iout,*) 'b1',b1(:,iti)
1681 cd write (iout,*) 'b2',b2(:,iti)
1682 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1683 c print *,"itilde1 i iti iti1",i,iti,iti1
1684 if (i .gt. iatel_s+2) then
1685 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1686 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1687 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1688 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1689 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1690 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1691 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1701 DtUg2(l,k,i-2)=0.0d0
1705 c print *,"itilde2 i iti iti1",i,iti,iti1
1706 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1707 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1708 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1709 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1710 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1711 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1712 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1713 c print *,"itilde3 i iti iti1",i,iti,iti1
1715 muder(k,i-2)=Ub2der(k,i-2)
1717 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1718 if (itype(i-1).le.ntyp) then
1719 iti1 = itortyp(itype(i-1))
1727 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1729 C Vectors and matrices dependent on a single virtual-bond dihedral.
1730 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1731 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1732 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1733 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1734 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1735 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1736 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1737 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1738 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1739 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1740 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1742 C Matrices dependent on two consecutive virtual-bond dihedrals.
1743 C The order of matrices is from left to right.
1745 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1746 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1747 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1748 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1749 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1750 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1751 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1752 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1755 cd iti = itortyp(itype(i))
1758 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1759 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1764 C--------------------------------------------------------------------------
1765 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1767 C This subroutine calculates the average interaction energy and its gradient
1768 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1769 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1770 C The potential depends both on the distance of peptide-group centers and on
1771 C the orientation of the CA-CA virtual bonds.
1773 implicit real*8 (a-h,o-z)
1774 include 'DIMENSIONS'
1775 include 'sizesclu.dat'
1776 include 'COMMON.CONTROL'
1777 include 'COMMON.IOUNITS'
1778 include 'COMMON.GEO'
1779 include 'COMMON.VAR'
1780 include 'COMMON.LOCAL'
1781 include 'COMMON.CHAIN'
1782 include 'COMMON.DERIV'
1783 include 'COMMON.INTERACT'
1784 include 'COMMON.CONTACTS'
1785 include 'COMMON.TORSION'
1786 include 'COMMON.VECTORS'
1787 include 'COMMON.FFIELD'
1788 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1789 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1790 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1791 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1792 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1793 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1794 double precision scal_el /0.5d0/
1796 C 13-go grudnia roku pamietnego...
1797 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1798 & 0.0d0,1.0d0,0.0d0,
1799 & 0.0d0,0.0d0,1.0d0/
1800 cd write(iout,*) 'In EELEC'
1802 cd write(iout,*) 'Type',i
1803 cd write(iout,*) 'B1',B1(:,i)
1804 cd write(iout,*) 'B2',B2(:,i)
1805 cd write(iout,*) 'CC',CC(:,:,i)
1806 cd write(iout,*) 'DD',DD(:,:,i)
1807 cd write(iout,*) 'EE',EE(:,:,i)
1809 cd call check_vecgrad
1811 if (icheckgrad.eq.1) then
1813 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1815 dc_norm(k,i)=dc(k,i)*fac
1817 c write (iout,*) 'i',i,' fac',fac
1820 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1821 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1822 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1823 cd if (wel_loc.gt.0.0d0) then
1824 if (icheckgrad.eq.1) then
1825 call vec_and_deriv_test
1832 cd write (iout,*) 'i=',i
1834 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1837 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1838 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1851 cd print '(a)','Enter EELEC'
1852 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1854 gel_loc_loc(i)=0.0d0
1857 do i=iatel_s,iatel_e
1858 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1859 if (itel(i).eq.0) goto 1215
1863 dx_normi=dc_norm(1,i)
1864 dy_normi=dc_norm(2,i)
1865 dz_normi=dc_norm(3,i)
1866 xmedi=c(1,i)+0.5d0*dxi
1867 ymedi=c(2,i)+0.5d0*dyi
1868 zmedi=c(3,i)+0.5d0*dzi
1870 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1871 do j=ielstart(i),ielend(i)
1872 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1873 if (itel(j).eq.0) goto 1216
1877 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1878 aaa=app(iteli,itelj)
1879 bbb=bpp(iteli,itelj)
1880 C Diagnostics only!!!
1886 ael6i=ael6(iteli,itelj)
1887 ael3i=ael3(iteli,itelj)
1891 dx_normj=dc_norm(1,j)
1892 dy_normj=dc_norm(2,j)
1893 dz_normj=dc_norm(3,j)
1894 xj=c(1,j)+0.5D0*dxj-xmedi
1895 yj=c(2,j)+0.5D0*dyj-ymedi
1896 zj=c(3,j)+0.5D0*dzj-zmedi
1897 rij=xj*xj+yj*yj+zj*zj
1903 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1904 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1905 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1906 fac=cosa-3.0D0*cosb*cosg
1908 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1909 if (j.eq.i+2) ev1=scal_el*ev1
1914 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1917 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1918 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1919 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1922 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1923 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1924 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1925 cd & xmedi,ymedi,zmedi,xj,yj,zj
1927 C Calculate contributions to the Cartesian gradient.
1930 facvdw=-6*rrmij*(ev1+evdwij)
1931 facel=-3*rrmij*(el1+eesij)
1938 * Radial derivatives. First process both termini of the fragment (i,j)
1945 gelc(k,i)=gelc(k,i)+ghalf
1946 gelc(k,j)=gelc(k,j)+ghalf
1949 * Loop over residues i+1 thru j-1.
1953 gelc(l,k)=gelc(l,k)+ggg(l)
1961 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1962 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1965 * Loop over residues i+1 thru j-1.
1969 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1976 fac=-3*rrmij*(facvdw+facvdw+facel)
1982 * Radial derivatives. First process both termini of the fragment (i,j)
1989 gelc(k,i)=gelc(k,i)+ghalf
1990 gelc(k,j)=gelc(k,j)+ghalf
1993 * Loop over residues i+1 thru j-1.
1997 gelc(l,k)=gelc(l,k)+ggg(l)
2004 ecosa=2.0D0*fac3*fac1+fac4
2007 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2008 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2010 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2011 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2013 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2014 cd & (dcosg(k),k=1,3)
2016 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2020 gelc(k,i)=gelc(k,i)+ghalf
2021 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2022 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2023 gelc(k,j)=gelc(k,j)+ghalf
2024 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2025 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2029 gelc(l,k)=gelc(l,k)+ggg(l)
2034 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2035 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2036 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2038 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2039 C energy of a peptide unit is assumed in the form of a second-order
2040 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2041 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2042 C are computed for EVERY pair of non-contiguous peptide groups.
2044 if (j.lt.nres-1) then
2055 muij(kkk)=mu(k,i)*mu(l,j)
2058 cd write (iout,*) 'EELEC: i',i,' j',j
2059 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2060 cd write(iout,*) 'muij',muij
2061 ury=scalar(uy(1,i),erij)
2062 urz=scalar(uz(1,i),erij)
2063 vry=scalar(uy(1,j),erij)
2064 vrz=scalar(uz(1,j),erij)
2065 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2066 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2067 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2068 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2069 C For diagnostics only
2074 fac=dsqrt(-ael6i)*r3ij
2075 cd write (2,*) 'fac=',fac
2076 C For diagnostics only
2082 cd write (iout,'(4i5,4f10.5)')
2083 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2084 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2085 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2086 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2087 cd write (iout,'(4f10.5)')
2088 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2089 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2090 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2091 cd write (iout,'(2i3,9f10.5/)') i,j,
2092 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2094 C Derivatives of the elements of A in virtual-bond vectors
2095 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2102 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2103 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2104 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2105 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2106 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2107 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2108 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2109 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2110 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2111 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2112 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2113 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2123 C Compute radial contributions to the gradient
2145 C Add the contributions coming from er
2148 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2149 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2150 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2151 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2154 C Derivatives in DC(i)
2155 ghalf1=0.5d0*agg(k,1)
2156 ghalf2=0.5d0*agg(k,2)
2157 ghalf3=0.5d0*agg(k,3)
2158 ghalf4=0.5d0*agg(k,4)
2159 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2160 & -3.0d0*uryg(k,2)*vry)+ghalf1
2161 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2162 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2163 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2164 & -3.0d0*urzg(k,2)*vry)+ghalf3
2165 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2166 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2167 C Derivatives in DC(i+1)
2168 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2169 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2170 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2171 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2172 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2173 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2174 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2175 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2176 C Derivatives in DC(j)
2177 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2178 & -3.0d0*vryg(k,2)*ury)+ghalf1
2179 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2180 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2181 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2182 & -3.0d0*vryg(k,2)*urz)+ghalf3
2183 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2184 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2185 C Derivatives in DC(j+1) or DC(nres-1)
2186 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2187 & -3.0d0*vryg(k,3)*ury)
2188 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2189 & -3.0d0*vrzg(k,3)*ury)
2190 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2191 & -3.0d0*vryg(k,3)*urz)
2192 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2193 & -3.0d0*vrzg(k,3)*urz)
2198 C Derivatives in DC(i+1)
2199 cd aggi1(k,1)=agg(k,1)
2200 cd aggi1(k,2)=agg(k,2)
2201 cd aggi1(k,3)=agg(k,3)
2202 cd aggi1(k,4)=agg(k,4)
2203 C Derivatives in DC(j)
2208 C Derivatives in DC(j+1)
2213 if (j.eq.nres-1 .and. i.lt.j-2) then
2215 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2216 cd aggj1(k,l)=agg(k,l)
2222 C Check the loc-el terms by numerical integration
2232 aggi(k,l)=-aggi(k,l)
2233 aggi1(k,l)=-aggi1(k,l)
2234 aggj(k,l)=-aggj(k,l)
2235 aggj1(k,l)=-aggj1(k,l)
2238 if (j.lt.nres-1) then
2244 aggi(k,l)=-aggi(k,l)
2245 aggi1(k,l)=-aggi1(k,l)
2246 aggj(k,l)=-aggj(k,l)
2247 aggj1(k,l)=-aggj1(k,l)
2258 aggi(k,l)=-aggi(k,l)
2259 aggi1(k,l)=-aggi1(k,l)
2260 aggj(k,l)=-aggj(k,l)
2261 aggj1(k,l)=-aggj1(k,l)
2267 IF (wel_loc.gt.0.0d0) THEN
2268 C Contribution to the local-electrostatic energy coming from the i-j pair
2269 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2271 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2272 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2273 eel_loc=eel_loc+eel_loc_ij
2274 C Partial derivatives in virtual-bond dihedral angles gamma
2277 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2278 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2279 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2280 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2281 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2282 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2283 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2284 cd write(iout,*) 'agg ',agg
2285 cd write(iout,*) 'aggi ',aggi
2286 cd write(iout,*) 'aggi1',aggi1
2287 cd write(iout,*) 'aggj ',aggj
2288 cd write(iout,*) 'aggj1',aggj1
2290 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2292 ggg(l)=agg(l,1)*muij(1)+
2293 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2297 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2300 C Remaining derivatives of eello
2302 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2303 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2304 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2305 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2306 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2307 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2308 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2309 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2313 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2314 C Contributions from turns
2319 call eturn34(i,j,eello_turn3,eello_turn4)
2321 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2322 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2324 C Calculate the contact function. The ith column of the array JCONT will
2325 C contain the numbers of atoms that make contacts with the atom I (of numbers
2326 C greater than I). The arrays FACONT and GACONT will contain the values of
2327 C the contact function and its derivative.
2328 c r0ij=1.02D0*rpp(iteli,itelj)
2329 c r0ij=1.11D0*rpp(iteli,itelj)
2330 r0ij=2.20D0*rpp(iteli,itelj)
2331 c r0ij=1.55D0*rpp(iteli,itelj)
2332 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2333 if (fcont.gt.0.0D0) then
2334 num_conti=num_conti+1
2335 if (num_conti.gt.maxconts) then
2336 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2337 & ' will skip next contacts for this conf.'
2339 jcont_hb(num_conti,i)=j
2340 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2341 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2342 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2344 d_cont(num_conti,i)=rij
2345 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2346 C --- Electrostatic-interaction matrix ---
2347 a_chuj(1,1,num_conti,i)=a22
2348 a_chuj(1,2,num_conti,i)=a23
2349 a_chuj(2,1,num_conti,i)=a32
2350 a_chuj(2,2,num_conti,i)=a33
2351 C --- Gradient of rij
2353 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2356 c a_chuj(1,1,num_conti,i)=-0.61d0
2357 c a_chuj(1,2,num_conti,i)= 0.4d0
2358 c a_chuj(2,1,num_conti,i)= 0.65d0
2359 c a_chuj(2,2,num_conti,i)= 0.50d0
2360 c else if (i.eq.2) then
2361 c a_chuj(1,1,num_conti,i)= 0.0d0
2362 c a_chuj(1,2,num_conti,i)= 0.0d0
2363 c a_chuj(2,1,num_conti,i)= 0.0d0
2364 c a_chuj(2,2,num_conti,i)= 0.0d0
2366 C --- and its gradients
2367 cd write (iout,*) 'i',i,' j',j
2369 cd write (iout,*) 'iii 1 kkk',kkk
2370 cd write (iout,*) agg(kkk,:)
2373 cd write (iout,*) 'iii 2 kkk',kkk
2374 cd write (iout,*) aggi(kkk,:)
2377 cd write (iout,*) 'iii 3 kkk',kkk
2378 cd write (iout,*) aggi1(kkk,:)
2381 cd write (iout,*) 'iii 4 kkk',kkk
2382 cd write (iout,*) aggj(kkk,:)
2385 cd write (iout,*) 'iii 5 kkk',kkk
2386 cd write (iout,*) aggj1(kkk,:)
2393 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2394 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2395 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2396 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2397 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2399 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2405 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2406 C Calculate contact energies
2408 wij=cosa-3.0D0*cosb*cosg
2411 c fac3=dsqrt(-ael6i)/r0ij**3
2412 fac3=dsqrt(-ael6i)*r3ij
2413 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2414 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2416 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2417 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2418 C Diagnostics. Comment out or remove after debugging!
2419 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2420 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2421 c ees0m(num_conti,i)=0.0D0
2423 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2424 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2425 facont_hb(num_conti,i)=fcont
2427 C Angular derivatives of the contact function
2428 ees0pij1=fac3/ees0pij
2429 ees0mij1=fac3/ees0mij
2430 fac3p=-3.0D0*fac3*rrmij
2431 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2432 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2434 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2435 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2436 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2437 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2438 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2439 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2440 ecosap=ecosa1+ecosa2
2441 ecosbp=ecosb1+ecosb2
2442 ecosgp=ecosg1+ecosg2
2443 ecosam=ecosa1-ecosa2
2444 ecosbm=ecosb1-ecosb2
2445 ecosgm=ecosg1-ecosg2
2454 fprimcont=fprimcont/rij
2455 cd facont_hb(num_conti,i)=1.0D0
2456 C Following line is for diagnostics.
2459 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2460 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2463 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2464 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2466 gggp(1)=gggp(1)+ees0pijp*xj
2467 gggp(2)=gggp(2)+ees0pijp*yj
2468 gggp(3)=gggp(3)+ees0pijp*zj
2469 gggm(1)=gggm(1)+ees0mijp*xj
2470 gggm(2)=gggm(2)+ees0mijp*yj
2471 gggm(3)=gggm(3)+ees0mijp*zj
2472 C Derivatives due to the contact function
2473 gacont_hbr(1,num_conti,i)=fprimcont*xj
2474 gacont_hbr(2,num_conti,i)=fprimcont*yj
2475 gacont_hbr(3,num_conti,i)=fprimcont*zj
2477 ghalfp=0.5D0*gggp(k)
2478 ghalfm=0.5D0*gggm(k)
2479 gacontp_hb1(k,num_conti,i)=ghalfp
2480 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2481 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2482 gacontp_hb2(k,num_conti,i)=ghalfp
2483 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2484 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2485 gacontp_hb3(k,num_conti,i)=gggp(k)
2486 gacontm_hb1(k,num_conti,i)=ghalfm
2487 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2488 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2489 gacontm_hb2(k,num_conti,i)=ghalfm
2490 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2491 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2492 gacontm_hb3(k,num_conti,i)=gggm(k)
2495 C Diagnostics. Comment out or remove after debugging!
2497 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2498 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2499 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2500 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2501 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2502 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2505 endif ! num_conti.le.maxconts
2510 num_cont_hb(i)=num_conti
2514 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2515 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2517 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2518 ccc eel_loc=eel_loc+eello_turn3
2521 C-----------------------------------------------------------------------------
2522 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2523 C Third- and fourth-order contributions from turns
2524 implicit real*8 (a-h,o-z)
2525 include 'DIMENSIONS'
2526 include 'sizesclu.dat'
2527 include 'COMMON.IOUNITS'
2528 include 'COMMON.GEO'
2529 include 'COMMON.VAR'
2530 include 'COMMON.LOCAL'
2531 include 'COMMON.CHAIN'
2532 include 'COMMON.DERIV'
2533 include 'COMMON.INTERACT'
2534 include 'COMMON.CONTACTS'
2535 include 'COMMON.TORSION'
2536 include 'COMMON.VECTORS'
2537 include 'COMMON.FFIELD'
2539 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2540 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2541 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2542 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2543 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2544 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2548 C Third-order contributions
2555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2556 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2557 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2558 call transpose2(auxmat(1,1),auxmat1(1,1))
2559 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2560 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2561 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2562 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2563 cd & ' eello_turn3_num',4*eello_turn3_num
2565 C Derivatives in gamma(i)
2566 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2567 call transpose2(auxmat2(1,1),pizda(1,1))
2568 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2569 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2570 C Derivatives in gamma(i+1)
2571 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2572 call transpose2(auxmat2(1,1),pizda(1,1))
2573 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2574 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2575 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 C Cartesian derivatives
2578 a_temp(1,1)=aggi(l,1)
2579 a_temp(1,2)=aggi(l,2)
2580 a_temp(2,1)=aggi(l,3)
2581 a_temp(2,2)=aggi(l,4)
2582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2583 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2584 & +0.5d0*(pizda(1,1)+pizda(2,2))
2585 a_temp(1,1)=aggi1(l,1)
2586 a_temp(1,2)=aggi1(l,2)
2587 a_temp(2,1)=aggi1(l,3)
2588 a_temp(2,2)=aggi1(l,4)
2589 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2590 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2591 & +0.5d0*(pizda(1,1)+pizda(2,2))
2592 a_temp(1,1)=aggj(l,1)
2593 a_temp(1,2)=aggj(l,2)
2594 a_temp(2,1)=aggj(l,3)
2595 a_temp(2,2)=aggj(l,4)
2596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2597 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2598 & +0.5d0*(pizda(1,1)+pizda(2,2))
2599 a_temp(1,1)=aggj1(l,1)
2600 a_temp(1,2)=aggj1(l,2)
2601 a_temp(2,1)=aggj1(l,3)
2602 a_temp(2,2)=aggj1(l,4)
2603 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2604 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2605 & +0.5d0*(pizda(1,1)+pizda(2,2))
2608 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2611 C Fourth-order contributions
2619 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2620 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2621 iti1=itortyp(itype(i+1))
2622 iti2=itortyp(itype(i+2))
2623 iti3=itortyp(itype(i+3))
2624 call transpose2(EUg(1,1,i+1),e1t(1,1))
2625 call transpose2(Eug(1,1,i+2),e2t(1,1))
2626 call transpose2(Eug(1,1,i+3),e3t(1,1))
2627 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2628 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2629 s1=scalar2(b1(1,iti2),auxvec(1))
2630 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2631 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2632 s2=scalar2(b1(1,iti1),auxvec(1))
2633 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2634 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2635 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2636 eello_turn4=eello_turn4-(s1+s2+s3)
2637 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2638 cd & ' eello_turn4_num',8*eello_turn4_num
2639 C Derivatives in gamma(i)
2641 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2642 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2643 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2644 s1=scalar2(b1(1,iti2),auxvec(1))
2645 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2646 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2647 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2648 C Derivatives in gamma(i+1)
2649 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2650 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2651 s2=scalar2(b1(1,iti1),auxvec(1))
2652 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2653 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2654 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2655 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2656 C Derivatives in gamma(i+2)
2657 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2658 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2659 s1=scalar2(b1(1,iti2),auxvec(1))
2660 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2661 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2662 s2=scalar2(b1(1,iti1),auxvec(1))
2663 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2664 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2665 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2666 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2667 C Cartesian derivatives
2668 C Derivatives of this turn contributions in DC(i+2)
2669 if (j.lt.nres-1) then
2671 a_temp(1,1)=agg(l,1)
2672 a_temp(1,2)=agg(l,2)
2673 a_temp(2,1)=agg(l,3)
2674 a_temp(2,2)=agg(l,4)
2675 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2676 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2677 s1=scalar2(b1(1,iti2),auxvec(1))
2678 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2679 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2680 s2=scalar2(b1(1,iti1),auxvec(1))
2681 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2682 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2683 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2685 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2688 C Remaining derivatives of this turn contribution
2690 a_temp(1,1)=aggi(l,1)
2691 a_temp(1,2)=aggi(l,2)
2692 a_temp(2,1)=aggi(l,3)
2693 a_temp(2,2)=aggi(l,4)
2694 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2695 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2696 s1=scalar2(b1(1,iti2),auxvec(1))
2697 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2698 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2699 s2=scalar2(b1(1,iti1),auxvec(1))
2700 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2701 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2702 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2703 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2704 a_temp(1,1)=aggi1(l,1)
2705 a_temp(1,2)=aggi1(l,2)
2706 a_temp(2,1)=aggi1(l,3)
2707 a_temp(2,2)=aggi1(l,4)
2708 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2709 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2710 s1=scalar2(b1(1,iti2),auxvec(1))
2711 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2712 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2713 s2=scalar2(b1(1,iti1),auxvec(1))
2714 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2715 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2716 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2717 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2718 a_temp(1,1)=aggj(l,1)
2719 a_temp(1,2)=aggj(l,2)
2720 a_temp(2,1)=aggj(l,3)
2721 a_temp(2,2)=aggj(l,4)
2722 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2723 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2724 s1=scalar2(b1(1,iti2),auxvec(1))
2725 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2726 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2727 s2=scalar2(b1(1,iti1),auxvec(1))
2728 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2729 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2730 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2731 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2732 a_temp(1,1)=aggj1(l,1)
2733 a_temp(1,2)=aggj1(l,2)
2734 a_temp(2,1)=aggj1(l,3)
2735 a_temp(2,2)=aggj1(l,4)
2736 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2737 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2738 s1=scalar2(b1(1,iti2),auxvec(1))
2739 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2740 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2741 s2=scalar2(b1(1,iti1),auxvec(1))
2742 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2743 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2744 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2745 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2751 C-----------------------------------------------------------------------------
2752 subroutine vecpr(u,v,w)
2753 implicit real*8(a-h,o-z)
2754 dimension u(3),v(3),w(3)
2755 w(1)=u(2)*v(3)-u(3)*v(2)
2756 w(2)=-u(1)*v(3)+u(3)*v(1)
2757 w(3)=u(1)*v(2)-u(2)*v(1)
2760 C-----------------------------------------------------------------------------
2761 subroutine unormderiv(u,ugrad,unorm,ungrad)
2762 C This subroutine computes the derivatives of a normalized vector u, given
2763 C the derivatives computed without normalization conditions, ugrad. Returns
2766 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2767 double precision vec(3)
2768 double precision scalar
2770 c write (2,*) 'ugrad',ugrad
2773 vec(i)=scalar(ugrad(1,i),u(1))
2775 c write (2,*) 'vec',vec
2778 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2781 c write (2,*) 'ungrad',ungrad
2784 C-----------------------------------------------------------------------------
2785 subroutine escp(evdw2,evdw2_14)
2787 C This subroutine calculates the excluded-volume interaction energy between
2788 C peptide-group centers and side chains and its gradient in virtual-bond and
2789 C side-chain vectors.
2791 implicit real*8 (a-h,o-z)
2792 include 'DIMENSIONS'
2793 include 'sizesclu.dat'
2794 include 'COMMON.GEO'
2795 include 'COMMON.VAR'
2796 include 'COMMON.LOCAL'
2797 include 'COMMON.CHAIN'
2798 include 'COMMON.DERIV'
2799 include 'COMMON.INTERACT'
2800 include 'COMMON.FFIELD'
2801 include 'COMMON.IOUNITS'
2805 cd print '(a)','Enter ESCP'
2806 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2807 c & ' scal14',scal14
2808 do i=iatscp_s,iatscp_e
2809 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2811 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2812 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2813 if (iteli.eq.0) goto 1225
2814 xi=0.5D0*(c(1,i)+c(1,i+1))
2815 yi=0.5D0*(c(2,i)+c(2,i+1))
2816 zi=0.5D0*(c(3,i)+c(3,i+1))
2818 do iint=1,nscp_gr(i)
2820 do j=iscpstart(i,iint),iscpend(i,iint)
2821 itypj=iabs(itype(j))
2822 if (itypj.eq.ntyp1) cycle
2823 C Uncomment following three lines for SC-p interactions
2827 C Uncomment following three lines for Ca-p interactions
2831 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2833 e1=fac*fac*aad(itypj,iteli)
2834 e2=fac*bad(itypj,iteli)
2835 if (iabs(j-i) .le. 2) then
2838 evdw2_14=evdw2_14+e1+e2
2841 c write (iout,*) i,j,evdwij
2845 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2847 fac=-(evdwij+e1)*rrij
2852 cd write (iout,*) 'j<i'
2853 C Uncomment following three lines for SC-p interactions
2855 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2858 cd write (iout,*) 'j>i'
2861 C Uncomment following line for SC-p interactions
2862 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2866 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2870 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2871 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2874 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2884 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2885 gradx_scp(j,i)=expon*gradx_scp(j,i)
2888 C******************************************************************************
2892 C To save time the factor EXPON has been extracted from ALL components
2893 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2896 C******************************************************************************
2899 C--------------------------------------------------------------------------
2900 subroutine edis(ehpb)
2902 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2904 implicit real*8 (a-h,o-z)
2905 include 'DIMENSIONS'
2906 include 'sizesclu.dat'
2907 include 'COMMON.SBRIDGE'
2908 include 'COMMON.CHAIN'
2909 include 'COMMON.DERIV'
2910 include 'COMMON.VAR'
2911 include 'COMMON.INTERACT'
2914 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2915 cd print *,'link_start=',link_start,' link_end=',link_end
2916 if (link_end.eq.0) return
2917 do i=link_start,link_end
2918 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2919 C CA-CA distance used in regularization of structure.
2922 C iii and jjj point to the residues for which the distance is assigned.
2923 if (ii.gt.nres) then
2930 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2931 C distance and angle dependent SS bond potential.
2932 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2933 C & iabs(itype(jjj)).eq.1) then
2934 C call ssbond_ene(iii,jjj,eij)
2937 if (.not.dyn_ss .and. i.le.nss) then
2938 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2939 & iabs(itype(jjj)).eq.1) then
2940 call ssbond_ene(iii,jjj,eij)
2943 else if (ii.gt.nres .and. jj.gt.nres) then
2944 c Restraints from contact prediction
2946 if (constr_dist.eq.11) then
2947 C ehpb=ehpb+fordepth(i)**4.0d0
2948 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2949 ehpb=ehpb+fordepth(i)**4.0d0
2950 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2951 fac=fordepth(i)**4.0d0
2952 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2953 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
2954 C & ehpb,fordepth(i),dd
2955 C write(iout,*) ehpb,"atu?"
2957 C fac=fordepth(i)**4.0d0
2958 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2959 else !constr_dist.eq.11
2960 if (dhpb1(i).gt.0.0d0) then
2961 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2962 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2963 c write (iout,*) "beta nmr",
2964 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2965 else !dhpb(i).gt.0.00
2967 C Calculate the distance between the two points and its difference from the
2971 C Get the force constant corresponding to this distance.
2973 C Calculate the contribution to energy.
2974 ehpb=ehpb+waga*rdis*rdis
2976 C Evaluate gradient.
2981 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2982 cd & ' waga=',waga,' fac=',fac
2984 ggg(j)=fac*(c(j,jj)-c(j,ii))
2986 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2987 C If this is a SC-SC distance, we need to calculate the contributions to the
2988 C Cartesian gradient in the SC vectors (ghpbx).
2991 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2992 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2996 C write(iout,*) "before"
2998 C write(iout,*) "after",dd
2999 if (constr_dist.eq.11) then
3000 ehpb=ehpb+fordepth(i)**4.0d0
3001 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3002 fac=fordepth(i)**4.0d0
3003 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3004 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3005 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3006 C print *,ehpb,"tu?"
3007 C write(iout,*) ehpb,"btu?",
3008 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3009 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3010 C & ehpb,fordepth(i),dd
3012 if (dhpb1(i).gt.0.0d0) then
3013 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3014 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3015 c write (iout,*) "alph nmr",
3016 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3019 C Get the force constant corresponding to this distance.
3021 C Calculate the contribution to energy.
3022 ehpb=ehpb+waga*rdis*rdis
3023 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3025 C Evaluate gradient.
3031 ggg(j)=fac*(c(j,jj)-c(j,ii))
3033 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3034 C If this is a SC-SC distance, we need to calculate the contributions to the
3035 C Cartesian gradient in the SC vectors (ghpbx).
3038 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3039 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3044 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3049 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3052 C--------------------------------------------------------------------------
3053 subroutine ssbond_ene(i,j,eij)
3055 C Calculate the distance and angle dependent SS-bond potential energy
3056 C using a free-energy function derived based on RHF/6-31G** ab initio
3057 C calculations of diethyl disulfide.
3059 C A. Liwo and U. Kozlowska, 11/24/03
3061 implicit real*8 (a-h,o-z)
3062 include 'DIMENSIONS'
3063 include 'sizesclu.dat'
3064 include 'COMMON.SBRIDGE'
3065 include 'COMMON.CHAIN'
3066 include 'COMMON.DERIV'
3067 include 'COMMON.LOCAL'
3068 include 'COMMON.INTERACT'
3069 include 'COMMON.VAR'
3070 include 'COMMON.IOUNITS'
3071 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3072 itypi=iabs(itype(i))
3076 dxi=dc_norm(1,nres+i)
3077 dyi=dc_norm(2,nres+i)
3078 dzi=dc_norm(3,nres+i)
3079 dsci_inv=dsc_inv(itypi)
3080 itypj=iabs(itype(j))
3081 dscj_inv=dsc_inv(itypj)
3085 dxj=dc_norm(1,nres+j)
3086 dyj=dc_norm(2,nres+j)
3087 dzj=dc_norm(3,nres+j)
3088 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3093 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3094 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3095 om12=dxi*dxj+dyi*dyj+dzi*dzj
3097 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3098 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3104 deltat12=om2-om1+2.0d0
3106 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3107 & +akct*deltad*deltat12
3108 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3109 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3110 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3111 c & " deltat12",deltat12," eij",eij
3112 ed=2*akcm*deltad+akct*deltat12
3114 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3115 eom1=-2*akth*deltat1-pom1-om2*pom2
3116 eom2= 2*akth*deltat2+pom1-om1*pom2
3119 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3122 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3123 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3124 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3125 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3128 C Calculate the components of the gradient in DC and X
3132 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3137 C--------------------------------------------------------------------------
3138 subroutine ebond(estr)
3140 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3142 implicit real*8 (a-h,o-z)
3143 include 'DIMENSIONS'
3144 include 'sizesclu.dat'
3145 include 'COMMON.LOCAL'
3146 include 'COMMON.GEO'
3147 include 'COMMON.INTERACT'
3148 include 'COMMON.DERIV'
3149 include 'COMMON.VAR'
3150 include 'COMMON.CHAIN'
3151 include 'COMMON.IOUNITS'
3152 include 'COMMON.NAMES'
3153 include 'COMMON.FFIELD'
3154 include 'COMMON.CONTROL'
3155 logical energy_dec /.false./
3156 double precision u(3),ud(3)
3160 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3161 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3163 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3164 & *dc(j,i-1)/vbld(i)
3166 if (energy_dec) write(iout,*)
3167 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3169 diff = vbld(i)-vbldp0
3170 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3173 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3178 estr=0.5d0*AKP*estr+estr1
3180 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3184 if (iti.ne.10 .and. iti.ne.ntyp1) then
3187 diff=vbld(i+nres)-vbldsc0(1,iti)
3188 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3189 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3190 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3192 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3196 diff=vbld(i+nres)-vbldsc0(j,iti)
3197 ud(j)=aksc(j,iti)*diff
3198 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3212 uprod2=uprod2*u(k)*u(k)
3216 usumsqder=usumsqder+ud(j)*uprod2
3218 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3219 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3220 estr=estr+uprod/usum
3222 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3230 C--------------------------------------------------------------------------
3231 subroutine ebend(etheta)
3233 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3234 C angles gamma and its derivatives in consecutive thetas and gammas.
3236 implicit real*8 (a-h,o-z)
3237 include 'DIMENSIONS'
3238 include 'sizesclu.dat'
3239 include 'COMMON.LOCAL'
3240 include 'COMMON.GEO'
3241 include 'COMMON.INTERACT'
3242 include 'COMMON.DERIV'
3243 include 'COMMON.VAR'
3244 include 'COMMON.CHAIN'
3245 include 'COMMON.IOUNITS'
3246 include 'COMMON.NAMES'
3247 include 'COMMON.FFIELD'
3248 common /calcthet/ term1,term2,termm,diffak,ratak,
3249 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3250 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3251 double precision y(2),z(2)
3253 c time11=dexp(-2*time)
3256 c write (iout,*) "nres",nres
3257 c write (*,'(a,i2)') 'EBEND ICG=',icg
3258 c write (iout,*) ithet_start,ithet_end
3259 do i=ithet_start,ithet_end
3260 if (itype(i-1).eq.ntyp1) cycle
3261 C Zero the energy function and its derivative at 0 or pi.
3262 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3264 ichir1=isign(1,itype(i-2))
3265 ichir2=isign(1,itype(i))
3266 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3267 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3268 if (itype(i-1).eq.10) then
3269 itype1=isign(10,itype(i-2))
3270 ichir11=isign(1,itype(i-2))
3271 ichir12=isign(1,itype(i-2))
3272 itype2=isign(10,itype(i))
3273 ichir21=isign(1,itype(i))
3274 ichir22=isign(1,itype(i))
3276 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3280 c call proc_proc(phii,icrc)
3281 if (icrc.eq.1) phii=150.0
3291 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3295 c call proc_proc(phii1,icrc)
3296 if (icrc.eq.1) phii1=150.0
3308 C Calculate the "mean" value of theta from the part of the distribution
3309 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3310 C In following comments this theta will be referred to as t_c.
3311 thet_pred_mean=0.0d0
3313 athetk=athet(k,it,ichir1,ichir2)
3314 bthetk=bthet(k,it,ichir1,ichir2)
3316 athetk=athet(k,itype1,ichir11,ichir12)
3317 bthetk=bthet(k,itype2,ichir21,ichir22)
3319 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3321 c write (iout,*) "thet_pred_mean",thet_pred_mean
3322 dthett=thet_pred_mean*ssd
3323 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3324 c write (iout,*) "thet_pred_mean",thet_pred_mean
3325 C Derivatives of the "mean" values in gamma1 and gamma2.
3326 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3327 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3328 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3329 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3331 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3332 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3333 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3334 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3336 if (theta(i).gt.pi-delta) then
3337 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3339 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3340 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3341 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3343 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3345 else if (theta(i).lt.delta) then
3346 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3347 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3348 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3350 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3351 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3354 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3357 etheta=etheta+ethetai
3358 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3359 c & rad2deg*phii,rad2deg*phii1,ethetai
3360 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3361 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3362 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3365 C Ufff.... We've done all this!!!
3368 C---------------------------------------------------------------------------
3369 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3371 implicit real*8 (a-h,o-z)
3372 include 'DIMENSIONS'
3373 include 'COMMON.LOCAL'
3374 include 'COMMON.IOUNITS'
3375 common /calcthet/ term1,term2,termm,diffak,ratak,
3376 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3377 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3378 C Calculate the contributions to both Gaussian lobes.
3379 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3380 C The "polynomial part" of the "standard deviation" of this part of
3384 sig=sig*thet_pred_mean+polthet(j,it)
3386 C Derivative of the "interior part" of the "standard deviation of the"
3387 C gamma-dependent Gaussian lobe in t_c.
3388 sigtc=3*polthet(3,it)
3390 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3393 C Set the parameters of both Gaussian lobes of the distribution.
3394 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3395 fac=sig*sig+sigc0(it)
3398 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3399 sigsqtc=-4.0D0*sigcsq*sigtc
3400 c print *,i,sig,sigtc,sigsqtc
3401 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3402 sigtc=-sigtc/(fac*fac)
3403 C Following variable is sigma(t_c)**(-2)
3404 sigcsq=sigcsq*sigcsq
3406 sig0inv=1.0D0/sig0i**2
3407 delthec=thetai-thet_pred_mean
3408 delthe0=thetai-theta0i
3409 term1=-0.5D0*sigcsq*delthec*delthec
3410 term2=-0.5D0*sig0inv*delthe0*delthe0
3411 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3412 C NaNs in taking the logarithm. We extract the largest exponent which is added
3413 C to the energy (this being the log of the distribution) at the end of energy
3414 C term evaluation for this virtual-bond angle.
3415 if (term1.gt.term2) then
3417 term2=dexp(term2-termm)
3421 term1=dexp(term1-termm)
3424 C The ratio between the gamma-independent and gamma-dependent lobes of
3425 C the distribution is a Gaussian function of thet_pred_mean too.
3426 diffak=gthet(2,it)-thet_pred_mean
3427 ratak=diffak/gthet(3,it)**2
3428 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3429 C Let's differentiate it in thet_pred_mean NOW.
3431 C Now put together the distribution terms to make complete distribution.
3432 termexp=term1+ak*term2
3433 termpre=sigc+ak*sig0i
3434 C Contribution of the bending energy from this theta is just the -log of
3435 C the sum of the contributions from the two lobes and the pre-exponential
3436 C factor. Simple enough, isn't it?
3437 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3438 C NOW the derivatives!!!
3439 C 6/6/97 Take into account the deformation.
3440 E_theta=(delthec*sigcsq*term1
3441 & +ak*delthe0*sig0inv*term2)/termexp
3442 E_tc=((sigtc+aktc*sig0i)/termpre
3443 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3444 & aktc*term2)/termexp)
3447 c-----------------------------------------------------------------------------
3448 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3449 implicit real*8 (a-h,o-z)
3450 include 'DIMENSIONS'
3451 include 'COMMON.LOCAL'
3452 include 'COMMON.IOUNITS'
3453 common /calcthet/ term1,term2,termm,diffak,ratak,
3454 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3455 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3456 delthec=thetai-thet_pred_mean
3457 delthe0=thetai-theta0i
3458 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3459 t3 = thetai-thet_pred_mean
3463 t14 = t12+t6*sigsqtc
3465 t21 = thetai-theta0i
3471 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3472 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3473 & *(-t12*t9-ak*sig0inv*t27)
3477 C--------------------------------------------------------------------------
3478 subroutine ebend(etheta)
3480 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3481 C angles gamma and its derivatives in consecutive thetas and gammas.
3482 C ab initio-derived potentials from
3483 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3485 implicit real*8 (a-h,o-z)
3486 include 'DIMENSIONS'
3487 include 'sizesclu.dat'
3488 include 'COMMON.LOCAL'
3489 include 'COMMON.GEO'
3490 include 'COMMON.INTERACT'
3491 include 'COMMON.DERIV'
3492 include 'COMMON.VAR'
3493 include 'COMMON.CHAIN'
3494 include 'COMMON.IOUNITS'
3495 include 'COMMON.NAMES'
3496 include 'COMMON.FFIELD'
3497 include 'COMMON.CONTROL'
3498 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3499 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3500 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3501 & sinph1ph2(maxdouble,maxdouble)
3502 logical lprn /.false./, lprn1 /.false./
3504 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3505 do i=ithet_start,ithet_end
3506 c if (itype(i-1).eq.ntyp1) cycle
3507 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3508 &(itype(i).eq.ntyp1)) cycle
3509 if (iabs(itype(i+1)).eq.20) iblock=2
3510 if (iabs(itype(i+1)).ne.20) iblock=1
3514 theti2=0.5d0*theta(i)
3515 CC Ta zmina jest niewlasciwa
3516 ityp2=ithetyp((itype(i-1)))
3518 coskt(k)=dcos(k*theti2)
3519 sinkt(k)=dsin(k*theti2)
3521 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3524 if (phii.ne.phii) phii=150.0
3528 ityp1=ithetyp((itype(i-2)))
3530 cosph1(k)=dcos(k*phii)
3531 sinph1(k)=dsin(k*phii)
3537 ityp1=ithetyp((itype(i-2)))
3542 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3545 if (phii1.ne.phii1) phii1=150.0
3550 ityp3=ithetyp((itype(i)))
3552 cosph2(k)=dcos(k*phii1)
3553 sinph2(k)=dsin(k*phii1)
3558 ityp3=ithetyp((itype(i)))
3564 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3565 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3567 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3570 ccl=cosph1(l)*cosph2(k-l)
3571 ssl=sinph1(l)*sinph2(k-l)
3572 scl=sinph1(l)*cosph2(k-l)
3573 csl=cosph1(l)*sinph2(k-l)
3574 cosph1ph2(l,k)=ccl-ssl
3575 cosph1ph2(k,l)=ccl+ssl
3576 sinph1ph2(l,k)=scl+csl
3577 sinph1ph2(k,l)=scl-csl
3581 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3582 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3583 write (iout,*) "coskt and sinkt"
3585 write (iout,*) k,coskt(k),sinkt(k)
3589 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3590 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3593 & write (iout,*) "k",k," aathet",
3594 & aathet(k,ityp1,ityp2,ityp3,iblock),
3595 & " ethetai",ethetai
3598 write (iout,*) "cosph and sinph"
3600 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3602 write (iout,*) "cosph1ph2 and sinph2ph2"
3605 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3606 & sinph1ph2(l,k),sinph1ph2(k,l)
3609 write(iout,*) "ethetai",ethetai
3613 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3614 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3615 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3616 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3617 ethetai=ethetai+sinkt(m)*aux
3618 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3619 dephii=dephii+k*sinkt(m)*(
3620 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3621 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3622 dephii1=dephii1+k*sinkt(m)*(
3623 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3624 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3626 & write (iout,*) "m",m," k",k," bbthet",
3627 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3628 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3629 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3630 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3634 & write(iout,*) "ethetai",ethetai
3638 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3639 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3640 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3641 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3642 ethetai=ethetai+sinkt(m)*aux
3643 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3644 dephii=dephii+l*sinkt(m)*(
3645 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3646 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3647 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3648 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3649 dephii1=dephii1+(k-l)*sinkt(m)*(
3650 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3651 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3652 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3653 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3655 write (iout,*) "m",m," k",k," l",l," ffthet",
3656 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3657 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3658 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3659 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3660 & " ethetai",ethetai
3661 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3662 & cosph1ph2(k,l)*sinkt(m),
3663 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3669 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3670 & i,theta(i)*rad2deg,phii*rad2deg,
3671 & phii1*rad2deg,ethetai
3672 etheta=etheta+ethetai
3673 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3674 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3675 c gloc(nphi+i-2,icg)=wang*dethetai
3676 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3682 c-----------------------------------------------------------------------------
3683 subroutine esc(escloc)
3684 C Calculate the local energy of a side chain and its derivatives in the
3685 C corresponding virtual-bond valence angles THETA and the spherical angles
3687 implicit real*8 (a-h,o-z)
3688 include 'DIMENSIONS'
3689 include 'sizesclu.dat'
3690 include 'COMMON.GEO'
3691 include 'COMMON.LOCAL'
3692 include 'COMMON.VAR'
3693 include 'COMMON.INTERACT'
3694 include 'COMMON.DERIV'
3695 include 'COMMON.CHAIN'
3696 include 'COMMON.IOUNITS'
3697 include 'COMMON.NAMES'
3698 include 'COMMON.FFIELD'
3699 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3700 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3701 common /sccalc/ time11,time12,time112,theti,it,nlobit
3704 c write (iout,'(a)') 'ESC'
3705 do i=loc_start,loc_end
3707 if (it.eq.ntyp1) cycle
3708 if (it.eq.10) goto 1
3709 nlobit=nlob(iabs(it))
3710 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3711 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3712 theti=theta(i+1)-pipol
3716 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3718 if (x(2).gt.pi-delta) then
3722 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3724 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3725 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3727 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3728 & ddersc0(1),dersc(1))
3729 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3730 & ddersc0(3),dersc(3))
3732 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3734 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3735 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3736 & dersc0(2),esclocbi,dersc02)
3737 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3739 call splinthet(x(2),0.5d0*delta,ss,ssd)
3744 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3746 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3747 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3749 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3751 c write (iout,*) escloci
3752 else if (x(2).lt.delta) then
3756 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3758 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3759 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3761 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3762 & ddersc0(1),dersc(1))
3763 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3764 & ddersc0(3),dersc(3))
3766 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3768 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3769 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3770 & dersc0(2),esclocbi,dersc02)
3771 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3776 call splinthet(x(2),0.5d0*delta,ss,ssd)
3778 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3780 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3781 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3783 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3784 c write (iout,*) escloci
3786 call enesc(x,escloci,dersc,ddummy,.false.)
3789 escloc=escloc+escloci
3790 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3792 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3794 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3795 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3800 C---------------------------------------------------------------------------
3801 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3802 implicit real*8 (a-h,o-z)
3803 include 'DIMENSIONS'
3804 include 'COMMON.GEO'
3805 include 'COMMON.LOCAL'
3806 include 'COMMON.IOUNITS'
3807 common /sccalc/ time11,time12,time112,theti,it,nlobit
3808 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3809 double precision contr(maxlob,-1:1)
3811 c write (iout,*) 'it=',it,' nlobit=',nlobit
3815 if (mixed) ddersc(j)=0.0d0
3819 C Because of periodicity of the dependence of the SC energy in omega we have
3820 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3821 C To avoid underflows, first compute & store the exponents.
3829 z(k)=x(k)-censc(k,j,it)
3834 Axk=Axk+gaussc(l,k,j,it)*z(l)
3840 expfac=expfac+Ax(k,j,iii)*z(k)
3848 C As in the case of ebend, we want to avoid underflows in exponentiation and
3849 C subsequent NaNs and INFs in energy calculation.
3850 C Find the largest exponent
3854 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3858 cd print *,'it=',it,' emin=',emin
3860 C Compute the contribution to SC energy and derivatives
3864 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3865 cd print *,'j=',j,' expfac=',expfac
3866 escloc_i=escloc_i+expfac
3868 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3872 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3873 & +gaussc(k,2,j,it))*expfac
3880 dersc(1)=dersc(1)/cos(theti)**2
3881 ddersc(1)=ddersc(1)/cos(theti)**2
3884 escloci=-(dlog(escloc_i)-emin)
3886 dersc(j)=dersc(j)/escloc_i
3890 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3895 C------------------------------------------------------------------------------
3896 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3897 implicit real*8 (a-h,o-z)
3898 include 'DIMENSIONS'
3899 include 'COMMON.GEO'
3900 include 'COMMON.LOCAL'
3901 include 'COMMON.IOUNITS'
3902 common /sccalc/ time11,time12,time112,theti,it,nlobit
3903 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3904 double precision contr(maxlob)
3915 z(k)=x(k)-censc(k,j,it)
3921 Axk=Axk+gaussc(l,k,j,it)*z(l)
3927 expfac=expfac+Ax(k,j)*z(k)
3932 C As in the case of ebend, we want to avoid underflows in exponentiation and
3933 C subsequent NaNs and INFs in energy calculation.
3934 C Find the largest exponent
3937 if (emin.gt.contr(j)) emin=contr(j)
3941 C Compute the contribution to SC energy and derivatives
3945 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3946 escloc_i=escloc_i+expfac
3948 dersc(k)=dersc(k)+Ax(k,j)*expfac
3950 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3951 & +gaussc(1,2,j,it))*expfac
3955 dersc(1)=dersc(1)/cos(theti)**2
3956 dersc12=dersc12/cos(theti)**2
3957 escloci=-(dlog(escloc_i)-emin)
3959 dersc(j)=dersc(j)/escloc_i
3961 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3965 c----------------------------------------------------------------------------------
3966 subroutine esc(escloc)
3967 C Calculate the local energy of a side chain and its derivatives in the
3968 C corresponding virtual-bond valence angles THETA and the spherical angles
3969 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3970 C added by Urszula Kozlowska. 07/11/2007
3972 implicit real*8 (a-h,o-z)
3973 include 'DIMENSIONS'
3974 include 'sizesclu.dat'
3975 include 'COMMON.GEO'
3976 include 'COMMON.LOCAL'
3977 include 'COMMON.VAR'
3978 include 'COMMON.SCROT'
3979 include 'COMMON.INTERACT'
3980 include 'COMMON.DERIV'
3981 include 'COMMON.CHAIN'
3982 include 'COMMON.IOUNITS'
3983 include 'COMMON.NAMES'
3984 include 'COMMON.FFIELD'
3985 include 'COMMON.CONTROL'
3986 include 'COMMON.VECTORS'
3987 double precision x_prime(3),y_prime(3),z_prime(3)
3988 & , sumene,dsc_i,dp2_i,x(65),
3989 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3990 & de_dxx,de_dyy,de_dzz,de_dt
3991 double precision s1_t,s1_6_t,s2_t,s2_6_t
3993 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3994 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3995 & dt_dCi(3),dt_dCi1(3)
3996 common /sccalc/ time11,time12,time112,theti,it,nlobit
3999 do i=loc_start,loc_end
4000 if (itype(i).eq.ntyp1) cycle
4001 costtab(i+1) =dcos(theta(i+1))
4002 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4003 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4004 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4005 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4006 cosfac=dsqrt(cosfac2)
4007 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4008 sinfac=dsqrt(sinfac2)
4010 if (it.eq.10) goto 1
4012 C Compute the axes of tghe local cartesian coordinates system; store in
4013 c x_prime, y_prime and z_prime
4020 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4021 C & dc_norm(3,i+nres)
4023 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4024 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4027 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4030 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4031 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4032 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4033 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4034 c & " xy",scalar(x_prime(1),y_prime(1)),
4035 c & " xz",scalar(x_prime(1),z_prime(1)),
4036 c & " yy",scalar(y_prime(1),y_prime(1)),
4037 c & " yz",scalar(y_prime(1),z_prime(1)),
4038 c & " zz",scalar(z_prime(1),z_prime(1))
4040 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4041 C to local coordinate system. Store in xx, yy, zz.
4047 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4048 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4049 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4056 C Compute the energy of the ith side cbain
4058 c write (2,*) "xx",xx," yy",yy," zz",zz
4061 x(j) = sc_parmin(j,it)
4064 Cc diagnostics - remove later
4066 yy1 = dsin(alph(2))*dcos(omeg(2))
4067 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4068 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4069 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4070 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4072 C," --- ", xx_w,yy_w,zz_w
4075 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4076 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4078 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4079 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4081 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4082 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4083 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4084 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4085 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4087 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4088 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4089 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4090 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4091 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4093 dsc_i = 0.743d0+x(61)
4095 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4096 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4097 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4098 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4099 s1=(1+x(63))/(0.1d0 + dscp1)
4100 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4101 s2=(1+x(65))/(0.1d0 + dscp2)
4102 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4103 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4104 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4105 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4107 c & dscp1,dscp2,sumene
4108 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4109 escloc = escloc + sumene
4110 c write (2,*) "escloc",escloc
4111 if (.not. calc_grad) goto 1
4114 C This section to check the numerical derivatives of the energy of ith side
4115 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4116 C #define DEBUG in the code to turn it on.
4118 write (2,*) "sumene =",sumene
4122 write (2,*) xx,yy,zz
4123 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4124 de_dxx_num=(sumenep-sumene)/aincr
4126 write (2,*) "xx+ sumene from enesc=",sumenep
4129 write (2,*) xx,yy,zz
4130 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4131 de_dyy_num=(sumenep-sumene)/aincr
4133 write (2,*) "yy+ sumene from enesc=",sumenep
4136 write (2,*) xx,yy,zz
4137 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4138 de_dzz_num=(sumenep-sumene)/aincr
4140 write (2,*) "zz+ sumene from enesc=",sumenep
4141 costsave=cost2tab(i+1)
4142 sintsave=sint2tab(i+1)
4143 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4144 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4145 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4146 de_dt_num=(sumenep-sumene)/aincr
4147 write (2,*) " t+ sumene from enesc=",sumenep
4148 cost2tab(i+1)=costsave
4149 sint2tab(i+1)=sintsave
4150 C End of diagnostics section.
4153 C Compute the gradient of esc
4155 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4156 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4157 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4158 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4159 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4160 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4161 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4162 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4163 pom1=(sumene3*sint2tab(i+1)+sumene1)
4164 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4165 pom2=(sumene4*cost2tab(i+1)+sumene2)
4166 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4167 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4168 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4169 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4171 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4172 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4173 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4175 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4176 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4177 & +(pom1+pom2)*pom_dx
4179 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4182 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4183 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4184 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4186 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4187 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4188 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4189 & +x(59)*zz**2 +x(60)*xx*zz
4190 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4191 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4192 & +(pom1-pom2)*pom_dy
4194 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4197 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4198 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4199 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4200 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4201 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4202 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4203 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4204 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4206 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4209 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4210 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4211 & +pom1*pom_dt1+pom2*pom_dt2
4213 write(2,*), "de_dt = ", de_dt,de_dt_num
4217 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4218 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4219 cosfac2xx=cosfac2*xx
4220 sinfac2yy=sinfac2*yy
4222 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4224 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4226 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4227 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4228 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4229 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4230 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4231 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4232 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4233 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4234 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4235 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4239 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4240 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4241 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4242 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4245 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4246 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4247 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4249 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4250 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4254 dXX_Ctab(k,i)=dXX_Ci(k)
4255 dXX_C1tab(k,i)=dXX_Ci1(k)
4256 dYY_Ctab(k,i)=dYY_Ci(k)
4257 dYY_C1tab(k,i)=dYY_Ci1(k)
4258 dZZ_Ctab(k,i)=dZZ_Ci(k)
4259 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4260 dXX_XYZtab(k,i)=dXX_XYZ(k)
4261 dYY_XYZtab(k,i)=dYY_XYZ(k)
4262 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4266 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4267 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4268 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4269 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4270 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4272 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4273 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4274 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4275 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4276 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4277 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4278 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4279 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4281 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4282 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4284 C to check gradient call subroutine check_grad
4291 c------------------------------------------------------------------------------
4292 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4294 C This procedure calculates two-body contact function g(rij) and its derivative:
4297 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4300 C where x=(rij-r0ij)/delta
4302 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4305 double precision rij,r0ij,eps0ij,fcont,fprimcont
4306 double precision x,x2,x4,delta
4310 if (x.lt.-1.0D0) then
4313 else if (x.le.1.0D0) then
4316 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4317 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4324 c------------------------------------------------------------------------------
4325 subroutine splinthet(theti,delta,ss,ssder)
4326 implicit real*8 (a-h,o-z)
4327 include 'DIMENSIONS'
4328 include 'sizesclu.dat'
4329 include 'COMMON.VAR'
4330 include 'COMMON.GEO'
4333 if (theti.gt.pipol) then
4334 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4336 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4341 c------------------------------------------------------------------------------
4342 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4344 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4345 double precision ksi,ksi2,ksi3,a1,a2,a3
4346 a1=fprim0*delta/(f1-f0)
4352 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4353 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4356 c------------------------------------------------------------------------------
4357 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4359 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4360 double precision ksi,ksi2,ksi3,a1,a2,a3
4365 a2=3*(f1x-f0x)-2*fprim0x*delta
4366 a3=fprim0x*delta-2*(f1x-f0x)
4367 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4370 C-----------------------------------------------------------------------------
4372 C-----------------------------------------------------------------------------
4373 subroutine etor(etors,edihcnstr,fact)
4374 implicit real*8 (a-h,o-z)
4375 include 'DIMENSIONS'
4376 include 'sizesclu.dat'
4377 include 'COMMON.VAR'
4378 include 'COMMON.GEO'
4379 include 'COMMON.LOCAL'
4380 include 'COMMON.TORSION'
4381 include 'COMMON.INTERACT'
4382 include 'COMMON.DERIV'
4383 include 'COMMON.CHAIN'
4384 include 'COMMON.NAMES'
4385 include 'COMMON.IOUNITS'
4386 include 'COMMON.FFIELD'
4387 include 'COMMON.TORCNSTR'
4389 C Set lprn=.true. for debugging
4393 do i=iphi_start,iphi_end
4394 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4395 & .or. itype(i).eq.ntyp1) cycle
4396 itori=itortyp(itype(i-2))
4397 itori1=itortyp(itype(i-1))
4400 C Proline-Proline pair is a special case...
4401 if (itori.eq.3 .and. itori1.eq.3) then
4402 if (phii.gt.-dwapi3) then
4404 fac=1.0D0/(1.0D0-cosphi)
4405 etorsi=v1(1,3,3)*fac
4406 etorsi=etorsi+etorsi
4407 etors=etors+etorsi-v1(1,3,3)
4408 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4411 v1ij=v1(j+1,itori,itori1)
4412 v2ij=v2(j+1,itori,itori1)
4415 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4416 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4420 v1ij=v1(j,itori,itori1)
4421 v2ij=v2(j,itori,itori1)
4424 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4425 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4429 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4430 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4431 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4432 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4433 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4435 ! 6/20/98 - dihedral angle constraints
4438 itori=idih_constr(i)
4441 if (difi.gt.drange(i)) then
4443 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4444 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4445 else if (difi.lt.-drange(i)) then
4447 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4448 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4450 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4451 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4453 ! write (iout,*) 'edihcnstr',edihcnstr
4456 c------------------------------------------------------------------------------
4458 subroutine etor(etors,edihcnstr,fact)
4459 implicit real*8 (a-h,o-z)
4460 include 'DIMENSIONS'
4461 include 'sizesclu.dat'
4462 include 'COMMON.VAR'
4463 include 'COMMON.GEO'
4464 include 'COMMON.LOCAL'
4465 include 'COMMON.TORSION'
4466 include 'COMMON.INTERACT'
4467 include 'COMMON.DERIV'
4468 include 'COMMON.CHAIN'
4469 include 'COMMON.NAMES'
4470 include 'COMMON.IOUNITS'
4471 include 'COMMON.FFIELD'
4472 include 'COMMON.TORCNSTR'
4474 C Set lprn=.true. for debugging
4478 do i=iphi_start,iphi_end
4479 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4480 & .or. itype(i).eq.ntyp1) cycle
4481 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4482 if (iabs(itype(i)).eq.20) then
4487 itori=itortyp(itype(i-2))
4488 itori1=itortyp(itype(i-1))
4491 C Regular cosine and sine terms
4492 do j=1,nterm(itori,itori1,iblock)
4493 v1ij=v1(j,itori,itori1,iblock)
4494 v2ij=v2(j,itori,itori1,iblock)
4497 etors=etors+v1ij*cosphi+v2ij*sinphi
4498 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4502 C E = SUM ----------------------------------- - v1
4503 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4505 cosphi=dcos(0.5d0*phii)
4506 sinphi=dsin(0.5d0*phii)
4507 do j=1,nlor(itori,itori1,iblock)
4508 vl1ij=vlor1(j,itori,itori1)
4509 vl2ij=vlor2(j,itori,itori1)
4510 vl3ij=vlor3(j,itori,itori1)
4511 pom=vl2ij*cosphi+vl3ij*sinphi
4512 pom1=1.0d0/(pom*pom+1.0d0)
4513 etors=etors+vl1ij*pom1
4515 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4517 C Subtract the constant term
4518 etors=etors-v0(itori,itori1,iblock)
4520 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4521 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4522 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4523 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4524 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4527 ! 6/20/98 - dihedral angle constraints
4530 itori=idih_constr(i)
4532 difi=pinorm(phii-phi0(i))
4534 if (difi.gt.drange(i)) then
4536 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4537 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4538 edihi=0.25d0*ftors(i)*difi**4
4539 else if (difi.lt.-drange(i)) then
4541 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4542 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4543 edihi=0.25d0*ftors(i)*difi**4
4547 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4549 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4550 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4552 ! write (iout,*) 'edihcnstr',edihcnstr
4555 c----------------------------------------------------------------------------
4556 subroutine etor_d(etors_d,fact2)
4557 C 6/23/01 Compute double torsional energy
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'sizesclu.dat'
4561 include 'COMMON.VAR'
4562 include 'COMMON.GEO'
4563 include 'COMMON.LOCAL'
4564 include 'COMMON.TORSION'
4565 include 'COMMON.INTERACT'
4566 include 'COMMON.DERIV'
4567 include 'COMMON.CHAIN'
4568 include 'COMMON.NAMES'
4569 include 'COMMON.IOUNITS'
4570 include 'COMMON.FFIELD'
4571 include 'COMMON.TORCNSTR'
4573 C Set lprn=.true. for debugging
4577 do i=iphi_start,iphi_end-1
4578 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4579 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4580 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4582 itori=itortyp(itype(i-2))
4583 itori1=itortyp(itype(i-1))
4584 itori2=itortyp(itype(i))
4590 if (iabs(itype(i+1)).eq.20) iblock=2
4591 C Regular cosine and sine terms
4592 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4593 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4594 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4595 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4596 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4597 cosphi1=dcos(j*phii)
4598 sinphi1=dsin(j*phii)
4599 cosphi2=dcos(j*phii1)
4600 sinphi2=dsin(j*phii1)
4601 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4602 & v2cij*cosphi2+v2sij*sinphi2
4603 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4604 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4606 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4608 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4609 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4610 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4611 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4612 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4613 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4614 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4615 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4616 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4617 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4618 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4619 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4620 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4621 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4624 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4625 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4631 c------------------------------------------------------------------------------
4632 subroutine eback_sc_corr(esccor)
4633 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4634 c conformational states; temporarily implemented as differences
4635 c between UNRES torsional potentials (dependent on three types of
4636 c residues) and the torsional potentials dependent on all 20 types
4637 c of residues computed from AM1 energy surfaces of terminally-blocked
4638 c amino-acid residues.
4639 implicit real*8 (a-h,o-z)
4640 include 'DIMENSIONS'
4641 include 'sizesclu.dat'
4642 include 'COMMON.VAR'
4643 include 'COMMON.GEO'
4644 include 'COMMON.LOCAL'
4645 include 'COMMON.TORSION'
4646 include 'COMMON.SCCOR'
4647 include 'COMMON.INTERACT'
4648 include 'COMMON.DERIV'
4649 include 'COMMON.CHAIN'
4650 include 'COMMON.NAMES'
4651 include 'COMMON.IOUNITS'
4652 include 'COMMON.FFIELD'
4653 include 'COMMON.CONTROL'
4655 C Set lprn=.true. for debugging
4658 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4660 do i=itau_start,itau_end
4661 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4663 isccori=isccortyp(itype(i-2))
4664 isccori1=isccortyp(itype(i-1))
4666 do intertyp=1,3 !intertyp
4667 cc Added 09 May 2012 (Adasko)
4668 cc Intertyp means interaction type of backbone mainchain correlation:
4669 c 1 = SC...Ca...Ca...Ca
4670 c 2 = Ca...Ca...Ca...SC
4671 c 3 = SC...Ca...Ca...SCi
4673 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4674 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4675 & (itype(i-1).eq.ntyp1)))
4676 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4677 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4678 & .or.(itype(i).eq.ntyp1)))
4679 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4680 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4681 & (itype(i-3).eq.ntyp1)))) cycle
4682 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4683 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4685 do j=1,nterm_sccor(isccori,isccori1)
4686 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4687 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4688 cosphi=dcos(j*tauangle(intertyp,i))
4689 sinphi=dsin(j*tauangle(intertyp,i))
4690 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4691 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4693 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4694 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4696 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4697 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4698 & (v1sccor(j,1,itori,itori1),j=1,6),
4699 & (v2sccor(j,1,itori,itori1),j=1,6)
4700 gsccor_loc(i-3)=gloci
4705 c------------------------------------------------------------------------------
4706 subroutine multibody(ecorr)
4707 C This subroutine calculates multi-body contributions to energy following
4708 C the idea of Skolnick et al. If side chains I and J make a contact and
4709 C at the same time side chains I+1 and J+1 make a contact, an extra
4710 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4711 implicit real*8 (a-h,o-z)
4712 include 'DIMENSIONS'
4713 include 'COMMON.IOUNITS'
4714 include 'COMMON.DERIV'
4715 include 'COMMON.INTERACT'
4716 include 'COMMON.CONTACTS'
4717 double precision gx(3),gx1(3)
4720 C Set lprn=.true. for debugging
4724 write (iout,'(a)') 'Contact function values:'
4726 write (iout,'(i2,20(1x,i2,f10.5))')
4727 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4742 num_conti=num_cont(i)
4743 num_conti1=num_cont(i1)
4748 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4749 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4750 cd & ' ishift=',ishift
4751 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4752 C The system gains extra energy.
4753 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4754 endif ! j1==j+-ishift
4763 c------------------------------------------------------------------------------
4764 double precision function esccorr(i,j,k,l,jj,kk)
4765 implicit real*8 (a-h,o-z)
4766 include 'DIMENSIONS'
4767 include 'COMMON.IOUNITS'
4768 include 'COMMON.DERIV'
4769 include 'COMMON.INTERACT'
4770 include 'COMMON.CONTACTS'
4771 double precision gx(3),gx1(3)
4776 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4777 C Calculate the multi-body contribution to energy.
4778 C Calculate multi-body contributions to the gradient.
4779 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4780 cd & k,l,(gacont(m,kk,k),m=1,3)
4782 gx(m) =ekl*gacont(m,jj,i)
4783 gx1(m)=eij*gacont(m,kk,k)
4784 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4785 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4786 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4787 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4791 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4796 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4802 c------------------------------------------------------------------------------
4804 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4805 implicit real*8 (a-h,o-z)
4806 include 'DIMENSIONS'
4807 integer dimen1,dimen2,atom,indx
4808 double precision buffer(dimen1,dimen2)
4809 double precision zapas
4810 common /contacts_hb/ zapas(3,20,maxres,7),
4811 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4812 & num_cont_hb(maxres),jcont_hb(20,maxres)
4813 num_kont=num_cont_hb(atom)
4817 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4820 buffer(i,indx+22)=facont_hb(i,atom)
4821 buffer(i,indx+23)=ees0p(i,atom)
4822 buffer(i,indx+24)=ees0m(i,atom)
4823 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4825 buffer(1,indx+26)=dfloat(num_kont)
4828 c------------------------------------------------------------------------------
4829 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4830 implicit real*8 (a-h,o-z)
4831 include 'DIMENSIONS'
4832 integer dimen1,dimen2,atom,indx
4833 double precision buffer(dimen1,dimen2)
4834 double precision zapas
4835 common /contacts_hb/ zapas(3,20,maxres,7),
4836 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4837 & num_cont_hb(maxres),jcont_hb(20,maxres)
4838 num_kont=buffer(1,indx+26)
4839 num_kont_old=num_cont_hb(atom)
4840 num_cont_hb(atom)=num_kont+num_kont_old
4845 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4848 facont_hb(ii,atom)=buffer(i,indx+22)
4849 ees0p(ii,atom)=buffer(i,indx+23)
4850 ees0m(ii,atom)=buffer(i,indx+24)
4851 jcont_hb(ii,atom)=buffer(i,indx+25)
4855 c------------------------------------------------------------------------------
4857 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4858 C This subroutine calculates multi-body contributions to hydrogen-bonding
4859 implicit real*8 (a-h,o-z)
4860 include 'DIMENSIONS'
4861 include 'sizesclu.dat'
4862 include 'COMMON.IOUNITS'
4864 include 'COMMON.INFO'
4866 include 'COMMON.FFIELD'
4867 include 'COMMON.DERIV'
4868 include 'COMMON.INTERACT'
4869 include 'COMMON.CONTACTS'
4871 parameter (max_cont=maxconts)
4872 parameter (max_dim=2*(8*3+2))
4873 parameter (msglen1=max_cont*max_dim*4)
4874 parameter (msglen2=2*msglen1)
4875 integer source,CorrelType,CorrelID,Error
4876 double precision buffer(max_cont,max_dim)
4878 double precision gx(3),gx1(3)
4881 C Set lprn=.true. for debugging
4886 if (fgProcs.le.1) goto 30
4888 write (iout,'(a)') 'Contact function values:'
4890 write (iout,'(2i3,50(1x,i2,f5.2))')
4891 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4892 & j=1,num_cont_hb(i))
4895 C Caution! Following code assumes that electrostatic interactions concerning
4896 C a given atom are split among at most two processors!
4906 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4909 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4910 if (MyRank.gt.0) then
4911 C Send correlation contributions to the preceding processor
4913 nn=num_cont_hb(iatel_s)
4914 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4915 cd write (iout,*) 'The BUFFER array:'
4917 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4919 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4921 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4922 C Clear the contacts of the atom passed to the neighboring processor
4923 nn=num_cont_hb(iatel_s+1)
4925 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4927 num_cont_hb(iatel_s)=0
4929 cd write (iout,*) 'Processor ',MyID,MyRank,
4930 cd & ' is sending correlation contribution to processor',MyID-1,
4931 cd & ' msglen=',msglen
4932 cd write (*,*) 'Processor ',MyID,MyRank,
4933 cd & ' is sending correlation contribution to processor',MyID-1,
4934 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4935 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4936 cd write (iout,*) 'Processor ',MyID,
4937 cd & ' has sent correlation contribution to processor',MyID-1,
4938 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4939 cd write (*,*) 'Processor ',MyID,
4940 cd & ' has sent correlation contribution to processor',MyID-1,
4941 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4943 endif ! (MyRank.gt.0)
4947 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4948 if (MyRank.lt.fgProcs-1) then
4949 C Receive correlation contributions from the next processor
4951 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4952 cd write (iout,*) 'Processor',MyID,
4953 cd & ' is receiving correlation contribution from processor',MyID+1,
4954 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4955 cd write (*,*) 'Processor',MyID,
4956 cd & ' is receiving correlation contribution from processor',MyID+1,
4957 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4959 do while (nbytes.le.0)
4960 call mp_probe(MyID+1,CorrelType,nbytes)
4962 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4963 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4964 cd write (iout,*) 'Processor',MyID,
4965 cd & ' has received correlation contribution from processor',MyID+1,
4966 cd & ' msglen=',msglen,' nbytes=',nbytes
4967 cd write (iout,*) 'The received BUFFER array:'
4969 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4971 if (msglen.eq.msglen1) then
4972 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4973 else if (msglen.eq.msglen2) then
4974 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4975 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4978 & 'ERROR!!!! message length changed while processing correlations.'
4980 & 'ERROR!!!! message length changed while processing correlations.'
4981 call mp_stopall(Error)
4982 endif ! msglen.eq.msglen1
4983 endif ! MyRank.lt.fgProcs-1
4990 write (iout,'(a)') 'Contact function values:'
4992 write (iout,'(2i3,50(1x,i2,f5.2))')
4993 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4994 & j=1,num_cont_hb(i))
4998 C Remove the loop below after debugging !!!
5005 C Calculate the local-electrostatic correlation terms
5006 do i=iatel_s,iatel_e+1
5008 num_conti=num_cont_hb(i)
5009 num_conti1=num_cont_hb(i+1)
5014 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5015 c & ' jj=',jj,' kk=',kk
5016 if (j1.eq.j+1 .or. j1.eq.j-1) then
5017 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5018 C The system gains extra energy.
5019 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5021 else if (j1.eq.j) then
5022 C Contacts I-J and I-(J+1) occur simultaneously.
5023 C The system loses extra energy.
5024 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5029 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5030 c & ' jj=',jj,' kk=',kk
5032 C Contacts I-J and (I+1)-J occur simultaneously.
5033 C The system loses extra energy.
5034 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5041 c------------------------------------------------------------------------------
5042 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5044 C This subroutine calculates multi-body contributions to hydrogen-bonding
5045 implicit real*8 (a-h,o-z)
5046 include 'DIMENSIONS'
5047 include 'sizesclu.dat'
5048 include 'COMMON.IOUNITS'
5050 include 'COMMON.INFO'
5052 include 'COMMON.FFIELD'
5053 include 'COMMON.DERIV'
5054 include 'COMMON.INTERACT'
5055 include 'COMMON.CONTACTS'
5057 parameter (max_cont=maxconts)
5058 parameter (max_dim=2*(8*3+2))
5059 parameter (msglen1=max_cont*max_dim*4)
5060 parameter (msglen2=2*msglen1)
5061 integer source,CorrelType,CorrelID,Error
5062 double precision buffer(max_cont,max_dim)
5064 double precision gx(3),gx1(3)
5067 C Set lprn=.true. for debugging
5073 if (fgProcs.le.1) goto 30
5075 write (iout,'(a)') 'Contact function values:'
5077 write (iout,'(2i3,50(1x,i2,f5.2))')
5078 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5079 & j=1,num_cont_hb(i))
5082 C Caution! Following code assumes that electrostatic interactions concerning
5083 C a given atom are split among at most two processors!
5093 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5096 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5097 if (MyRank.gt.0) then
5098 C Send correlation contributions to the preceding processor
5100 nn=num_cont_hb(iatel_s)
5101 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5102 cd write (iout,*) 'The BUFFER array:'
5104 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5106 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5108 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5109 C Clear the contacts of the atom passed to the neighboring processor
5110 nn=num_cont_hb(iatel_s+1)
5112 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5114 num_cont_hb(iatel_s)=0
5116 cd write (iout,*) 'Processor ',MyID,MyRank,
5117 cd & ' is sending correlation contribution to processor',MyID-1,
5118 cd & ' msglen=',msglen
5119 cd write (*,*) 'Processor ',MyID,MyRank,
5120 cd & ' is sending correlation contribution to processor',MyID-1,
5121 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5122 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5123 cd write (iout,*) 'Processor ',MyID,
5124 cd & ' has sent correlation contribution to processor',MyID-1,
5125 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5126 cd write (*,*) 'Processor ',MyID,
5127 cd & ' has sent correlation contribution to processor',MyID-1,
5128 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5130 endif ! (MyRank.gt.0)
5134 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5135 if (MyRank.lt.fgProcs-1) then
5136 C Receive correlation contributions from the next processor
5138 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5139 cd write (iout,*) 'Processor',MyID,
5140 cd & ' is receiving correlation contribution from processor',MyID+1,
5141 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5142 cd write (*,*) 'Processor',MyID,
5143 cd & ' is receiving correlation contribution from processor',MyID+1,
5144 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5146 do while (nbytes.le.0)
5147 call mp_probe(MyID+1,CorrelType,nbytes)
5149 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5150 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5151 cd write (iout,*) 'Processor',MyID,
5152 cd & ' has received correlation contribution from processor',MyID+1,
5153 cd & ' msglen=',msglen,' nbytes=',nbytes
5154 cd write (iout,*) 'The received BUFFER array:'
5156 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5158 if (msglen.eq.msglen1) then
5159 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5160 else if (msglen.eq.msglen2) then
5161 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5162 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5165 & 'ERROR!!!! message length changed while processing correlations.'
5167 & 'ERROR!!!! message length changed while processing correlations.'
5168 call mp_stopall(Error)
5169 endif ! msglen.eq.msglen1
5170 endif ! MyRank.lt.fgProcs-1
5177 write (iout,'(a)') 'Contact function values:'
5179 write (iout,'(2i3,50(1x,i2,f5.2))')
5180 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5181 & j=1,num_cont_hb(i))
5187 C Remove the loop below after debugging !!!
5194 C Calculate the dipole-dipole interaction energies
5195 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5196 do i=iatel_s,iatel_e+1
5197 num_conti=num_cont_hb(i)
5204 C Calculate the local-electrostatic correlation terms
5205 do i=iatel_s,iatel_e+1
5207 num_conti=num_cont_hb(i)
5208 num_conti1=num_cont_hb(i+1)
5213 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5214 c & ' jj=',jj,' kk=',kk
5215 if (j1.eq.j+1 .or. j1.eq.j-1) then
5216 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5217 C The system gains extra energy.
5219 sqd1=dsqrt(d_cont(jj,i))
5220 sqd2=dsqrt(d_cont(kk,i1))
5221 sred_geom = sqd1*sqd2
5222 IF (sred_geom.lt.cutoff_corr) THEN
5223 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5225 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5226 c & ' jj=',jj,' kk=',kk
5227 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5228 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5230 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5231 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5234 cd write (iout,*) 'sred_geom=',sred_geom,
5235 cd & ' ekont=',ekont,' fprim=',fprimcont
5236 call calc_eello(i,j,i+1,j1,jj,kk)
5237 if (wcorr4.gt.0.0d0)
5238 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5239 if (wcorr5.gt.0.0d0)
5240 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5241 c print *,"wcorr5",ecorr5
5242 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5243 cd write(2,*)'ijkl',i,j,i+1,j1
5244 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5245 & .or. wturn6.eq.0.0d0))then
5246 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5247 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5248 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5249 cd & 'ecorr6=',ecorr6
5250 cd write (iout,'(4e15.5)') sred_geom,
5251 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5252 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5253 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5254 else if (wturn6.gt.0.0d0
5255 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5256 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5257 eturn6=eturn6+eello_turn6(i,jj,kk)
5258 cd write (2,*) 'multibody_eello:eturn6',eturn6
5262 else if (j1.eq.j) then
5263 C Contacts I-J and I-(J+1) occur simultaneously.
5264 C The system loses extra energy.
5265 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5270 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5271 c & ' jj=',jj,' kk=',kk
5273 C Contacts I-J and (I+1)-J occur simultaneously.
5274 C The system loses extra energy.
5275 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5282 c------------------------------------------------------------------------------
5283 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5284 implicit real*8 (a-h,o-z)
5285 include 'DIMENSIONS'
5286 include 'COMMON.IOUNITS'
5287 include 'COMMON.DERIV'
5288 include 'COMMON.INTERACT'
5289 include 'COMMON.CONTACTS'
5290 double precision gx(3),gx1(3)
5300 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5301 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5302 C Following 4 lines for diagnostics.
5307 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5309 c write (iout,*)'Contacts have occurred for peptide groups',
5310 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5311 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5312 C Calculate the multi-body contribution to energy.
5313 ecorr=ecorr+ekont*ees
5315 C Calculate multi-body contributions to the gradient.
5317 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5318 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5319 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5320 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5321 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5322 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5323 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5324 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5325 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5326 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5327 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5328 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5329 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5330 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5334 gradcorr(ll,m)=gradcorr(ll,m)+
5335 & ees*ekl*gacont_hbr(ll,jj,i)-
5336 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5337 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5342 gradcorr(ll,m)=gradcorr(ll,m)+
5343 & ees*eij*gacont_hbr(ll,kk,k)-
5344 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5345 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5352 C---------------------------------------------------------------------------
5353 subroutine dipole(i,j,jj)
5354 implicit real*8 (a-h,o-z)
5355 include 'DIMENSIONS'
5356 include 'sizesclu.dat'
5357 include 'COMMON.IOUNITS'
5358 include 'COMMON.CHAIN'
5359 include 'COMMON.FFIELD'
5360 include 'COMMON.DERIV'
5361 include 'COMMON.INTERACT'
5362 include 'COMMON.CONTACTS'
5363 include 'COMMON.TORSION'
5364 include 'COMMON.VAR'
5365 include 'COMMON.GEO'
5366 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5368 iti1 = itortyp(itype(i+1))
5369 if (j.lt.nres-1) then
5370 if (itype(j).le.ntyp) then
5371 itj1 = itortyp(itype(j+1))
5379 dipi(iii,1)=Ub2(iii,i)
5380 dipderi(iii)=Ub2der(iii,i)
5381 dipi(iii,2)=b1(iii,iti1)
5382 dipj(iii,1)=Ub2(iii,j)
5383 dipderj(iii)=Ub2der(iii,j)
5384 dipj(iii,2)=b1(iii,itj1)
5388 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5391 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5394 if (.not.calc_grad) return
5399 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5403 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5408 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5409 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5411 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5413 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5415 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5419 C---------------------------------------------------------------------------
5420 subroutine calc_eello(i,j,k,l,jj,kk)
5422 C This subroutine computes matrices and vectors needed to calculate
5423 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5425 implicit real*8 (a-h,o-z)
5426 include 'DIMENSIONS'
5427 include 'sizesclu.dat'
5428 include 'COMMON.IOUNITS'
5429 include 'COMMON.CHAIN'
5430 include 'COMMON.DERIV'
5431 include 'COMMON.INTERACT'
5432 include 'COMMON.CONTACTS'
5433 include 'COMMON.TORSION'
5434 include 'COMMON.VAR'
5435 include 'COMMON.GEO'
5436 include 'COMMON.FFIELD'
5437 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5438 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5441 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5442 cd & ' jj=',jj,' kk=',kk
5443 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5446 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5447 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5450 call transpose2(aa1(1,1),aa1t(1,1))
5451 call transpose2(aa2(1,1),aa2t(1,1))
5454 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5455 & aa1tder(1,1,lll,kkk))
5456 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5457 & aa2tder(1,1,lll,kkk))
5461 C parallel orientation of the two CA-CA-CA frames.
5463 if (i.gt.1 .and. itype(i).le.ntyp) then
5464 iti=itortyp(itype(i))
5468 itk1=itortyp(itype(k+1))
5469 itj=itortyp(itype(j))
5470 c if (l.lt.nres-1) then
5471 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5472 itl1=itortyp(itype(l+1))
5476 C A1 kernel(j+1) A2T
5478 cd write (iout,'(3f10.5,5x,3f10.5)')
5479 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5481 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5482 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5483 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5484 C Following matrices are needed only for 6-th order cumulants
5485 IF (wcorr6.gt.0.0d0) THEN
5486 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5487 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5488 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5489 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5490 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5491 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5492 & ADtEAderx(1,1,1,1,1,1))
5494 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5495 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5496 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5497 & ADtEA1derx(1,1,1,1,1,1))
5499 C End 6-th order cumulants
5502 cd write (2,*) 'In calc_eello6'
5504 cd write (2,*) 'iii=',iii
5506 cd write (2,*) 'kkk=',kkk
5508 cd write (2,'(3(2f10.5),5x)')
5509 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5514 call transpose2(EUgder(1,1,k),auxmat(1,1))
5515 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5516 call transpose2(EUg(1,1,k),auxmat(1,1))
5517 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5518 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5522 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5523 & EAEAderx(1,1,lll,kkk,iii,1))
5527 C A1T kernel(i+1) A2
5528 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5529 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5530 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5531 C Following matrices are needed only for 6-th order cumulants
5532 IF (wcorr6.gt.0.0d0) THEN
5533 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5534 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5535 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5536 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5537 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5538 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5539 & ADtEAderx(1,1,1,1,1,2))
5540 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5541 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5542 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5543 & ADtEA1derx(1,1,1,1,1,2))
5545 C End 6-th order cumulants
5546 call transpose2(EUgder(1,1,l),auxmat(1,1))
5547 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5548 call transpose2(EUg(1,1,l),auxmat(1,1))
5549 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5550 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5554 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5555 & EAEAderx(1,1,lll,kkk,iii,2))
5560 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5561 C They are needed only when the fifth- or the sixth-order cumulants are
5563 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5564 call transpose2(AEA(1,1,1),auxmat(1,1))
5565 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5566 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5567 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5568 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5569 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5570 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5571 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5572 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5573 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5574 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5575 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5576 call transpose2(AEA(1,1,2),auxmat(1,1))
5577 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5578 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5579 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5580 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5581 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5582 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5583 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5584 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5585 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5586 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5587 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5588 C Calculate the Cartesian derivatives of the vectors.
5592 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5593 call matvec2(auxmat(1,1),b1(1,iti),
5594 & AEAb1derx(1,lll,kkk,iii,1,1))
5595 call matvec2(auxmat(1,1),Ub2(1,i),
5596 & AEAb2derx(1,lll,kkk,iii,1,1))
5597 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5598 & AEAb1derx(1,lll,kkk,iii,2,1))
5599 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5600 & AEAb2derx(1,lll,kkk,iii,2,1))
5601 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5602 call matvec2(auxmat(1,1),b1(1,itj),
5603 & AEAb1derx(1,lll,kkk,iii,1,2))
5604 call matvec2(auxmat(1,1),Ub2(1,j),
5605 & AEAb2derx(1,lll,kkk,iii,1,2))
5606 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5607 & AEAb1derx(1,lll,kkk,iii,2,2))
5608 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5609 & AEAb2derx(1,lll,kkk,iii,2,2))
5616 C Antiparallel orientation of the two CA-CA-CA frames.
5618 if (i.gt.1 .and. itype(i).le.ntyp) then
5619 iti=itortyp(itype(i))
5623 itk1=itortyp(itype(k+1))
5624 itl=itortyp(itype(l))
5625 itj=itortyp(itype(j))
5626 c if (j.lt.nres-1) then
5627 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5628 itj1=itortyp(itype(j+1))
5632 C A2 kernel(j-1)T A1T
5633 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5634 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5635 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5636 C Following matrices are needed only for 6-th order cumulants
5637 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5638 & j.eq.i+4 .and. l.eq.i+3)) THEN
5639 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5640 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5641 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5642 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5643 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5644 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5645 & ADtEAderx(1,1,1,1,1,1))
5646 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5647 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5648 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5649 & ADtEA1derx(1,1,1,1,1,1))
5651 C End 6-th order cumulants
5652 call transpose2(EUgder(1,1,k),auxmat(1,1))
5653 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5654 call transpose2(EUg(1,1,k),auxmat(1,1))
5655 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5656 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5660 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5661 & EAEAderx(1,1,lll,kkk,iii,1))
5665 C A2T kernel(i+1)T A1
5666 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5667 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5668 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5669 C Following matrices are needed only for 6-th order cumulants
5670 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5671 & j.eq.i+4 .and. l.eq.i+3)) THEN
5672 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5673 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5674 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5675 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5676 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5677 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5678 & ADtEAderx(1,1,1,1,1,2))
5679 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5680 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5681 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5682 & ADtEA1derx(1,1,1,1,1,2))
5684 C End 6-th order cumulants
5685 call transpose2(EUgder(1,1,j),auxmat(1,1))
5686 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5687 call transpose2(EUg(1,1,j),auxmat(1,1))
5688 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5689 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5693 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5694 & EAEAderx(1,1,lll,kkk,iii,2))
5699 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5700 C They are needed only when the fifth- or the sixth-order cumulants are
5702 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5703 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5704 call transpose2(AEA(1,1,1),auxmat(1,1))
5705 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5706 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5707 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5708 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5709 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5710 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5711 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5712 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5713 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5714 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5715 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5716 call transpose2(AEA(1,1,2),auxmat(1,1))
5717 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5718 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5719 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5720 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5721 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5722 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5723 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5724 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5725 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5726 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5727 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5728 C Calculate the Cartesian derivatives of the vectors.
5732 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5733 call matvec2(auxmat(1,1),b1(1,iti),
5734 & AEAb1derx(1,lll,kkk,iii,1,1))
5735 call matvec2(auxmat(1,1),Ub2(1,i),
5736 & AEAb2derx(1,lll,kkk,iii,1,1))
5737 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5738 & AEAb1derx(1,lll,kkk,iii,2,1))
5739 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5740 & AEAb2derx(1,lll,kkk,iii,2,1))
5741 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5742 call matvec2(auxmat(1,1),b1(1,itl),
5743 & AEAb1derx(1,lll,kkk,iii,1,2))
5744 call matvec2(auxmat(1,1),Ub2(1,l),
5745 & AEAb2derx(1,lll,kkk,iii,1,2))
5746 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5747 & AEAb1derx(1,lll,kkk,iii,2,2))
5748 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5749 & AEAb2derx(1,lll,kkk,iii,2,2))
5758 C---------------------------------------------------------------------------
5759 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5760 & KK,KKderg,AKA,AKAderg,AKAderx)
5764 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5765 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5766 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5771 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5773 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5776 cd if (lprn) write (2,*) 'In kernel'
5778 cd if (lprn) write (2,*) 'kkk=',kkk
5780 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5781 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5783 cd write (2,*) 'lll=',lll
5784 cd write (2,*) 'iii=1'
5786 cd write (2,'(3(2f10.5),5x)')
5787 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5790 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5791 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5793 cd write (2,*) 'lll=',lll
5794 cd write (2,*) 'iii=2'
5796 cd write (2,'(3(2f10.5),5x)')
5797 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5804 C---------------------------------------------------------------------------
5805 double precision function eello4(i,j,k,l,jj,kk)
5806 implicit real*8 (a-h,o-z)
5807 include 'DIMENSIONS'
5808 include 'sizesclu.dat'
5809 include 'COMMON.IOUNITS'
5810 include 'COMMON.CHAIN'
5811 include 'COMMON.DERIV'
5812 include 'COMMON.INTERACT'
5813 include 'COMMON.CONTACTS'
5814 include 'COMMON.TORSION'
5815 include 'COMMON.VAR'
5816 include 'COMMON.GEO'
5817 double precision pizda(2,2),ggg1(3),ggg2(3)
5818 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5822 cd print *,'eello4:',i,j,k,l,jj,kk
5823 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5824 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5825 cold eij=facont_hb(jj,i)
5826 cold ekl=facont_hb(kk,k)
5828 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5830 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5831 gcorr_loc(k-1)=gcorr_loc(k-1)
5832 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5834 gcorr_loc(l-1)=gcorr_loc(l-1)
5835 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5837 gcorr_loc(j-1)=gcorr_loc(j-1)
5838 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5843 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5844 & -EAEAderx(2,2,lll,kkk,iii,1)
5845 cd derx(lll,kkk,iii)=0.0d0
5849 cd gcorr_loc(l-1)=0.0d0
5850 cd gcorr_loc(j-1)=0.0d0
5851 cd gcorr_loc(k-1)=0.0d0
5853 cd write (iout,*)'Contacts have occurred for peptide groups',
5854 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5855 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5856 if (j.lt.nres-1) then
5863 if (l.lt.nres-1) then
5871 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5872 ggg1(ll)=eel4*g_contij(ll,1)
5873 ggg2(ll)=eel4*g_contij(ll,2)
5874 ghalf=0.5d0*ggg1(ll)
5876 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5877 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5878 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5879 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5880 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5881 ghalf=0.5d0*ggg2(ll)
5883 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5884 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5885 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5886 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5891 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5892 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5897 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5898 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5904 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5909 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5913 cd write (2,*) iii,gcorr_loc(iii)
5917 cd write (2,*) 'ekont',ekont
5918 cd write (iout,*) 'eello4',ekont*eel4
5921 C---------------------------------------------------------------------------
5922 double precision function eello5(i,j,k,l,jj,kk)
5923 implicit real*8 (a-h,o-z)
5924 include 'DIMENSIONS'
5925 include 'sizesclu.dat'
5926 include 'COMMON.IOUNITS'
5927 include 'COMMON.CHAIN'
5928 include 'COMMON.DERIV'
5929 include 'COMMON.INTERACT'
5930 include 'COMMON.CONTACTS'
5931 include 'COMMON.TORSION'
5932 include 'COMMON.VAR'
5933 include 'COMMON.GEO'
5934 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5935 double precision ggg1(3),ggg2(3)
5936 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5941 C /l\ / \ \ / \ / \ / C
5942 C / \ / \ \ / \ / \ / C
5943 C j| o |l1 | o | o| o | | o |o C
5944 C \ |/k\| |/ \| / |/ \| |/ \| C
5945 C \i/ \ / \ / / \ / \ C
5947 C (I) (II) (III) (IV) C
5949 C eello5_1 eello5_2 eello5_3 eello5_4 C
5951 C Antiparallel chains C
5954 C /j\ / \ \ / \ / \ / C
5955 C / \ / \ \ / \ / \ / C
5956 C j1| o |l | o | o| o | | o |o C
5957 C \ |/k\| |/ \| / |/ \| |/ \| C
5958 C \i/ \ / \ / / \ / \ C
5960 C (I) (II) (III) (IV) C
5962 C eello5_1 eello5_2 eello5_3 eello5_4 C
5964 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5966 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5967 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5972 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5974 itk=itortyp(itype(k))
5975 itl=itortyp(itype(l))
5976 itj=itortyp(itype(j))
5981 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5982 cd & eel5_3_num,eel5_4_num)
5986 derx(lll,kkk,iii)=0.0d0
5990 cd eij=facont_hb(jj,i)
5991 cd ekl=facont_hb(kk,k)
5993 cd write (iout,*)'Contacts have occurred for peptide groups',
5994 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5996 C Contribution from the graph I.
5997 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5998 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5999 call transpose2(EUg(1,1,k),auxmat(1,1))
6000 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6001 vv(1)=pizda(1,1)-pizda(2,2)
6002 vv(2)=pizda(1,2)+pizda(2,1)
6003 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6004 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6006 C Explicit gradient in virtual-dihedral angles.
6007 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6008 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6009 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6010 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6011 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6012 vv(1)=pizda(1,1)-pizda(2,2)
6013 vv(2)=pizda(1,2)+pizda(2,1)
6014 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6015 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6016 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6017 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6018 vv(1)=pizda(1,1)-pizda(2,2)
6019 vv(2)=pizda(1,2)+pizda(2,1)
6021 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6022 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6023 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6025 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6026 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6027 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6029 C Cartesian gradient
6033 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6035 vv(1)=pizda(1,1)-pizda(2,2)
6036 vv(2)=pizda(1,2)+pizda(2,1)
6037 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6038 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6039 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6046 C Contribution from graph II
6047 call transpose2(EE(1,1,itk),auxmat(1,1))
6048 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6049 vv(1)=pizda(1,1)+pizda(2,2)
6050 vv(2)=pizda(2,1)-pizda(1,2)
6051 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6052 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6054 C Explicit gradient in virtual-dihedral angles.
6055 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6056 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6057 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6058 vv(1)=pizda(1,1)+pizda(2,2)
6059 vv(2)=pizda(2,1)-pizda(1,2)
6061 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6062 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6063 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6065 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6066 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6067 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6069 C Cartesian gradient
6073 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6075 vv(1)=pizda(1,1)+pizda(2,2)
6076 vv(2)=pizda(2,1)-pizda(1,2)
6077 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6078 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6079 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6088 C Parallel orientation
6089 C Contribution from graph III
6090 call transpose2(EUg(1,1,l),auxmat(1,1))
6091 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6092 vv(1)=pizda(1,1)-pizda(2,2)
6093 vv(2)=pizda(1,2)+pizda(2,1)
6094 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6095 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6097 C Explicit gradient in virtual-dihedral angles.
6098 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6099 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6100 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6101 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6102 vv(1)=pizda(1,1)-pizda(2,2)
6103 vv(2)=pizda(1,2)+pizda(2,1)
6104 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6105 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6106 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6107 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6108 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6109 vv(1)=pizda(1,1)-pizda(2,2)
6110 vv(2)=pizda(1,2)+pizda(2,1)
6111 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6112 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6113 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6114 C Cartesian gradient
6118 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6120 vv(1)=pizda(1,1)-pizda(2,2)
6121 vv(2)=pizda(1,2)+pizda(2,1)
6122 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6123 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6124 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6130 C Contribution from graph IV
6132 call transpose2(EE(1,1,itl),auxmat(1,1))
6133 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6134 vv(1)=pizda(1,1)+pizda(2,2)
6135 vv(2)=pizda(2,1)-pizda(1,2)
6136 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6137 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6139 C Explicit gradient in virtual-dihedral angles.
6140 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6141 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6142 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6143 vv(1)=pizda(1,1)+pizda(2,2)
6144 vv(2)=pizda(2,1)-pizda(1,2)
6145 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6146 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6147 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6148 C Cartesian gradient
6152 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6154 vv(1)=pizda(1,1)+pizda(2,2)
6155 vv(2)=pizda(2,1)-pizda(1,2)
6156 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6157 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6158 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6164 C Antiparallel orientation
6165 C Contribution from graph III
6167 call transpose2(EUg(1,1,j),auxmat(1,1))
6168 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6169 vv(1)=pizda(1,1)-pizda(2,2)
6170 vv(2)=pizda(1,2)+pizda(2,1)
6171 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6172 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6174 C Explicit gradient in virtual-dihedral angles.
6175 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6176 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6177 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6178 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6179 vv(1)=pizda(1,1)-pizda(2,2)
6180 vv(2)=pizda(1,2)+pizda(2,1)
6181 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6182 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6183 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6184 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6185 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6186 vv(1)=pizda(1,1)-pizda(2,2)
6187 vv(2)=pizda(1,2)+pizda(2,1)
6188 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6189 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6190 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6191 C Cartesian gradient
6195 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6197 vv(1)=pizda(1,1)-pizda(2,2)
6198 vv(2)=pizda(1,2)+pizda(2,1)
6199 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6200 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6201 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6207 C Contribution from graph IV
6209 call transpose2(EE(1,1,itj),auxmat(1,1))
6210 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6211 vv(1)=pizda(1,1)+pizda(2,2)
6212 vv(2)=pizda(2,1)-pizda(1,2)
6213 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6214 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6216 C Explicit gradient in virtual-dihedral angles.
6217 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6218 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6219 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6220 vv(1)=pizda(1,1)+pizda(2,2)
6221 vv(2)=pizda(2,1)-pizda(1,2)
6222 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6223 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6224 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6225 C Cartesian gradient
6229 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6231 vv(1)=pizda(1,1)+pizda(2,2)
6232 vv(2)=pizda(2,1)-pizda(1,2)
6233 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6234 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6235 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6242 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6243 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6244 cd write (2,*) 'ijkl',i,j,k,l
6245 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6246 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6248 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6249 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6250 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6251 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6253 if (j.lt.nres-1) then
6260 if (l.lt.nres-1) then
6270 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6272 ggg1(ll)=eel5*g_contij(ll,1)
6273 ggg2(ll)=eel5*g_contij(ll,2)
6274 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6275 ghalf=0.5d0*ggg1(ll)
6277 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6278 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6279 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6280 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6281 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6282 ghalf=0.5d0*ggg2(ll)
6284 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6285 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6286 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6287 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6292 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6293 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6298 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6299 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6305 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6310 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6314 cd write (2,*) iii,g_corr5_loc(iii)
6318 cd write (2,*) 'ekont',ekont
6319 cd write (iout,*) 'eello5',ekont*eel5
6322 c--------------------------------------------------------------------------
6323 double precision function eello6(i,j,k,l,jj,kk)
6324 implicit real*8 (a-h,o-z)
6325 include 'DIMENSIONS'
6326 include 'sizesclu.dat'
6327 include 'COMMON.IOUNITS'
6328 include 'COMMON.CHAIN'
6329 include 'COMMON.DERIV'
6330 include 'COMMON.INTERACT'
6331 include 'COMMON.CONTACTS'
6332 include 'COMMON.TORSION'
6333 include 'COMMON.VAR'
6334 include 'COMMON.GEO'
6335 include 'COMMON.FFIELD'
6336 double precision ggg1(3),ggg2(3)
6337 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6342 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6350 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6351 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6355 derx(lll,kkk,iii)=0.0d0
6359 cd eij=facont_hb(jj,i)
6360 cd ekl=facont_hb(kk,k)
6366 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6367 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6368 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6369 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6370 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6371 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6373 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6374 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6375 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6376 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6377 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6378 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6382 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6384 C If turn contributions are considered, they will be handled separately.
6385 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6386 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6387 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6388 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6389 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6390 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6391 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6394 if (j.lt.nres-1) then
6401 if (l.lt.nres-1) then
6409 ggg1(ll)=eel6*g_contij(ll,1)
6410 ggg2(ll)=eel6*g_contij(ll,2)
6411 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6412 ghalf=0.5d0*ggg1(ll)
6414 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6415 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6416 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6417 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6418 ghalf=0.5d0*ggg2(ll)
6419 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6421 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6422 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6423 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6424 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6429 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6430 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6435 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6436 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6442 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6447 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6451 cd write (2,*) iii,g_corr6_loc(iii)
6455 cd write (2,*) 'ekont',ekont
6456 cd write (iout,*) 'eello6',ekont*eel6
6459 c--------------------------------------------------------------------------
6460 double precision function eello6_graph1(i,j,k,l,imat,swap)
6461 implicit real*8 (a-h,o-z)
6462 include 'DIMENSIONS'
6463 include 'sizesclu.dat'
6464 include 'COMMON.IOUNITS'
6465 include 'COMMON.CHAIN'
6466 include 'COMMON.DERIV'
6467 include 'COMMON.INTERACT'
6468 include 'COMMON.CONTACTS'
6469 include 'COMMON.TORSION'
6470 include 'COMMON.VAR'
6471 include 'COMMON.GEO'
6472 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6476 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6478 C Parallel Antiparallel C
6484 C \ j|/k\| / \ |/k\|l / C
6489 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6490 itk=itortyp(itype(k))
6491 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6492 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6493 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6494 call transpose2(EUgC(1,1,k),auxmat(1,1))
6495 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6496 vv1(1)=pizda1(1,1)-pizda1(2,2)
6497 vv1(2)=pizda1(1,2)+pizda1(2,1)
6498 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6499 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6500 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6501 s5=scalar2(vv(1),Dtobr2(1,i))
6502 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6503 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6504 if (.not. calc_grad) return
6505 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6506 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6507 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6508 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6509 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6510 & +scalar2(vv(1),Dtobr2der(1,i)))
6511 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6512 vv1(1)=pizda1(1,1)-pizda1(2,2)
6513 vv1(2)=pizda1(1,2)+pizda1(2,1)
6514 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6515 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6517 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6518 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6519 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6520 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6521 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6523 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6524 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6525 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6526 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6527 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6529 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6530 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6531 vv1(1)=pizda1(1,1)-pizda1(2,2)
6532 vv1(2)=pizda1(1,2)+pizda1(2,1)
6533 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6534 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6535 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6536 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6545 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6546 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6547 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6548 call transpose2(EUgC(1,1,k),auxmat(1,1))
6549 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6551 vv1(1)=pizda1(1,1)-pizda1(2,2)
6552 vv1(2)=pizda1(1,2)+pizda1(2,1)
6553 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6554 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6555 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6556 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6557 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6558 s5=scalar2(vv(1),Dtobr2(1,i))
6559 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6565 c----------------------------------------------------------------------------
6566 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6567 implicit real*8 (a-h,o-z)
6568 include 'DIMENSIONS'
6569 include 'sizesclu.dat'
6570 include 'COMMON.IOUNITS'
6571 include 'COMMON.CHAIN'
6572 include 'COMMON.DERIV'
6573 include 'COMMON.INTERACT'
6574 include 'COMMON.CONTACTS'
6575 include 'COMMON.TORSION'
6576 include 'COMMON.VAR'
6577 include 'COMMON.GEO'
6579 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6580 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6585 C Parallel Antiparallel C
6591 C \ j|/k\| \ |/k\|l C
6596 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6597 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6598 C AL 7/4/01 s1 would occur in the sixth-order moment,
6599 C but not in a cluster cumulant
6601 s1=dip(1,jj,i)*dip(1,kk,k)
6603 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6604 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6605 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6606 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6607 call transpose2(EUg(1,1,k),auxmat(1,1))
6608 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6609 vv(1)=pizda(1,1)-pizda(2,2)
6610 vv(2)=pizda(1,2)+pizda(2,1)
6611 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6612 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6614 eello6_graph2=-(s1+s2+s3+s4)
6616 eello6_graph2=-(s2+s3+s4)
6619 if (.not. calc_grad) return
6620 C Derivatives in gamma(i-1)
6623 s1=dipderg(1,jj,i)*dip(1,kk,k)
6625 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6626 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6627 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6628 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6630 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6632 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6634 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6636 C Derivatives in gamma(k-1)
6638 s1=dip(1,jj,i)*dipderg(1,kk,k)
6640 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6641 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6642 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6643 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6644 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6645 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6646 vv(1)=pizda(1,1)-pizda(2,2)
6647 vv(2)=pizda(1,2)+pizda(2,1)
6648 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6650 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6652 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6654 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6655 C Derivatives in gamma(j-1) or gamma(l-1)
6658 s1=dipderg(3,jj,i)*dip(1,kk,k)
6660 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6661 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6662 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6663 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6664 vv(1)=pizda(1,1)-pizda(2,2)
6665 vv(2)=pizda(1,2)+pizda(2,1)
6666 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6669 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6671 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6674 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6675 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6677 C Derivatives in gamma(l-1) or gamma(j-1)
6680 s1=dip(1,jj,i)*dipderg(3,kk,k)
6682 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6683 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6684 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6685 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6686 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6687 vv(1)=pizda(1,1)-pizda(2,2)
6688 vv(2)=pizda(1,2)+pizda(2,1)
6689 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6692 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6694 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6697 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6698 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6700 C Cartesian derivatives.
6702 write (2,*) 'In eello6_graph2'
6704 write (2,*) 'iii=',iii
6706 write (2,*) 'kkk=',kkk
6708 write (2,'(3(2f10.5),5x)')
6709 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6719 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6721 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6724 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6726 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6727 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6729 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6730 call transpose2(EUg(1,1,k),auxmat(1,1))
6731 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6733 vv(1)=pizda(1,1)-pizda(2,2)
6734 vv(2)=pizda(1,2)+pizda(2,1)
6735 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6736 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6738 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6743 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6745 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6752 c----------------------------------------------------------------------------
6753 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6754 implicit real*8 (a-h,o-z)
6755 include 'DIMENSIONS'
6756 include 'sizesclu.dat'
6757 include 'COMMON.IOUNITS'
6758 include 'COMMON.CHAIN'
6759 include 'COMMON.DERIV'
6760 include 'COMMON.INTERACT'
6761 include 'COMMON.CONTACTS'
6762 include 'COMMON.TORSION'
6763 include 'COMMON.VAR'
6764 include 'COMMON.GEO'
6765 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6769 C Parallel Antiparallel C
6775 C j|/k\| / |/k\|l / C
6780 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6782 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6783 C energy moment and not to the cluster cumulant.
6784 iti=itortyp(itype(i))
6785 c if (j.lt.nres-1) then
6786 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6787 itj1=itortyp(itype(j+1))
6791 itk=itortyp(itype(k))
6792 itk1=itortyp(itype(k+1))
6793 c if (l.lt.nres-1) then
6794 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6795 itl1=itortyp(itype(l+1))
6800 s1=dip(4,jj,i)*dip(4,kk,k)
6802 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6803 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6804 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6805 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6806 call transpose2(EE(1,1,itk),auxmat(1,1))
6807 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6808 vv(1)=pizda(1,1)+pizda(2,2)
6809 vv(2)=pizda(2,1)-pizda(1,2)
6810 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6811 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6813 eello6_graph3=-(s1+s2+s3+s4)
6815 eello6_graph3=-(s2+s3+s4)
6818 if (.not. calc_grad) return
6819 C Derivatives in gamma(k-1)
6820 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6821 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6822 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6823 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6824 C Derivatives in gamma(l-1)
6825 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6826 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6827 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6828 vv(1)=pizda(1,1)+pizda(2,2)
6829 vv(2)=pizda(2,1)-pizda(1,2)
6830 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6831 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6832 C Cartesian derivatives.
6838 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6840 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6843 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6845 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6846 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6848 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6849 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6851 vv(1)=pizda(1,1)+pizda(2,2)
6852 vv(2)=pizda(2,1)-pizda(1,2)
6853 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6855 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6857 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6860 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6862 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6864 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6870 c----------------------------------------------------------------------------
6871 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6872 implicit real*8 (a-h,o-z)
6873 include 'DIMENSIONS'
6874 include 'sizesclu.dat'
6875 include 'COMMON.IOUNITS'
6876 include 'COMMON.CHAIN'
6877 include 'COMMON.DERIV'
6878 include 'COMMON.INTERACT'
6879 include 'COMMON.CONTACTS'
6880 include 'COMMON.TORSION'
6881 include 'COMMON.VAR'
6882 include 'COMMON.GEO'
6883 include 'COMMON.FFIELD'
6884 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6885 & auxvec1(2),auxmat1(2,2)
6887 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6889 C Parallel Antiparallel C
6895 C \ j|/k\| \ |/k\|l C
6900 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6902 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6903 C energy moment and not to the cluster cumulant.
6904 cd write (2,*) 'eello_graph4: wturn6',wturn6
6905 iti=itortyp(itype(i))
6906 itj=itortyp(itype(j))
6907 c if (j.lt.nres-1) then
6908 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6909 itj1=itortyp(itype(j+1))
6913 itk=itortyp(itype(k))
6914 c if (k.lt.nres-1) then
6915 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6916 itk1=itortyp(itype(k+1))
6920 itl=itortyp(itype(l))
6921 if (l.lt.nres-1) then
6922 itl1=itortyp(itype(l+1))
6926 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6927 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6928 cd & ' itl',itl,' itl1',itl1
6931 s1=dip(3,jj,i)*dip(3,kk,k)
6933 s1=dip(2,jj,j)*dip(2,kk,l)
6936 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6937 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6939 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6940 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6942 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6943 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6945 call transpose2(EUg(1,1,k),auxmat(1,1))
6946 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6947 vv(1)=pizda(1,1)-pizda(2,2)
6948 vv(2)=pizda(2,1)+pizda(1,2)
6949 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6950 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6952 eello6_graph4=-(s1+s2+s3+s4)
6954 eello6_graph4=-(s2+s3+s4)
6956 if (.not. calc_grad) return
6957 C Derivatives in gamma(i-1)
6961 s1=dipderg(2,jj,i)*dip(3,kk,k)
6963 s1=dipderg(4,jj,j)*dip(2,kk,l)
6966 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6968 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6969 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6971 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6972 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6974 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6975 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6976 cd write (2,*) 'turn6 derivatives'
6978 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6980 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6984 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6986 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6990 C Derivatives in gamma(k-1)
6993 s1=dip(3,jj,i)*dipderg(2,kk,k)
6995 s1=dip(2,jj,j)*dipderg(4,kk,l)
6998 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6999 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7001 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7002 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7004 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7005 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7007 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7008 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7009 vv(1)=pizda(1,1)-pizda(2,2)
7010 vv(2)=pizda(2,1)+pizda(1,2)
7011 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7012 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7014 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7016 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7020 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7022 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7025 C Derivatives in gamma(j-1) or gamma(l-1)
7026 if (l.eq.j+1 .and. l.gt.1) then
7027 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7028 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7029 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7030 vv(1)=pizda(1,1)-pizda(2,2)
7031 vv(2)=pizda(2,1)+pizda(1,2)
7032 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7033 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7034 else if (j.gt.1) then
7035 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7036 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7037 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7038 vv(1)=pizda(1,1)-pizda(2,2)
7039 vv(2)=pizda(2,1)+pizda(1,2)
7040 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7041 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7042 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7044 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7047 C Cartesian derivatives.
7054 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7056 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7060 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7062 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7066 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7068 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7070 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7071 & b1(1,itj1),auxvec(1))
7072 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7074 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7075 & b1(1,itl1),auxvec(1))
7076 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7078 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7080 vv(1)=pizda(1,1)-pizda(2,2)
7081 vv(2)=pizda(2,1)+pizda(1,2)
7082 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7084 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7086 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7089 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7092 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7095 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7097 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7099 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7103 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7105 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7108 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7110 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7118 c----------------------------------------------------------------------------
7119 double precision function eello_turn6(i,jj,kk)
7120 implicit real*8 (a-h,o-z)
7121 include 'DIMENSIONS'
7122 include 'sizesclu.dat'
7123 include 'COMMON.IOUNITS'
7124 include 'COMMON.CHAIN'
7125 include 'COMMON.DERIV'
7126 include 'COMMON.INTERACT'
7127 include 'COMMON.CONTACTS'
7128 include 'COMMON.TORSION'
7129 include 'COMMON.VAR'
7130 include 'COMMON.GEO'
7131 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7132 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7134 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7135 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7136 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7137 C the respective energy moment and not to the cluster cumulant.
7142 iti=itortyp(itype(i))
7143 itk=itortyp(itype(k))
7144 itk1=itortyp(itype(k+1))
7145 itl=itortyp(itype(l))
7146 itj=itortyp(itype(j))
7147 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7148 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7149 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7154 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7156 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7160 derx_turn(lll,kkk,iii)=0.0d0
7167 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7169 cd write (2,*) 'eello6_5',eello6_5
7171 call transpose2(AEA(1,1,1),auxmat(1,1))
7172 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7173 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7174 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7178 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7179 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7180 s2 = scalar2(b1(1,itk),vtemp1(1))
7182 call transpose2(AEA(1,1,2),atemp(1,1))
7183 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7184 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7185 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7189 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7190 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7191 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7193 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7194 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7195 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7196 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7197 ss13 = scalar2(b1(1,itk),vtemp4(1))
7198 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7202 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7208 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7210 C Derivatives in gamma(i+2)
7212 call transpose2(AEA(1,1,1),auxmatd(1,1))
7213 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7214 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7215 call transpose2(AEAderg(1,1,2),atempd(1,1))
7216 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7217 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7221 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7222 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7223 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7229 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7230 C Derivatives in gamma(i+3)
7232 call transpose2(AEA(1,1,1),auxmatd(1,1))
7233 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7234 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7235 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7239 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7240 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7241 s2d = scalar2(b1(1,itk),vtemp1d(1))
7243 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7244 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7246 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7248 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7249 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7250 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7260 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7261 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7263 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7264 & -0.5d0*ekont*(s2d+s12d)
7266 C Derivatives in gamma(i+4)
7267 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7268 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7269 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7271 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7272 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7273 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7283 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7285 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7287 C Derivatives in gamma(i+5)
7289 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7290 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7291 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7295 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7296 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7297 s2d = scalar2(b1(1,itk),vtemp1d(1))
7299 call transpose2(AEA(1,1,2),atempd(1,1))
7300 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7301 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7305 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7306 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7308 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7309 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7310 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7320 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7321 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7323 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7324 & -0.5d0*ekont*(s2d+s12d)
7326 C Cartesian derivatives
7331 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7332 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7333 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7337 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7338 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7340 s2d = scalar2(b1(1,itk),vtemp1d(1))
7342 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7343 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7344 s8d = -(atempd(1,1)+atempd(2,2))*
7345 & scalar2(cc(1,1,itl),vtemp2(1))
7349 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7351 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7352 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7359 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7362 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7366 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7367 & - 0.5d0*(s8d+s12d)
7369 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7378 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7380 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7381 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7382 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7383 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7384 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7386 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7387 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7388 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7392 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7393 cd & 16*eel_turn6_num
7395 if (j.lt.nres-1) then
7402 if (l.lt.nres-1) then
7410 ggg1(ll)=eel_turn6*g_contij(ll,1)
7411 ggg2(ll)=eel_turn6*g_contij(ll,2)
7412 ghalf=0.5d0*ggg1(ll)
7414 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7415 & +ekont*derx_turn(ll,2,1)
7416 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7417 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7418 & +ekont*derx_turn(ll,4,1)
7419 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7420 ghalf=0.5d0*ggg2(ll)
7422 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7423 & +ekont*derx_turn(ll,2,2)
7424 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7425 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7426 & +ekont*derx_turn(ll,4,2)
7427 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7432 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7437 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7443 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7448 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7452 cd write (2,*) iii,g_corr6_loc(iii)
7455 eello_turn6=ekont*eel_turn6
7456 cd write (2,*) 'ekont',ekont
7457 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7460 crc-------------------------------------------------
7461 SUBROUTINE MATVEC2(A1,V1,V2)
7462 implicit real*8 (a-h,o-z)
7463 include 'DIMENSIONS'
7464 DIMENSION A1(2,2),V1(2),V2(2)
7468 c 3 VI=VI+A1(I,K)*V1(K)
7472 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7473 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7478 C---------------------------------------
7479 SUBROUTINE MATMAT2(A1,A2,A3)
7480 implicit real*8 (a-h,o-z)
7481 include 'DIMENSIONS'
7482 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7483 c DIMENSION AI3(2,2)
7487 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7493 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7494 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7495 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7496 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7504 c-------------------------------------------------------------------------
7505 double precision function scalar2(u,v)
7507 double precision u(2),v(2)
7510 scalar2=u(1)*v(1)+u(2)*v(2)
7514 C-----------------------------------------------------------------------------
7516 subroutine transpose2(a,at)
7518 double precision a(2,2),at(2,2)
7525 c--------------------------------------------------------------------------
7526 subroutine transpose(n,a,at)
7529 double precision a(n,n),at(n,n)
7537 C---------------------------------------------------------------------------
7538 subroutine prodmat3(a1,a2,kk,transp,prod)
7541 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7543 crc double precision auxmat(2,2),prod_(2,2)
7546 crc call transpose2(kk(1,1),auxmat(1,1))
7547 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7548 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7550 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7551 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7552 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7553 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7554 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7555 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7556 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7557 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7560 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7561 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7563 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7564 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7565 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7566 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7567 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7568 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7569 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7570 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7573 c call transpose2(a2(1,1),a2t(1,1))
7576 crc print *,((prod_(i,j),i=1,2),j=1,2)
7577 crc print *,((prod(i,j),i=1,2),j=1,2)
7581 C-----------------------------------------------------------------------------
7582 double precision function scalar(u,v)
7584 double precision u(3),v(3)