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+nss*ebr+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+nss*ebr+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
127 c call enerprint(energia(0),frac)
129 energia(2)=evdw2-evdw2_14
146 energia(8)=eello_turn3
147 energia(9)=eello_turn4
156 energia(20)=edihcnstr
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'sizesclu.dat'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'sizesclu.dat'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
367 if (itypi.eq.ntyp1) cycle
368 itypi1=iabs(itype(i+1))
375 C Calculate SC interaction energy.
378 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
379 cd & 'iend=',iend(i,iint)
380 do j=istart(i,iint),iend(i,iint)
382 if (itypj.eq.ntyp1) cycle
386 C Change 12/1/95 to calculate four-body interactions
387 rij=xj*xj+yj*yj+zj*zj
389 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
390 eps0ij=eps(itypi,itypj)
392 e1=fac*fac*aa(itypi,itypj)
393 e2=fac*bb(itypi,itypj)
395 ij=icant(itypi,itypj)
396 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
397 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
398 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
399 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
400 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
401 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
402 if (bb(itypi,itypj).gt.0.0d0) then
409 C Calculate the components of the gradient in DC and X
411 fac=-rrij*(e1+evdwij)
416 gvdwx(k,i)=gvdwx(k,i)-gg(k)
417 gvdwx(k,j)=gvdwx(k,j)+gg(k)
421 gvdwc(l,k)=gvdwc(l,k)+gg(l)
426 C 12/1/95, revised on 5/20/97
428 C Calculate the contact function. The ith column of the array JCONT will
429 C contain the numbers of atoms that make contacts with the atom I (of numbers
430 C greater than I). The arrays FACONT and GACONT will contain the values of
431 C the contact function and its derivative.
433 C Uncomment next line, if the correlation interactions include EVDW explicitly.
434 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
435 C Uncomment next line, if the correlation interactions are contact function only
436 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
438 sigij=sigma(itypi,itypj)
439 r0ij=rs0(itypi,itypj)
441 C Check whether the SC's are not too far to make a contact.
444 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
445 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
447 if (fcont.gt.0.0D0) then
448 C If the SC-SC distance if close to sigma, apply spline.
449 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
450 cAdam & fcont1,fprimcont1)
451 cAdam fcont1=1.0d0-fcont1
452 cAdam if (fcont1.gt.0.0d0) then
453 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
454 cAdam fcont=fcont*fcont1
456 C Uncomment following 4 lines to have the geometric average of the epsilon0's
457 cga eps0ij=1.0d0/dsqrt(eps0ij)
459 cga gg(k)=gg(k)*eps0ij
461 cga eps0ij=-evdwij*eps0ij
462 C Uncomment for AL's type of SC correlation interactions.
464 num_conti=num_conti+1
466 facont(num_conti,i)=fcont*eps0ij
467 fprimcont=eps0ij*fprimcont/rij
469 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
470 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
471 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
472 C Uncomment following 3 lines for Skolnick's type of SC correlation.
473 gacont(1,num_conti,i)=-fprimcont*xj
474 gacont(2,num_conti,i)=-fprimcont*yj
475 gacont(3,num_conti,i)=-fprimcont*zj
476 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
477 cd write (iout,'(2i3,3f10.5)')
478 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
484 num_cont(i)=num_conti
489 gvdwc(j,i)=expon*gvdwc(j,i)
490 gvdwx(j,i)=expon*gvdwx(j,i)
494 C******************************************************************************
498 C To save time, the factor of EXPON has been extracted from ALL components
499 C of GVDWC and GRADX. Remember to multiply them by this factor before further
502 C******************************************************************************
505 C-----------------------------------------------------------------------------
506 subroutine eljk(evdw,evdw_t)
508 C This subroutine calculates the interaction energy of nonbonded side chains
509 C assuming the LJK potential of interaction.
511 implicit real*8 (a-h,o-z)
513 include 'sizesclu.dat'
514 include "DIMENSIONS.COMPAR"
517 include 'COMMON.LOCAL'
518 include 'COMMON.CHAIN'
519 include 'COMMON.DERIV'
520 include 'COMMON.INTERACT'
521 include 'COMMON.IOUNITS'
522 include 'COMMON.NAMES'
527 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
532 if (itypi.eq.ntyp1) cycle
533 itypi1=iabs(itype(i+1))
538 C Calculate SC interaction energy.
541 do j=istart(i,iint),iend(i,iint)
543 if (itypj.eq.ntyp1) cycle
547 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
549 e_augm=augm(itypi,itypj)*fac_augm
552 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
553 fac=r_shift_inv**expon
554 e1=fac*fac*aa(itypi,itypj)
555 e2=fac*bb(itypi,itypj)
557 ij=icant(itypi,itypj)
558 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
559 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
560 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
561 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
562 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
563 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
564 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
565 if (bb(itypi,itypj).gt.0.0d0) then
572 C Calculate the components of the gradient in DC and X
574 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
579 gvdwx(k,i)=gvdwx(k,i)-gg(k)
580 gvdwx(k,j)=gvdwx(k,j)+gg(k)
584 gvdwc(l,k)=gvdwc(l,k)+gg(l)
594 gvdwc(j,i)=expon*gvdwc(j,i)
595 gvdwx(j,i)=expon*gvdwx(j,i)
601 C-----------------------------------------------------------------------------
602 subroutine ebp(evdw,evdw_t)
604 C This subroutine calculates the interaction energy of nonbonded side chains
605 C assuming the Berne-Pechukas potential of interaction.
607 implicit real*8 (a-h,o-z)
609 include 'sizesclu.dat'
610 include "DIMENSIONS.COMPAR"
613 include 'COMMON.LOCAL'
614 include 'COMMON.CHAIN'
615 include 'COMMON.DERIV'
616 include 'COMMON.NAMES'
617 include 'COMMON.INTERACT'
618 include 'COMMON.IOUNITS'
619 include 'COMMON.CALC'
621 c double precision rrsave(maxdim)
627 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
628 c if (icall.eq.0) then
636 if (itypi.eq.ntyp1) cycle
637 itypi1=iabs(itype(i+1))
641 dxi=dc_norm(1,nres+i)
642 dyi=dc_norm(2,nres+i)
643 dzi=dc_norm(3,nres+i)
644 dsci_inv=vbld_inv(i+nres)
646 C Calculate SC interaction energy.
649 do j=istart(i,iint),iend(i,iint)
652 if (itypj.eq.ntyp1) cycle
653 dscj_inv=vbld_inv(j+nres)
654 chi1=chi(itypi,itypj)
655 chi2=chi(itypj,itypi)
662 alf12=0.5D0*(alf1+alf2)
663 C For diagnostics only!!!
676 dxj=dc_norm(1,nres+j)
677 dyj=dc_norm(2,nres+j)
678 dzj=dc_norm(3,nres+j)
679 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
680 cd if (icall.eq.0) then
686 C Calculate the angle-dependent terms of energy & contributions to derivatives.
688 C Calculate whole angle-dependent part of epsilon and contributions
690 fac=(rrij*sigsq)**expon2
691 e1=fac*fac*aa(itypi,itypj)
692 e2=fac*bb(itypi,itypj)
693 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
694 eps2der=evdwij*eps3rt
695 eps3der=evdwij*eps2rt
696 evdwij=evdwij*eps2rt*eps3rt
697 ij=icant(itypi,itypj)
698 aux=eps1*eps2rt**2*eps3rt**2
699 if (bb(itypi,itypj).gt.0.0d0) then
706 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
707 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
708 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
709 cd & restyp(itypi),i,restyp(itypj),j,
710 cd & epsi,sigm,chi1,chi2,chip1,chip2,
711 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
712 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
715 C Calculate gradient components.
716 e1=e1*eps1*eps2rt**2*eps3rt**2
717 fac=-expon*(e1+evdwij)
720 C Calculate radial part of the gradient
724 C Calculate the angular part of the gradient and sum add the contributions
725 C to the appropriate components of the Cartesian gradient.
734 C-----------------------------------------------------------------------------
735 subroutine egb(evdw,evdw_t)
737 C This subroutine calculates the interaction energy of nonbonded side chains
738 C assuming the Gay-Berne potential of interaction.
740 implicit real*8 (a-h,o-z)
742 include 'sizesclu.dat'
743 include "DIMENSIONS.COMPAR"
746 include 'COMMON.LOCAL'
747 include 'COMMON.CHAIN'
748 include 'COMMON.DERIV'
749 include 'COMMON.NAMES'
750 include 'COMMON.INTERACT'
751 include 'COMMON.IOUNITS'
752 include 'COMMON.CALC'
757 integer xshift,yshift,zshift
758 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
762 c if (icall.gt.0) lprn=.true.
766 if (itypi.eq.ntyp1) cycle
767 itypi1=iabs(itype(i+1))
772 if (xi.lt.0) xi=xi+boxxsize
774 if (yi.lt.0) yi=yi+boxysize
776 if (zi.lt.0) zi=zi+boxzsize
777 dxi=dc_norm(1,nres+i)
778 dyi=dc_norm(2,nres+i)
779 dzi=dc_norm(3,nres+i)
780 dsci_inv=vbld_inv(i+nres)
782 C Calculate SC interaction energy.
785 do j=istart(i,iint),iend(i,iint)
788 if (itypj.eq.ntyp1) cycle
789 dscj_inv=vbld_inv(j+nres)
790 sig0ij=sigma(itypi,itypj)
791 chi1=chi(itypi,itypj)
792 chi2=chi(itypj,itypi)
799 alf12=0.5D0*(alf1+alf2)
800 C For diagnostics only!!!
814 if (xj.lt.0) xj=xj+boxxsize
816 if (yj.lt.0) yj=yj+boxysize
818 if (zj.lt.0) zj=zj+boxzsize
819 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
827 xj=xj_safe+xshift*boxxsize
828 yj=yj_safe+yshift*boxysize
829 zj=zj_safe+zshift*boxzsize
830 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
831 if(dist_temp.lt.dist_init) then
841 if (subchap.eq.1) then
850 dxj=dc_norm(1,nres+j)
851 dyj=dc_norm(2,nres+j)
852 dzj=dc_norm(3,nres+j)
853 c write (iout,*) i,j,xj,yj,zj
854 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
856 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
857 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
858 if (sss.le.0.0d0) cycle
859 C Calculate angle-dependent terms of energy and contributions to their
863 sig=sig0ij*dsqrt(sigsq)
864 rij_shift=1.0D0/rij-sig+sig0ij
865 C I hate to put IF's in the loops, but here don't have another choice!!!!
866 if (rij_shift.le.0.0D0) then
871 c---------------------------------------------------------------
872 rij_shift=1.0D0/rij_shift
874 e1=fac*fac*aa(itypi,itypj)
875 e2=fac*bb(itypi,itypj)
876 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
877 eps2der=evdwij*eps3rt
878 eps3der=evdwij*eps2rt
879 evdwij=evdwij*eps2rt*eps3rt
880 if (bb(itypi,itypj).gt.0) then
883 evdw_t=evdw_t+evdwij*sss
885 ij=icant(itypi,itypj)
886 aux=eps1*eps2rt**2*eps3rt**2
887 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
888 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
889 c & aux*e2/eps(itypi,itypj)
891 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
892 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
893 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
894 c & restyp(itypi),i,restyp(itypj),j,
895 c & epsi,sigm,chi1,chi2,chip1,chip2,
896 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
897 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
899 c write (iout,*) "pratial sum", evdw,evdw_t
902 C Calculate gradient components.
903 e1=e1*eps1*eps2rt**2*eps3rt**2
904 fac=-expon*(e1+evdwij)*rij_shift
907 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
908 C Calculate the radial part of the gradient
912 C Calculate angular part of the gradient.
920 C-----------------------------------------------------------------------------
921 subroutine egbv(evdw,evdw_t)
923 C This subroutine calculates the interaction energy of nonbonded side chains
924 C assuming the Gay-Berne-Vorobjev potential of interaction.
926 implicit real*8 (a-h,o-z)
928 include 'sizesclu.dat'
929 include "DIMENSIONS.COMPAR"
932 include 'COMMON.LOCAL'
933 include 'COMMON.CHAIN'
934 include 'COMMON.DERIV'
935 include 'COMMON.NAMES'
936 include 'COMMON.INTERACT'
937 include 'COMMON.IOUNITS'
938 include 'COMMON.CALC'
945 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
948 c if (icall.gt.0) lprn=.true.
952 if (itypi.eq.ntyp1) cycle
953 itypi1=iabs(itype(i+1))
957 dxi=dc_norm(1,nres+i)
958 dyi=dc_norm(2,nres+i)
959 dzi=dc_norm(3,nres+i)
960 dsci_inv=vbld_inv(i+nres)
962 C Calculate SC interaction energy.
965 do j=istart(i,iint),iend(i,iint)
968 if (itypj.eq.ntyp1) cycle
969 dscj_inv=vbld_inv(j+nres)
970 sig0ij=sigma(itypi,itypj)
972 chi1=chi(itypi,itypj)
973 chi2=chi(itypj,itypi)
980 alf12=0.5D0*(alf1+alf2)
981 C For diagnostics only!!!
994 dxj=dc_norm(1,nres+j)
995 dyj=dc_norm(2,nres+j)
996 dzj=dc_norm(3,nres+j)
997 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
999 C Calculate angle-dependent terms of energy and contributions to their
1003 sig=sig0ij*dsqrt(sigsq)
1004 rij_shift=1.0D0/rij-sig+r0ij
1005 C I hate to put IF's in the loops, but here don't have another choice!!!!
1006 if (rij_shift.le.0.0D0) then
1011 c---------------------------------------------------------------
1012 rij_shift=1.0D0/rij_shift
1013 fac=rij_shift**expon
1014 e1=fac*fac*aa(itypi,itypj)
1015 e2=fac*bb(itypi,itypj)
1016 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1017 eps2der=evdwij*eps3rt
1018 eps3der=evdwij*eps2rt
1019 fac_augm=rrij**expon
1020 e_augm=augm(itypi,itypj)*fac_augm
1021 evdwij=evdwij*eps2rt*eps3rt
1022 if (bb(itypi,itypj).gt.0.0d0) then
1023 evdw=evdw+evdwij+e_augm
1025 evdw_t=evdw_t+evdwij+e_augm
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1030 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1031 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1032 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1033 c & restyp(itypi),i,restyp(itypj),j,
1034 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1035 c & chi1,chi2,chip1,chip2,
1036 c & eps1,eps2rt**2,eps3rt**2,
1037 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1041 C Calculate gradient components.
1042 e1=e1*eps1*eps2rt**2*eps3rt**2
1043 fac=-expon*(e1+evdwij)*rij_shift
1045 fac=rij*fac-2*expon*rrij*e_augm
1046 C Calculate the radial part of the gradient
1050 C Calculate angular part of the gradient.
1058 C-----------------------------------------------------------------------------
1059 subroutine sc_angular
1060 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1061 C om12. Called by ebp, egb, and egbv.
1063 include 'COMMON.CALC'
1067 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1068 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1069 om12=dxi*dxj+dyi*dyj+dzi*dzj
1071 C Calculate eps1(om12) and its derivative in om12
1072 faceps1=1.0D0-om12*chiom12
1073 faceps1_inv=1.0D0/faceps1
1074 eps1=dsqrt(faceps1_inv)
1075 C Following variable is eps1*deps1/dom12
1076 eps1_om12=faceps1_inv*chiom12
1077 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1082 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1083 sigsq=1.0D0-facsig*faceps1_inv
1084 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1085 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1086 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1087 C Calculate eps2 and its derivatives in om1, om2, and om12.
1090 chipom12=chip12*om12
1091 facp=1.0D0-om12*chipom12
1093 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1094 C Following variable is the square root of eps2
1095 eps2rt=1.0D0-facp1*facp_inv
1096 C Following three variables are the derivatives of the square root of eps
1097 C in om1, om2, and om12.
1098 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1099 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1100 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1101 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1102 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1103 C Calculate whole angle-dependent part of epsilon and contributions
1104 C to its derivatives
1107 C----------------------------------------------------------------------------
1109 implicit real*8 (a-h,o-z)
1110 include 'DIMENSIONS'
1111 include 'sizesclu.dat'
1112 include 'COMMON.CHAIN'
1113 include 'COMMON.DERIV'
1114 include 'COMMON.CALC'
1115 double precision dcosom1(3),dcosom2(3)
1116 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1117 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1118 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1119 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1121 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1122 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1125 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1128 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1129 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1130 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1131 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1132 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1133 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1136 C Calculate the components of the gradient in DC and X
1140 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1145 c------------------------------------------------------------------------------
1146 subroutine vec_and_deriv
1147 implicit real*8 (a-h,o-z)
1148 include 'DIMENSIONS'
1149 include 'sizesclu.dat'
1150 include 'COMMON.IOUNITS'
1151 include 'COMMON.GEO'
1152 include 'COMMON.VAR'
1153 include 'COMMON.LOCAL'
1154 include 'COMMON.CHAIN'
1155 include 'COMMON.VECTORS'
1156 include 'COMMON.DERIV'
1157 include 'COMMON.INTERACT'
1158 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1159 C Compute the local reference systems. For reference system (i), the
1160 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1161 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1163 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1164 if (i.eq.nres-1) then
1165 C Case of the last full residue
1166 C Compute the Z-axis
1167 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1168 costh=dcos(pi-theta(nres))
1169 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1174 C Compute the derivatives of uz
1176 uzder(2,1,1)=-dc_norm(3,i-1)
1177 uzder(3,1,1)= dc_norm(2,i-1)
1178 uzder(1,2,1)= dc_norm(3,i-1)
1180 uzder(3,2,1)=-dc_norm(1,i-1)
1181 uzder(1,3,1)=-dc_norm(2,i-1)
1182 uzder(2,3,1)= dc_norm(1,i-1)
1185 uzder(2,1,2)= dc_norm(3,i)
1186 uzder(3,1,2)=-dc_norm(2,i)
1187 uzder(1,2,2)=-dc_norm(3,i)
1189 uzder(3,2,2)= dc_norm(1,i)
1190 uzder(1,3,2)= dc_norm(2,i)
1191 uzder(2,3,2)=-dc_norm(1,i)
1194 C Compute the Y-axis
1197 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1200 C Compute the derivatives of uy
1203 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1204 & -dc_norm(k,i)*dc_norm(j,i-1)
1205 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1207 uyder(j,j,1)=uyder(j,j,1)-costh
1208 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1213 uygrad(l,k,j,i)=uyder(l,k,j)
1214 uzgrad(l,k,j,i)=uzder(l,k,j)
1218 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1219 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1220 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1221 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1225 C Compute the Z-axis
1226 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1227 costh=dcos(pi-theta(i+2))
1228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1233 C Compute the derivatives of uz
1235 uzder(2,1,1)=-dc_norm(3,i+1)
1236 uzder(3,1,1)= dc_norm(2,i+1)
1237 uzder(1,2,1)= dc_norm(3,i+1)
1239 uzder(3,2,1)=-dc_norm(1,i+1)
1240 uzder(1,3,1)=-dc_norm(2,i+1)
1241 uzder(2,3,1)= dc_norm(1,i+1)
1244 uzder(2,1,2)= dc_norm(3,i)
1245 uzder(3,1,2)=-dc_norm(2,i)
1246 uzder(1,2,2)=-dc_norm(3,i)
1248 uzder(3,2,2)= dc_norm(1,i)
1249 uzder(1,3,2)= dc_norm(2,i)
1250 uzder(2,3,2)=-dc_norm(1,i)
1253 C Compute the Y-axis
1256 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1259 C Compute the derivatives of uy
1262 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1263 & -dc_norm(k,i)*dc_norm(j,i+1)
1264 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1266 uyder(j,j,1)=uyder(j,j,1)-costh
1267 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1272 uygrad(l,k,j,i)=uyder(l,k,j)
1273 uzgrad(l,k,j,i)=uzder(l,k,j)
1277 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1278 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1279 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1280 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1286 vbld_inv_temp(1)=vbld_inv(i+1)
1287 if (i.lt.nres-1) then
1288 vbld_inv_temp(2)=vbld_inv(i+2)
1290 vbld_inv_temp(2)=vbld_inv(i)
1295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1304 C-----------------------------------------------------------------------------
1305 subroutine vec_and_deriv_test
1306 implicit real*8 (a-h,o-z)
1307 include 'DIMENSIONS'
1308 include 'sizesclu.dat'
1309 include 'COMMON.IOUNITS'
1310 include 'COMMON.GEO'
1311 include 'COMMON.VAR'
1312 include 'COMMON.LOCAL'
1313 include 'COMMON.CHAIN'
1314 include 'COMMON.VECTORS'
1315 dimension uyder(3,3,2),uzder(3,3,2)
1316 C Compute the local reference systems. For reference system (i), the
1317 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1318 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1320 if (i.eq.nres-1) then
1321 C Case of the last full residue
1322 C Compute the Z-axis
1323 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1324 costh=dcos(pi-theta(nres))
1325 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1326 c write (iout,*) 'fac',fac,
1327 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1328 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1332 C Compute the derivatives of uz
1334 uzder(2,1,1)=-dc_norm(3,i-1)
1335 uzder(3,1,1)= dc_norm(2,i-1)
1336 uzder(1,2,1)= dc_norm(3,i-1)
1338 uzder(3,2,1)=-dc_norm(1,i-1)
1339 uzder(1,3,1)=-dc_norm(2,i-1)
1340 uzder(2,3,1)= dc_norm(1,i-1)
1343 uzder(2,1,2)= dc_norm(3,i)
1344 uzder(3,1,2)=-dc_norm(2,i)
1345 uzder(1,2,2)=-dc_norm(3,i)
1347 uzder(3,2,2)= dc_norm(1,i)
1348 uzder(1,3,2)= dc_norm(2,i)
1349 uzder(2,3,2)=-dc_norm(1,i)
1351 C Compute the Y-axis
1353 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1356 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1357 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1358 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1360 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1363 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1364 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1367 c write (iout,*) 'facy',facy,
1368 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1369 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1371 uy(k,i)=facy*uy(k,i)
1373 C Compute the derivatives of uy
1376 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1377 & -dc_norm(k,i)*dc_norm(j,i-1)
1378 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1380 c uyder(j,j,1)=uyder(j,j,1)-costh
1381 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1382 uyder(j,j,1)=uyder(j,j,1)
1383 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1384 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1390 uygrad(l,k,j,i)=uyder(l,k,j)
1391 uzgrad(l,k,j,i)=uzder(l,k,j)
1395 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1396 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1397 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1398 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1401 C Compute the Z-axis
1402 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1403 costh=dcos(pi-theta(i+2))
1404 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1405 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1409 C Compute the derivatives of uz
1411 uzder(2,1,1)=-dc_norm(3,i+1)
1412 uzder(3,1,1)= dc_norm(2,i+1)
1413 uzder(1,2,1)= dc_norm(3,i+1)
1415 uzder(3,2,1)=-dc_norm(1,i+1)
1416 uzder(1,3,1)=-dc_norm(2,i+1)
1417 uzder(2,3,1)= dc_norm(1,i+1)
1420 uzder(2,1,2)= dc_norm(3,i)
1421 uzder(3,1,2)=-dc_norm(2,i)
1422 uzder(1,2,2)=-dc_norm(3,i)
1424 uzder(3,2,2)= dc_norm(1,i)
1425 uzder(1,3,2)= dc_norm(2,i)
1426 uzder(2,3,2)=-dc_norm(1,i)
1428 C Compute the Y-axis
1430 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1431 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1432 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1434 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1437 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1438 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1441 c write (iout,*) 'facy',facy,
1442 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1443 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1445 uy(k,i)=facy*uy(k,i)
1447 C Compute the derivatives of uy
1450 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1451 & -dc_norm(k,i)*dc_norm(j,i+1)
1452 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1454 c uyder(j,j,1)=uyder(j,j,1)-costh
1455 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1456 uyder(j,j,1)=uyder(j,j,1)
1457 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1458 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1464 uygrad(l,k,j,i)=uyder(l,k,j)
1465 uzgrad(l,k,j,i)=uzder(l,k,j)
1469 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1470 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1471 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1472 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1479 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1480 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1487 C-----------------------------------------------------------------------------
1488 subroutine check_vecgrad
1489 implicit real*8 (a-h,o-z)
1490 include 'DIMENSIONS'
1491 include 'sizesclu.dat'
1492 include 'COMMON.IOUNITS'
1493 include 'COMMON.GEO'
1494 include 'COMMON.VAR'
1495 include 'COMMON.LOCAL'
1496 include 'COMMON.CHAIN'
1497 include 'COMMON.VECTORS'
1498 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1499 dimension uyt(3,maxres),uzt(3,maxres)
1500 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1501 double precision delta /1.0d-7/
1504 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1505 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1506 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1507 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1508 cd & (dc_norm(if90,i),if90=1,3)
1509 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1510 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1511 cd write(iout,'(a)')
1517 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1518 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1531 cd write (iout,*) 'i=',i
1533 erij(k)=dc_norm(k,i)
1537 dc_norm(k,i)=erij(k)
1539 dc_norm(j,i)=dc_norm(j,i)+delta
1540 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1542 c dc_norm(k,i)=dc_norm(k,i)/fac
1544 c write (iout,*) (dc_norm(k,i),k=1,3)
1545 c write (iout,*) (erij(k),k=1,3)
1548 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1549 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1550 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1551 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1553 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1554 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1555 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1558 dc_norm(k,i)=erij(k)
1561 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1562 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1563 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1564 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1565 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1566 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1567 cd write (iout,'(a)')
1572 C--------------------------------------------------------------------------
1573 subroutine set_matrices
1574 implicit real*8 (a-h,o-z)
1575 include 'DIMENSIONS'
1576 include 'sizesclu.dat'
1577 include 'COMMON.IOUNITS'
1578 include 'COMMON.GEO'
1579 include 'COMMON.VAR'
1580 include 'COMMON.LOCAL'
1581 include 'COMMON.CHAIN'
1582 include 'COMMON.DERIV'
1583 include 'COMMON.INTERACT'
1584 include 'COMMON.CONTACTS'
1585 include 'COMMON.TORSION'
1586 include 'COMMON.VECTORS'
1587 include 'COMMON.FFIELD'
1588 double precision auxvec(2),auxmat(2,2)
1590 C Compute the virtual-bond-torsional-angle dependent quantities needed
1591 C to calculate the el-loc multibody terms of various order.
1594 if (i .lt. nres+1) then
1631 if (i .gt. 3 .and. i .lt. nres+1) then
1632 obrot_der(1,i-2)=-sin1
1633 obrot_der(2,i-2)= cos1
1634 Ugder(1,1,i-2)= sin1
1635 Ugder(1,2,i-2)=-cos1
1636 Ugder(2,1,i-2)=-cos1
1637 Ugder(2,2,i-2)=-sin1
1640 obrot2_der(1,i-2)=-dwasin2
1641 obrot2_der(2,i-2)= dwacos2
1642 Ug2der(1,1,i-2)= dwasin2
1643 Ug2der(1,2,i-2)=-dwacos2
1644 Ug2der(2,1,i-2)=-dwacos2
1645 Ug2der(2,2,i-2)=-dwasin2
1647 obrot_der(1,i-2)=0.0d0
1648 obrot_der(2,i-2)=0.0d0
1649 Ugder(1,1,i-2)=0.0d0
1650 Ugder(1,2,i-2)=0.0d0
1651 Ugder(2,1,i-2)=0.0d0
1652 Ugder(2,2,i-2)=0.0d0
1653 obrot2_der(1,i-2)=0.0d0
1654 obrot2_der(2,i-2)=0.0d0
1655 Ug2der(1,1,i-2)=0.0d0
1656 Ug2der(1,2,i-2)=0.0d0
1657 Ug2der(2,1,i-2)=0.0d0
1658 Ug2der(2,2,i-2)=0.0d0
1660 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1661 if (itype(i-2).le.ntyp) then
1662 iti = itortyp(itype(i-2))
1669 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1670 if (itype(i-1).le.ntyp) then
1671 iti1 = itortyp(itype(i-1))
1678 cd write (iout,*) '*******i',i,' iti1',iti
1679 cd write (iout,*) 'b1',b1(:,iti)
1680 cd write (iout,*) 'b2',b2(:,iti)
1681 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1682 c print *,"itilde1 i iti iti1",i,iti,iti1
1683 if (i .gt. iatel_s+2) then
1684 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1685 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1686 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1687 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1688 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1689 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1690 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1700 DtUg2(l,k,i-2)=0.0d0
1704 c print *,"itilde2 i iti iti1",i,iti,iti1
1705 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1706 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1707 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1708 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1709 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1710 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1711 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1712 c print *,"itilde3 i iti iti1",i,iti,iti1
1714 muder(k,i-2)=Ub2der(k,i-2)
1716 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1717 if (itype(i-1).le.ntyp) then
1718 iti1 = itortyp(itype(i-1))
1726 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1728 C Vectors and matrices dependent on a single virtual-bond dihedral.
1729 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1730 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1731 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1732 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1733 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1734 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1735 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1736 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1737 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1738 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1739 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1741 C Matrices dependent on two consecutive virtual-bond dihedrals.
1742 C The order of matrices is from left to right.
1744 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1745 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1746 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1747 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1748 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1749 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1750 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1751 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1754 cd iti = itortyp(itype(i))
1757 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1758 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1763 C--------------------------------------------------------------------------
1764 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1766 C This subroutine calculates the average interaction energy and its gradient
1767 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1768 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1769 C The potential depends both on the distance of peptide-group centers and on
1770 C the orientation of the CA-CA virtual bonds.
1772 implicit real*8 (a-h,o-z)
1773 include 'DIMENSIONS'
1774 include 'sizesclu.dat'
1775 include 'COMMON.CONTROL'
1776 include 'COMMON.IOUNITS'
1777 include 'COMMON.GEO'
1778 include 'COMMON.VAR'
1779 include 'COMMON.LOCAL'
1780 include 'COMMON.CHAIN'
1781 include 'COMMON.DERIV'
1782 include 'COMMON.INTERACT'
1783 include 'COMMON.CONTACTS'
1784 include 'COMMON.TORSION'
1785 include 'COMMON.VECTORS'
1786 include 'COMMON.FFIELD'
1787 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1788 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1789 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1790 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1791 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1792 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1793 double precision scal_el /0.5d0/
1795 C 13-go grudnia roku pamietnego...
1796 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1797 & 0.0d0,1.0d0,0.0d0,
1798 & 0.0d0,0.0d0,1.0d0/
1799 cd write(iout,*) 'In EELEC'
1801 cd write(iout,*) 'Type',i
1802 cd write(iout,*) 'B1',B1(:,i)
1803 cd write(iout,*) 'B2',B2(:,i)
1804 cd write(iout,*) 'CC',CC(:,:,i)
1805 cd write(iout,*) 'DD',DD(:,:,i)
1806 cd write(iout,*) 'EE',EE(:,:,i)
1808 cd call check_vecgrad
1810 if (icheckgrad.eq.1) then
1812 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1814 dc_norm(k,i)=dc(k,i)*fac
1816 c write (iout,*) 'i',i,' fac',fac
1819 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1820 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1821 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1822 cd if (wel_loc.gt.0.0d0) then
1823 if (icheckgrad.eq.1) then
1824 call vec_and_deriv_test
1831 cd write (iout,*) 'i=',i
1833 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1836 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1837 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1850 cd print '(a)','Enter EELEC'
1851 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1853 gel_loc_loc(i)=0.0d0
1856 do i=iatel_s,iatel_e
1858 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
1859 & .or. itype(i+2).eq.ntyp1) cycle
1861 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1862 & .or. itype(i+2).eq.ntyp1
1863 & .or. itype(i-1).eq.ntyp1
1866 if (itel(i).eq.0) goto 1215
1870 dx_normi=dc_norm(1,i)
1871 dy_normi=dc_norm(2,i)
1872 dz_normi=dc_norm(3,i)
1873 xmedi=c(1,i)+0.5d0*dxi
1874 ymedi=c(2,i)+0.5d0*dyi
1875 zmedi=c(3,i)+0.5d0*dzi
1876 xmedi=mod(xmedi,boxxsize)
1877 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1878 ymedi=mod(ymedi,boxysize)
1879 if (ymedi.lt.0) ymedi=ymedi+boxysize
1880 zmedi=mod(zmedi,boxzsize)
1881 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1883 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1884 do j=ielstart(i),ielend(i)
1886 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1887 & .or.itype(j+2).eq.ntyp1
1890 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1891 & .or.itype(j+2).eq.ntyp1
1892 & .or.itype(j-1).eq.ntyp1
1895 if (itel(j).eq.0) goto 1216
1899 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1900 aaa=app(iteli,itelj)
1901 bbb=bpp(iteli,itelj)
1902 C Diagnostics only!!!
1908 ael6i=ael6(iteli,itelj)
1909 ael3i=ael3(iteli,itelj)
1913 dx_normj=dc_norm(1,j)
1914 dy_normj=dc_norm(2,j)
1915 dz_normj=dc_norm(3,j)
1920 if (xj.lt.0) xj=xj+boxxsize
1922 if (yj.lt.0) yj=yj+boxysize
1924 if (zj.lt.0) zj=zj+boxzsize
1925 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1933 xj=xj_safe+xshift*boxxsize
1934 yj=yj_safe+yshift*boxysize
1935 zj=zj_safe+zshift*boxzsize
1936 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1937 if(dist_temp.lt.dist_init) then
1947 if (isubchap.eq.1) then
1957 rij=xj*xj+yj*yj+zj*zj
1958 sss=sscale(sqrt(rij))
1959 sssgrad=sscagrad(sqrt(rij))
1965 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1966 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1967 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1968 fac=cosa-3.0D0*cosb*cosg
1970 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1971 if (j.eq.i+2) ev1=scal_el*ev1
1976 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1979 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1980 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1981 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1983 evdw1=evdw1+evdwij*sss
1984 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1985 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1986 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1987 cd & xmedi,ymedi,zmedi,xj,yj,zj
1989 C Calculate contributions to the Cartesian gradient.
1992 facvdw=-6*rrmij*(ev1+evdwij)*sss
1993 facel=-3*rrmij*(el1+eesij)
2000 * Radial derivatives. First process both termini of the fragment (i,j)
2007 gelc(k,i)=gelc(k,i)+ghalf
2008 gelc(k,j)=gelc(k,j)+ghalf
2011 * Loop over residues i+1 thru j-1.
2015 gelc(l,k)=gelc(l,k)+ggg(l)
2021 if (sss.gt.0.0) then
2022 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2023 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2024 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2032 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2033 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2036 * Loop over residues i+1 thru j-1.
2040 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2044 facvdw=(ev1+evdwij)*sss
2047 fac=-3*rrmij*(facvdw+facvdw+facel)
2053 * Radial derivatives. First process both termini of the fragment (i,j)
2060 gelc(k,i)=gelc(k,i)+ghalf
2061 gelc(k,j)=gelc(k,j)+ghalf
2064 * Loop over residues i+1 thru j-1.
2068 gelc(l,k)=gelc(l,k)+ggg(l)
2075 ecosa=2.0D0*fac3*fac1+fac4
2078 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2079 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2081 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2082 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2084 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2085 cd & (dcosg(k),k=1,3)
2087 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2091 gelc(k,i)=gelc(k,i)+ghalf
2092 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2093 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2094 gelc(k,j)=gelc(k,j)+ghalf
2095 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2096 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2100 gelc(l,k)=gelc(l,k)+ggg(l)
2105 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2106 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2107 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2109 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2110 C energy of a peptide unit is assumed in the form of a second-order
2111 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2112 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2113 C are computed for EVERY pair of non-contiguous peptide groups.
2115 if (j.lt.nres-1) then
2126 muij(kkk)=mu(k,i)*mu(l,j)
2129 cd write (iout,*) 'EELEC: i',i,' j',j
2130 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2131 cd write(iout,*) 'muij',muij
2132 ury=scalar(uy(1,i),erij)
2133 urz=scalar(uz(1,i),erij)
2134 vry=scalar(uy(1,j),erij)
2135 vrz=scalar(uz(1,j),erij)
2136 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2137 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2138 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2139 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2140 C For diagnostics only
2145 fac=dsqrt(-ael6i)*r3ij
2146 cd write (2,*) 'fac=',fac
2147 C For diagnostics only
2153 cd write (iout,'(4i5,4f10.5)')
2154 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2155 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2156 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2157 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2158 cd write (iout,'(4f10.5)')
2159 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2160 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2161 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2162 cd write (iout,'(2i3,9f10.5/)') i,j,
2163 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2165 C Derivatives of the elements of A in virtual-bond vectors
2166 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2173 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2174 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2175 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2176 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2177 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2178 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2179 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2180 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2181 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2182 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2183 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2184 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2194 C Compute radial contributions to the gradient
2216 C Add the contributions coming from er
2219 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2220 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2221 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2222 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2225 C Derivatives in DC(i)
2226 ghalf1=0.5d0*agg(k,1)
2227 ghalf2=0.5d0*agg(k,2)
2228 ghalf3=0.5d0*agg(k,3)
2229 ghalf4=0.5d0*agg(k,4)
2230 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2231 & -3.0d0*uryg(k,2)*vry)+ghalf1
2232 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2233 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2234 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2235 & -3.0d0*urzg(k,2)*vry)+ghalf3
2236 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2237 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2238 C Derivatives in DC(i+1)
2239 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2240 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2241 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2242 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2243 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2244 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2245 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2246 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2247 C Derivatives in DC(j)
2248 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2249 & -3.0d0*vryg(k,2)*ury)+ghalf1
2250 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2251 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2252 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2253 & -3.0d0*vryg(k,2)*urz)+ghalf3
2254 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2255 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2256 C Derivatives in DC(j+1) or DC(nres-1)
2257 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2258 & -3.0d0*vryg(k,3)*ury)
2259 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2260 & -3.0d0*vrzg(k,3)*ury)
2261 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2262 & -3.0d0*vryg(k,3)*urz)
2263 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2264 & -3.0d0*vrzg(k,3)*urz)
2269 C Derivatives in DC(i+1)
2270 cd aggi1(k,1)=agg(k,1)
2271 cd aggi1(k,2)=agg(k,2)
2272 cd aggi1(k,3)=agg(k,3)
2273 cd aggi1(k,4)=agg(k,4)
2274 C Derivatives in DC(j)
2279 C Derivatives in DC(j+1)
2284 if (j.eq.nres-1 .and. i.lt.j-2) then
2286 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2287 cd aggj1(k,l)=agg(k,l)
2293 C Check the loc-el terms by numerical integration
2303 aggi(k,l)=-aggi(k,l)
2304 aggi1(k,l)=-aggi1(k,l)
2305 aggj(k,l)=-aggj(k,l)
2306 aggj1(k,l)=-aggj1(k,l)
2309 if (j.lt.nres-1) then
2315 aggi(k,l)=-aggi(k,l)
2316 aggi1(k,l)=-aggi1(k,l)
2317 aggj(k,l)=-aggj(k,l)
2318 aggj1(k,l)=-aggj1(k,l)
2329 aggi(k,l)=-aggi(k,l)
2330 aggi1(k,l)=-aggi1(k,l)
2331 aggj(k,l)=-aggj(k,l)
2332 aggj1(k,l)=-aggj1(k,l)
2338 IF (wel_loc.gt.0.0d0) THEN
2339 C Contribution to the local-electrostatic energy coming from the i-j pair
2340 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2342 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2343 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2344 eel_loc=eel_loc+eel_loc_ij
2345 C Partial derivatives in virtual-bond dihedral angles gamma
2348 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2349 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2350 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2351 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2352 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2353 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2354 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2355 cd write(iout,*) 'agg ',agg
2356 cd write(iout,*) 'aggi ',aggi
2357 cd write(iout,*) 'aggi1',aggi1
2358 cd write(iout,*) 'aggj ',aggj
2359 cd write(iout,*) 'aggj1',aggj1
2361 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2363 ggg(l)=agg(l,1)*muij(1)+
2364 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2368 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2371 C Remaining derivatives of eello
2373 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2374 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2375 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2376 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2377 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2378 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2379 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2380 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2384 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2385 C Contributions from turns
2390 call eturn34(i,j,eello_turn3,eello_turn4)
2392 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2393 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2395 C Calculate the contact function. The ith column of the array JCONT will
2396 C contain the numbers of atoms that make contacts with the atom I (of numbers
2397 C greater than I). The arrays FACONT and GACONT will contain the values of
2398 C the contact function and its derivative.
2399 c r0ij=1.02D0*rpp(iteli,itelj)
2400 c r0ij=1.11D0*rpp(iteli,itelj)
2401 r0ij=2.20D0*rpp(iteli,itelj)
2402 c r0ij=1.55D0*rpp(iteli,itelj)
2403 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2404 if (fcont.gt.0.0D0) then
2405 num_conti=num_conti+1
2406 if (num_conti.gt.maxconts) then
2407 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2408 & ' will skip next contacts for this conf.'
2410 jcont_hb(num_conti,i)=j
2411 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2412 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2413 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2415 d_cont(num_conti,i)=rij
2416 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2417 C --- Electrostatic-interaction matrix ---
2418 a_chuj(1,1,num_conti,i)=a22
2419 a_chuj(1,2,num_conti,i)=a23
2420 a_chuj(2,1,num_conti,i)=a32
2421 a_chuj(2,2,num_conti,i)=a33
2422 C --- Gradient of rij
2424 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2427 c a_chuj(1,1,num_conti,i)=-0.61d0
2428 c a_chuj(1,2,num_conti,i)= 0.4d0
2429 c a_chuj(2,1,num_conti,i)= 0.65d0
2430 c a_chuj(2,2,num_conti,i)= 0.50d0
2431 c else if (i.eq.2) then
2432 c a_chuj(1,1,num_conti,i)= 0.0d0
2433 c a_chuj(1,2,num_conti,i)= 0.0d0
2434 c a_chuj(2,1,num_conti,i)= 0.0d0
2435 c a_chuj(2,2,num_conti,i)= 0.0d0
2437 C --- and its gradients
2438 cd write (iout,*) 'i',i,' j',j
2440 cd write (iout,*) 'iii 1 kkk',kkk
2441 cd write (iout,*) agg(kkk,:)
2444 cd write (iout,*) 'iii 2 kkk',kkk
2445 cd write (iout,*) aggi(kkk,:)
2448 cd write (iout,*) 'iii 3 kkk',kkk
2449 cd write (iout,*) aggi1(kkk,:)
2452 cd write (iout,*) 'iii 4 kkk',kkk
2453 cd write (iout,*) aggj(kkk,:)
2456 cd write (iout,*) 'iii 5 kkk',kkk
2457 cd write (iout,*) aggj1(kkk,:)
2464 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2465 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2466 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2467 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2468 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2470 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2476 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2477 C Calculate contact energies
2479 wij=cosa-3.0D0*cosb*cosg
2482 c fac3=dsqrt(-ael6i)/r0ij**3
2483 fac3=dsqrt(-ael6i)*r3ij
2484 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2485 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2487 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2488 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2489 C Diagnostics. Comment out or remove after debugging!
2490 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2491 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2492 c ees0m(num_conti,i)=0.0D0
2494 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2495 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2496 facont_hb(num_conti,i)=fcont
2498 C Angular derivatives of the contact function
2499 ees0pij1=fac3/ees0pij
2500 ees0mij1=fac3/ees0mij
2501 fac3p=-3.0D0*fac3*rrmij
2502 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2503 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2505 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2506 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2507 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2508 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2509 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2510 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2511 ecosap=ecosa1+ecosa2
2512 ecosbp=ecosb1+ecosb2
2513 ecosgp=ecosg1+ecosg2
2514 ecosam=ecosa1-ecosa2
2515 ecosbm=ecosb1-ecosb2
2516 ecosgm=ecosg1-ecosg2
2525 fprimcont=fprimcont/rij
2526 cd facont_hb(num_conti,i)=1.0D0
2527 C Following line is for diagnostics.
2530 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2531 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2534 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2535 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2537 gggp(1)=gggp(1)+ees0pijp*xj
2538 gggp(2)=gggp(2)+ees0pijp*yj
2539 gggp(3)=gggp(3)+ees0pijp*zj
2540 gggm(1)=gggm(1)+ees0mijp*xj
2541 gggm(2)=gggm(2)+ees0mijp*yj
2542 gggm(3)=gggm(3)+ees0mijp*zj
2543 C Derivatives due to the contact function
2544 gacont_hbr(1,num_conti,i)=fprimcont*xj
2545 gacont_hbr(2,num_conti,i)=fprimcont*yj
2546 gacont_hbr(3,num_conti,i)=fprimcont*zj
2548 ghalfp=0.5D0*gggp(k)
2549 ghalfm=0.5D0*gggm(k)
2550 gacontp_hb1(k,num_conti,i)=ghalfp
2551 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2552 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2553 gacontp_hb2(k,num_conti,i)=ghalfp
2554 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2555 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2556 gacontp_hb3(k,num_conti,i)=gggp(k)
2557 gacontm_hb1(k,num_conti,i)=ghalfm
2558 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2559 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2560 gacontm_hb2(k,num_conti,i)=ghalfm
2561 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2562 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2563 gacontm_hb3(k,num_conti,i)=gggm(k)
2566 C Diagnostics. Comment out or remove after debugging!
2568 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2569 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2570 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2571 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2572 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2573 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2576 endif ! num_conti.le.maxconts
2581 num_cont_hb(i)=num_conti
2585 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2586 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2588 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2589 ccc eel_loc=eel_loc+eello_turn3
2592 C-----------------------------------------------------------------------------
2593 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2594 C Third- and fourth-order contributions from turns
2595 implicit real*8 (a-h,o-z)
2596 include 'DIMENSIONS'
2597 include 'sizesclu.dat'
2598 include 'COMMON.IOUNITS'
2599 include 'COMMON.GEO'
2600 include 'COMMON.VAR'
2601 include 'COMMON.LOCAL'
2602 include 'COMMON.CHAIN'
2603 include 'COMMON.DERIV'
2604 include 'COMMON.INTERACT'
2605 include 'COMMON.CONTACTS'
2606 include 'COMMON.TORSION'
2607 include 'COMMON.VECTORS'
2608 include 'COMMON.FFIELD'
2610 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2611 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2612 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2613 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2614 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2615 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2617 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2619 C Third-order contributions
2626 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2627 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2628 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2629 call transpose2(auxmat(1,1),auxmat1(1,1))
2630 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2631 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2632 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2633 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2634 cd & ' eello_turn3_num',4*eello_turn3_num
2636 C Derivatives in gamma(i)
2637 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2638 call transpose2(auxmat2(1,1),pizda(1,1))
2639 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2640 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2641 C Derivatives in gamma(i+1)
2642 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2643 call transpose2(auxmat2(1,1),pizda(1,1))
2644 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2645 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2646 & +0.5d0*(pizda(1,1)+pizda(2,2))
2647 C Cartesian derivatives
2649 a_temp(1,1)=aggi(l,1)
2650 a_temp(1,2)=aggi(l,2)
2651 a_temp(2,1)=aggi(l,3)
2652 a_temp(2,2)=aggi(l,4)
2653 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2654 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2655 & +0.5d0*(pizda(1,1)+pizda(2,2))
2656 a_temp(1,1)=aggi1(l,1)
2657 a_temp(1,2)=aggi1(l,2)
2658 a_temp(2,1)=aggi1(l,3)
2659 a_temp(2,2)=aggi1(l,4)
2660 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2661 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2662 & +0.5d0*(pizda(1,1)+pizda(2,2))
2663 a_temp(1,1)=aggj(l,1)
2664 a_temp(1,2)=aggj(l,2)
2665 a_temp(2,1)=aggj(l,3)
2666 a_temp(2,2)=aggj(l,4)
2667 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2668 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2669 & +0.5d0*(pizda(1,1)+pizda(2,2))
2670 a_temp(1,1)=aggj1(l,1)
2671 a_temp(1,2)=aggj1(l,2)
2672 a_temp(2,1)=aggj1(l,3)
2673 a_temp(2,2)=aggj1(l,4)
2674 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2675 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2676 & +0.5d0*(pizda(1,1)+pizda(2,2))
2679 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2680 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2682 C Fourth-order contributions
2690 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2691 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2692 iti1=itortyp(itype(i+1))
2693 iti2=itortyp(itype(i+2))
2694 iti3=itortyp(itype(i+3))
2695 call transpose2(EUg(1,1,i+1),e1t(1,1))
2696 call transpose2(Eug(1,1,i+2),e2t(1,1))
2697 call transpose2(Eug(1,1,i+3),e3t(1,1))
2698 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2699 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2700 s1=scalar2(b1(1,iti2),auxvec(1))
2701 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2702 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2703 s2=scalar2(b1(1,iti1),auxvec(1))
2704 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2705 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2706 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2707 eello_turn4=eello_turn4-(s1+s2+s3)
2708 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2709 cd & ' eello_turn4_num',8*eello_turn4_num
2710 C Derivatives in gamma(i)
2712 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2713 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2714 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2715 s1=scalar2(b1(1,iti2),auxvec(1))
2716 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2717 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2718 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2719 C Derivatives in gamma(i+1)
2720 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2721 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2722 s2=scalar2(b1(1,iti1),auxvec(1))
2723 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2724 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2725 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2726 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2727 C Derivatives in gamma(i+2)
2728 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2729 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2730 s1=scalar2(b1(1,iti2),auxvec(1))
2731 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2732 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2733 s2=scalar2(b1(1,iti1),auxvec(1))
2734 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2735 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2736 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2737 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2738 C Cartesian derivatives
2739 C Derivatives of this turn contributions in DC(i+2)
2740 if (j.lt.nres-1) then
2742 a_temp(1,1)=agg(l,1)
2743 a_temp(1,2)=agg(l,2)
2744 a_temp(2,1)=agg(l,3)
2745 a_temp(2,2)=agg(l,4)
2746 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2747 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2748 s1=scalar2(b1(1,iti2),auxvec(1))
2749 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2750 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2751 s2=scalar2(b1(1,iti1),auxvec(1))
2752 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2753 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2754 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2756 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2759 C Remaining derivatives of this turn contribution
2761 a_temp(1,1)=aggi(l,1)
2762 a_temp(1,2)=aggi(l,2)
2763 a_temp(2,1)=aggi(l,3)
2764 a_temp(2,2)=aggi(l,4)
2765 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2766 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2767 s1=scalar2(b1(1,iti2),auxvec(1))
2768 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2769 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2770 s2=scalar2(b1(1,iti1),auxvec(1))
2771 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2772 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2773 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2774 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2775 a_temp(1,1)=aggi1(l,1)
2776 a_temp(1,2)=aggi1(l,2)
2777 a_temp(2,1)=aggi1(l,3)
2778 a_temp(2,2)=aggi1(l,4)
2779 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2780 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2781 s1=scalar2(b1(1,iti2),auxvec(1))
2782 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2783 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2784 s2=scalar2(b1(1,iti1),auxvec(1))
2785 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2786 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2787 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2788 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2789 a_temp(1,1)=aggj(l,1)
2790 a_temp(1,2)=aggj(l,2)
2791 a_temp(2,1)=aggj(l,3)
2792 a_temp(2,2)=aggj(l,4)
2793 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2794 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2795 s1=scalar2(b1(1,iti2),auxvec(1))
2796 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2797 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2798 s2=scalar2(b1(1,iti1),auxvec(1))
2799 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2800 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2801 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2802 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2803 a_temp(1,1)=aggj1(l,1)
2804 a_temp(1,2)=aggj1(l,2)
2805 a_temp(2,1)=aggj1(l,3)
2806 a_temp(2,2)=aggj1(l,4)
2807 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2808 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2809 s1=scalar2(b1(1,iti2),auxvec(1))
2810 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2811 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2812 s2=scalar2(b1(1,iti1),auxvec(1))
2813 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2814 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2815 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2816 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2822 C-----------------------------------------------------------------------------
2823 subroutine vecpr(u,v,w)
2824 implicit real*8(a-h,o-z)
2825 dimension u(3),v(3),w(3)
2826 w(1)=u(2)*v(3)-u(3)*v(2)
2827 w(2)=-u(1)*v(3)+u(3)*v(1)
2828 w(3)=u(1)*v(2)-u(2)*v(1)
2831 C-----------------------------------------------------------------------------
2832 subroutine unormderiv(u,ugrad,unorm,ungrad)
2833 C This subroutine computes the derivatives of a normalized vector u, given
2834 C the derivatives computed without normalization conditions, ugrad. Returns
2837 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2838 double precision vec(3)
2839 double precision scalar
2841 c write (2,*) 'ugrad',ugrad
2844 vec(i)=scalar(ugrad(1,i),u(1))
2846 c write (2,*) 'vec',vec
2849 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2852 c write (2,*) 'ungrad',ungrad
2855 C-----------------------------------------------------------------------------
2856 subroutine escp(evdw2,evdw2_14)
2858 C This subroutine calculates the excluded-volume interaction energy between
2859 C peptide-group centers and side chains and its gradient in virtual-bond and
2860 C side-chain vectors.
2862 implicit real*8 (a-h,o-z)
2863 include 'DIMENSIONS'
2864 include 'sizesclu.dat'
2865 include 'COMMON.GEO'
2866 include 'COMMON.VAR'
2867 include 'COMMON.LOCAL'
2868 include 'COMMON.CHAIN'
2869 include 'COMMON.DERIV'
2870 include 'COMMON.INTERACT'
2871 include 'COMMON.FFIELD'
2872 include 'COMMON.IOUNITS'
2876 cd print '(a)','Enter ESCP'
2877 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2878 c & ' scal14',scal14
2879 do i=iatscp_s,iatscp_e
2880 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2882 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2883 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2884 if (iteli.eq.0) goto 1225
2885 xi=0.5D0*(c(1,i)+c(1,i+1))
2886 yi=0.5D0*(c(2,i)+c(2,i+1))
2887 zi=0.5D0*(c(3,i)+c(3,i+1))
2888 C Returning the ith atom to box
2890 if (xi.lt.0) xi=xi+boxxsize
2892 if (yi.lt.0) yi=yi+boxysize
2894 if (zi.lt.0) zi=zi+boxzsize
2896 do iint=1,nscp_gr(i)
2898 do j=iscpstart(i,iint),iscpend(i,iint)
2899 itypj=iabs(itype(j))
2900 if (itypj.eq.ntyp1) cycle
2901 C Uncomment following three lines for SC-p interactions
2905 C Uncomment following three lines for Ca-p interactions
2909 C returning the jth atom to box
2911 if (xj.lt.0) xj=xj+boxxsize
2913 if (yj.lt.0) yj=yj+boxysize
2915 if (zj.lt.0) zj=zj+boxzsize
2916 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2921 C Finding the closest jth atom
2925 xj=xj_safe+xshift*boxxsize
2926 yj=yj_safe+yshift*boxysize
2927 zj=zj_safe+zshift*boxzsize
2928 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2929 if(dist_temp.lt.dist_init) then
2939 if (subchap.eq.1) then
2949 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2950 C sss is scaling function for smoothing the cutoff gradient otherwise
2951 C the gradient would not be continuouse
2952 sss=sscale(1.0d0/(dsqrt(rrij)))
2953 if (sss.le.0.0d0) cycle
2954 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
2956 e1=fac*fac*aad(itypj,iteli)
2957 e2=fac*bad(itypj,iteli)
2958 if (iabs(j-i) .le. 2) then
2961 evdw2_14=evdw2_14+(e1+e2)*sss
2964 c write (iout,*) i,j,evdwij
2965 evdw2=evdw2+evdwij*sss
2968 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2970 fac=-(evdwij+e1)*rrij*sss
2971 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
2976 cd write (iout,*) 'j<i'
2977 C Uncomment following three lines for SC-p interactions
2979 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2982 cd write (iout,*) 'j>i'
2985 C Uncomment following line for SC-p interactions
2986 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2990 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2994 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2995 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2998 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3008 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3009 gradx_scp(j,i)=expon*gradx_scp(j,i)
3012 C******************************************************************************
3016 C To save time the factor EXPON has been extracted from ALL components
3017 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3020 C******************************************************************************
3023 C--------------------------------------------------------------------------
3024 subroutine edis(ehpb)
3026 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3028 implicit real*8 (a-h,o-z)
3029 include 'DIMENSIONS'
3030 include 'sizesclu.dat'
3031 include 'COMMON.SBRIDGE'
3032 include 'COMMON.CHAIN'
3033 include 'COMMON.DERIV'
3034 include 'COMMON.VAR'
3035 include 'COMMON.INTERACT'
3038 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3039 cd print *,'link_start=',link_start,' link_end=',link_end
3040 if (link_end.eq.0) return
3041 do i=link_start,link_end
3042 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3043 C CA-CA distance used in regularization of structure.
3046 C iii and jjj point to the residues for which the distance is assigned.
3047 if (ii.gt.nres) then
3054 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3055 C distance and angle dependent SS bond potential.
3056 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3057 & iabs(itype(jjj)).eq.1) then
3058 call ssbond_ene(iii,jjj,eij)
3061 C Calculate the distance between the two points and its difference from the
3065 C Get the force constant corresponding to this distance.
3067 C Calculate the contribution to energy.
3068 ehpb=ehpb+waga*rdis*rdis
3070 C Evaluate gradient.
3073 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3074 cd & ' waga=',waga,' fac=',fac
3076 ggg(j)=fac*(c(j,jj)-c(j,ii))
3078 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3079 C If this is a SC-SC distance, we need to calculate the contributions to the
3080 C Cartesian gradient in the SC vectors (ghpbx).
3083 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3084 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3089 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3097 C--------------------------------------------------------------------------
3098 subroutine ssbond_ene(i,j,eij)
3100 C Calculate the distance and angle dependent SS-bond potential energy
3101 C using a free-energy function derived based on RHF/6-31G** ab initio
3102 C calculations of diethyl disulfide.
3104 C A. Liwo and U. Kozlowska, 11/24/03
3106 implicit real*8 (a-h,o-z)
3107 include 'DIMENSIONS'
3108 include 'sizesclu.dat'
3109 include 'COMMON.SBRIDGE'
3110 include 'COMMON.CHAIN'
3111 include 'COMMON.DERIV'
3112 include 'COMMON.LOCAL'
3113 include 'COMMON.INTERACT'
3114 include 'COMMON.VAR'
3115 include 'COMMON.IOUNITS'
3116 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3117 itypi=iabs(itype(i))
3121 dxi=dc_norm(1,nres+i)
3122 dyi=dc_norm(2,nres+i)
3123 dzi=dc_norm(3,nres+i)
3124 dsci_inv=dsc_inv(itypi)
3125 itypj=iabs(itype(j))
3126 dscj_inv=dsc_inv(itypj)
3130 dxj=dc_norm(1,nres+j)
3131 dyj=dc_norm(2,nres+j)
3132 dzj=dc_norm(3,nres+j)
3133 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3138 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3139 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3140 om12=dxi*dxj+dyi*dyj+dzi*dzj
3142 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3143 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3149 deltat12=om2-om1+2.0d0
3151 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3152 & +akct*deltad*deltat12
3153 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3154 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3155 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3156 c & " deltat12",deltat12," eij",eij
3157 ed=2*akcm*deltad+akct*deltat12
3159 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3160 eom1=-2*akth*deltat1-pom1-om2*pom2
3161 eom2= 2*akth*deltat2+pom1-om1*pom2
3164 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3167 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3168 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3169 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3170 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3173 C Calculate the components of the gradient in DC and X
3177 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3182 C--------------------------------------------------------------------------
3183 subroutine ebond(estr)
3185 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3187 implicit real*8 (a-h,o-z)
3188 include 'DIMENSIONS'
3189 include 'sizesclu.dat'
3190 include 'COMMON.LOCAL'
3191 include 'COMMON.GEO'
3192 include 'COMMON.INTERACT'
3193 include 'COMMON.DERIV'
3194 include 'COMMON.VAR'
3195 include 'COMMON.CHAIN'
3196 include 'COMMON.IOUNITS'
3197 include 'COMMON.NAMES'
3198 include 'COMMON.FFIELD'
3199 include 'COMMON.CONTROL'
3200 logical energy_dec /.false./
3201 double precision u(3),ud(3)
3205 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3206 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3208 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3209 C & *dc(j,i-1)/vbld(i)
3211 C if (energy_dec) write(iout,*)
3212 C & "estr1",i,vbld(i),distchainmax,
3213 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3215 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3216 diff = vbld(i)-vbldpDUM
3218 diff = vbld(i)-vbldp0
3219 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3223 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3226 C write (iout,'(a7,i5,4f7.3)')
3227 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3229 estr=0.5d0*AKP*estr+estr1
3231 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3235 if (iti.ne.10 .and. iti.ne.ntyp1) then
3238 diff=vbld(i+nres)-vbldsc0(1,iti)
3239 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3240 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3241 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3243 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3247 diff=vbld(i+nres)-vbldsc0(j,iti)
3248 ud(j)=aksc(j,iti)*diff
3249 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3263 uprod2=uprod2*u(k)*u(k)
3267 usumsqder=usumsqder+ud(j)*uprod2
3269 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3270 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3271 estr=estr+uprod/usum
3273 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3281 C--------------------------------------------------------------------------
3282 subroutine ebend(etheta)
3284 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3285 C angles gamma and its derivatives in consecutive thetas and gammas.
3287 implicit real*8 (a-h,o-z)
3288 include 'DIMENSIONS'
3289 include 'sizesclu.dat'
3290 include 'COMMON.LOCAL'
3291 include 'COMMON.GEO'
3292 include 'COMMON.INTERACT'
3293 include 'COMMON.DERIV'
3294 include 'COMMON.VAR'
3295 include 'COMMON.CHAIN'
3296 include 'COMMON.IOUNITS'
3297 include 'COMMON.NAMES'
3298 include 'COMMON.FFIELD'
3299 common /calcthet/ term1,term2,termm,diffak,ratak,
3300 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3301 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3302 double precision y(2),z(2)
3304 time11=dexp(-2*time)
3307 c write (iout,*) "nres",nres
3308 c write (*,'(a,i2)') 'EBEND ICG=',icg
3309 c write (iout,*) ithet_start,ithet_end
3310 do i=ithet_start,ithet_end
3312 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3313 & .or.itype(i).eq.ntyp1) cycle
3314 C Zero the energy function and its derivative at 0 or pi.
3315 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3317 ichir1=isign(1,itype(i-2))
3318 ichir2=isign(1,itype(i))
3319 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3320 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3321 if (itype(i-1).eq.10) then
3322 itype1=isign(10,itype(i-2))
3323 ichir11=isign(1,itype(i-2))
3324 ichir12=isign(1,itype(i-2))
3325 itype2=isign(10,itype(i))
3326 ichir21=isign(1,itype(i))
3327 ichir22=isign(1,itype(i))
3333 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3337 call proc_proc(phii,icrc)
3338 if (icrc.eq.1) phii=150.0
3349 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3353 call proc_proc(phii1,icrc)
3354 if (icrc.eq.1) phii1=150.0
3366 C Calculate the "mean" value of theta from the part of the distribution
3367 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3368 C In following comments this theta will be referred to as t_c.
3369 thet_pred_mean=0.0d0
3371 athetk=athet(k,it,ichir1,ichir2)
3372 bthetk=bthet(k,it,ichir1,ichir2)
3374 athetk=athet(k,itype1,ichir11,ichir12)
3375 bthetk=bthet(k,itype2,ichir21,ichir22)
3377 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3379 c write (iout,*) "thet_pred_mean",thet_pred_mean
3380 dthett=thet_pred_mean*ssd
3381 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3382 c write (iout,*) "thet_pred_mean",thet_pred_mean
3383 C Derivatives of the "mean" values in gamma1 and gamma2.
3384 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3385 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3386 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3387 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3389 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3390 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3391 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3392 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3394 if (theta(i).gt.pi-delta) then
3395 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3397 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3398 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3399 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3401 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3403 else if (theta(i).lt.delta) then
3404 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3405 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3406 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3408 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3409 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3412 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3415 etheta=etheta+ethetai
3416 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3417 c & rad2deg*phii,rad2deg*phii1,ethetai
3418 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3419 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3420 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3423 C Ufff.... We've done all this!!!
3426 C---------------------------------------------------------------------------
3427 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3429 implicit real*8 (a-h,o-z)
3430 include 'DIMENSIONS'
3431 include 'COMMON.LOCAL'
3432 include 'COMMON.IOUNITS'
3433 common /calcthet/ term1,term2,termm,diffak,ratak,
3434 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3435 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3436 C Calculate the contributions to both Gaussian lobes.
3437 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3438 C The "polynomial part" of the "standard deviation" of this part of
3442 sig=sig*thet_pred_mean+polthet(j,it)
3444 C Derivative of the "interior part" of the "standard deviation of the"
3445 C gamma-dependent Gaussian lobe in t_c.
3446 sigtc=3*polthet(3,it)
3448 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3451 C Set the parameters of both Gaussian lobes of the distribution.
3452 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3453 fac=sig*sig+sigc0(it)
3456 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3457 sigsqtc=-4.0D0*sigcsq*sigtc
3458 c print *,i,sig,sigtc,sigsqtc
3459 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3460 sigtc=-sigtc/(fac*fac)
3461 C Following variable is sigma(t_c)**(-2)
3462 sigcsq=sigcsq*sigcsq
3464 sig0inv=1.0D0/sig0i**2
3465 delthec=thetai-thet_pred_mean
3466 delthe0=thetai-theta0i
3467 term1=-0.5D0*sigcsq*delthec*delthec
3468 term2=-0.5D0*sig0inv*delthe0*delthe0
3469 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3470 C NaNs in taking the logarithm. We extract the largest exponent which is added
3471 C to the energy (this being the log of the distribution) at the end of energy
3472 C term evaluation for this virtual-bond angle.
3473 if (term1.gt.term2) then
3475 term2=dexp(term2-termm)
3479 term1=dexp(term1-termm)
3482 C The ratio between the gamma-independent and gamma-dependent lobes of
3483 C the distribution is a Gaussian function of thet_pred_mean too.
3484 diffak=gthet(2,it)-thet_pred_mean
3485 ratak=diffak/gthet(3,it)**2
3486 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3487 C Let's differentiate it in thet_pred_mean NOW.
3489 C Now put together the distribution terms to make complete distribution.
3490 termexp=term1+ak*term2
3491 termpre=sigc+ak*sig0i
3492 C Contribution of the bending energy from this theta is just the -log of
3493 C the sum of the contributions from the two lobes and the pre-exponential
3494 C factor. Simple enough, isn't it?
3495 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3496 C NOW the derivatives!!!
3497 C 6/6/97 Take into account the deformation.
3498 E_theta=(delthec*sigcsq*term1
3499 & +ak*delthe0*sig0inv*term2)/termexp
3500 E_tc=((sigtc+aktc*sig0i)/termpre
3501 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3502 & aktc*term2)/termexp)
3505 c-----------------------------------------------------------------------------
3506 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3507 implicit real*8 (a-h,o-z)
3508 include 'DIMENSIONS'
3509 include 'COMMON.LOCAL'
3510 include 'COMMON.IOUNITS'
3511 common /calcthet/ term1,term2,termm,diffak,ratak,
3512 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3513 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3514 delthec=thetai-thet_pred_mean
3515 delthe0=thetai-theta0i
3516 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3517 t3 = thetai-thet_pred_mean
3521 t14 = t12+t6*sigsqtc
3523 t21 = thetai-theta0i
3529 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3530 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3531 & *(-t12*t9-ak*sig0inv*t27)
3535 C--------------------------------------------------------------------------
3536 subroutine ebend(etheta)
3538 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3539 C angles gamma and its derivatives in consecutive thetas and gammas.
3540 C ab initio-derived potentials from
3541 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3543 implicit real*8 (a-h,o-z)
3544 include 'DIMENSIONS'
3545 include 'sizesclu.dat'
3546 include 'COMMON.LOCAL'
3547 include 'COMMON.GEO'
3548 include 'COMMON.INTERACT'
3549 include 'COMMON.DERIV'
3550 include 'COMMON.VAR'
3551 include 'COMMON.CHAIN'
3552 include 'COMMON.IOUNITS'
3553 include 'COMMON.NAMES'
3554 include 'COMMON.FFIELD'
3555 include 'COMMON.CONTROL'
3556 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3557 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3558 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3559 & sinph1ph2(maxdouble,maxdouble)
3560 logical lprn /.false./, lprn1 /.false./
3562 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3563 do i=ithet_start,ithet_end
3565 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3566 & .or.itype(i).eq.ntyp1) cycle
3567 if (iabs(itype(i+1)).eq.20) iblock=2
3568 if (iabs(itype(i+1)).ne.20) iblock=1
3572 theti2=0.5d0*theta(i)
3573 ityp2=ithetyp((itype(i-1)))
3575 coskt(k)=dcos(k*theti2)
3576 sinkt(k)=dsin(k*theti2)
3586 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3589 if (phii.ne.phii) phii=150.0
3593 ityp1=ithetyp((itype(i-2)))
3595 cosph1(k)=dcos(k*phii)
3596 sinph1(k)=dsin(k*phii)
3607 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3610 if (phii1.ne.phii1) phii1=150.0
3615 ityp3=ithetyp((itype(i)))
3617 cosph2(k)=dcos(k*phii1)
3618 sinph2(k)=dsin(k*phii1)
3628 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3629 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3631 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3634 ccl=cosph1(l)*cosph2(k-l)
3635 ssl=sinph1(l)*sinph2(k-l)
3636 scl=sinph1(l)*cosph2(k-l)
3637 csl=cosph1(l)*sinph2(k-l)
3638 cosph1ph2(l,k)=ccl-ssl
3639 cosph1ph2(k,l)=ccl+ssl
3640 sinph1ph2(l,k)=scl+csl
3641 sinph1ph2(k,l)=scl-csl
3645 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3646 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3647 write (iout,*) "coskt and sinkt"
3649 write (iout,*) k,coskt(k),sinkt(k)
3653 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3654 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3657 & write (iout,*) "k",k," aathet",
3658 & aathet(k,ityp1,ityp2,ityp3,iblock),
3659 & " ethetai",ethetai
3662 write (iout,*) "cosph and sinph"
3664 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3666 write (iout,*) "cosph1ph2 and sinph2ph2"
3669 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3670 & sinph1ph2(l,k),sinph1ph2(k,l)
3673 write(iout,*) "ethetai",ethetai
3677 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3678 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3679 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3680 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3681 ethetai=ethetai+sinkt(m)*aux
3682 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3683 dephii=dephii+k*sinkt(m)*(
3684 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3685 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3686 dephii1=dephii1+k*sinkt(m)*(
3687 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3688 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3690 & write (iout,*) "m",m," k",k," bbthet",
3691 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3692 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3693 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3694 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3698 & write(iout,*) "ethetai",ethetai
3702 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3703 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3704 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3705 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3706 ethetai=ethetai+sinkt(m)*aux
3707 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3708 dephii=dephii+l*sinkt(m)*(
3709 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3710 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3711 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3712 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3713 dephii1=dephii1+(k-l)*sinkt(m)*(
3714 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3715 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3716 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3717 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3719 write (iout,*) "m",m," k",k," l",l," ffthet",
3720 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3724 & " ethetai",ethetai
3725 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3726 & cosph1ph2(k,l)*sinkt(m),
3727 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3733 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3734 & i,theta(i)*rad2deg,phii*rad2deg,
3735 & phii1*rad2deg,ethetai
3736 etheta=etheta+ethetai
3737 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3738 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3739 gloc(nphi+i-2,icg)=wang*dethetai
3745 c-----------------------------------------------------------------------------
3746 subroutine esc(escloc)
3747 C Calculate the local energy of a side chain and its derivatives in the
3748 C corresponding virtual-bond valence angles THETA and the spherical angles
3750 implicit real*8 (a-h,o-z)
3751 include 'DIMENSIONS'
3752 include 'sizesclu.dat'
3753 include 'COMMON.GEO'
3754 include 'COMMON.LOCAL'
3755 include 'COMMON.VAR'
3756 include 'COMMON.INTERACT'
3757 include 'COMMON.DERIV'
3758 include 'COMMON.CHAIN'
3759 include 'COMMON.IOUNITS'
3760 include 'COMMON.NAMES'
3761 include 'COMMON.FFIELD'
3762 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3763 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3764 common /sccalc/ time11,time12,time112,theti,it,nlobit
3767 c write (iout,'(a)') 'ESC'
3768 do i=loc_start,loc_end
3770 if (it.eq.ntyp1) cycle
3771 if (it.eq.10) goto 1
3772 nlobit=nlob(iabs(it))
3773 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3774 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3775 theti=theta(i+1)-pipol
3779 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3781 if (x(2).gt.pi-delta) then
3785 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3787 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3788 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3790 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3791 & ddersc0(1),dersc(1))
3792 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3793 & ddersc0(3),dersc(3))
3795 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3797 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3798 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3799 & dersc0(2),esclocbi,dersc02)
3800 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3802 call splinthet(x(2),0.5d0*delta,ss,ssd)
3807 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3809 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3810 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3812 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3814 c write (iout,*) escloci
3815 else if (x(2).lt.delta) then
3819 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3821 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3822 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3824 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3825 & ddersc0(1),dersc(1))
3826 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3827 & ddersc0(3),dersc(3))
3829 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3831 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3832 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3833 & dersc0(2),esclocbi,dersc02)
3834 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3839 call splinthet(x(2),0.5d0*delta,ss,ssd)
3841 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3843 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3844 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3846 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3847 c write (iout,*) escloci
3849 call enesc(x,escloci,dersc,ddummy,.false.)
3852 escloc=escloc+escloci
3853 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3855 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3857 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3858 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3863 C---------------------------------------------------------------------------
3864 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3865 implicit real*8 (a-h,o-z)
3866 include 'DIMENSIONS'
3867 include 'COMMON.GEO'
3868 include 'COMMON.LOCAL'
3869 include 'COMMON.IOUNITS'
3870 common /sccalc/ time11,time12,time112,theti,it,nlobit
3871 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3872 double precision contr(maxlob,-1:1)
3874 c write (iout,*) 'it=',it,' nlobit=',nlobit
3878 if (mixed) ddersc(j)=0.0d0
3882 C Because of periodicity of the dependence of the SC energy in omega we have
3883 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3884 C To avoid underflows, first compute & store the exponents.
3892 z(k)=x(k)-censc(k,j,it)
3897 Axk=Axk+gaussc(l,k,j,it)*z(l)
3903 expfac=expfac+Ax(k,j,iii)*z(k)
3911 C As in the case of ebend, we want to avoid underflows in exponentiation and
3912 C subsequent NaNs and INFs in energy calculation.
3913 C Find the largest exponent
3917 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3921 cd print *,'it=',it,' emin=',emin
3923 C Compute the contribution to SC energy and derivatives
3927 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3928 cd print *,'j=',j,' expfac=',expfac
3929 escloc_i=escloc_i+expfac
3931 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3935 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3936 & +gaussc(k,2,j,it))*expfac
3943 dersc(1)=dersc(1)/cos(theti)**2
3944 ddersc(1)=ddersc(1)/cos(theti)**2
3947 escloci=-(dlog(escloc_i)-emin)
3949 dersc(j)=dersc(j)/escloc_i
3953 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3958 C------------------------------------------------------------------------------
3959 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3960 implicit real*8 (a-h,o-z)
3961 include 'DIMENSIONS'
3962 include 'COMMON.GEO'
3963 include 'COMMON.LOCAL'
3964 include 'COMMON.IOUNITS'
3965 common /sccalc/ time11,time12,time112,theti,it,nlobit
3966 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3967 double precision contr(maxlob)
3978 z(k)=x(k)-censc(k,j,it)
3984 Axk=Axk+gaussc(l,k,j,it)*z(l)
3990 expfac=expfac+Ax(k,j)*z(k)
3995 C As in the case of ebend, we want to avoid underflows in exponentiation and
3996 C subsequent NaNs and INFs in energy calculation.
3997 C Find the largest exponent
4000 if (emin.gt.contr(j)) emin=contr(j)
4004 C Compute the contribution to SC energy and derivatives
4008 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4009 escloc_i=escloc_i+expfac
4011 dersc(k)=dersc(k)+Ax(k,j)*expfac
4013 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4014 & +gaussc(1,2,j,it))*expfac
4018 dersc(1)=dersc(1)/cos(theti)**2
4019 dersc12=dersc12/cos(theti)**2
4020 escloci=-(dlog(escloc_i)-emin)
4022 dersc(j)=dersc(j)/escloc_i
4024 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4028 c----------------------------------------------------------------------------------
4029 subroutine esc(escloc)
4030 C Calculate the local energy of a side chain and its derivatives in the
4031 C corresponding virtual-bond valence angles THETA and the spherical angles
4032 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4033 C added by Urszula Kozlowska. 07/11/2007
4035 implicit real*8 (a-h,o-z)
4036 include 'DIMENSIONS'
4037 include 'sizesclu.dat'
4038 include 'COMMON.GEO'
4039 include 'COMMON.LOCAL'
4040 include 'COMMON.VAR'
4041 include 'COMMON.SCROT'
4042 include 'COMMON.INTERACT'
4043 include 'COMMON.DERIV'
4044 include 'COMMON.CHAIN'
4045 include 'COMMON.IOUNITS'
4046 include 'COMMON.NAMES'
4047 include 'COMMON.FFIELD'
4048 include 'COMMON.CONTROL'
4049 include 'COMMON.VECTORS'
4050 double precision x_prime(3),y_prime(3),z_prime(3)
4051 & , sumene,dsc_i,dp2_i,x(65),
4052 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4053 & de_dxx,de_dyy,de_dzz,de_dt
4054 double precision s1_t,s1_6_t,s2_t,s2_6_t
4056 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4057 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4058 & dt_dCi(3),dt_dCi1(3)
4059 common /sccalc/ time11,time12,time112,theti,it,nlobit
4062 do i=loc_start,loc_end
4063 if (itype(i).eq.ntyp1) cycle
4064 costtab(i+1) =dcos(theta(i+1))
4065 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4066 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4067 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4068 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4069 cosfac=dsqrt(cosfac2)
4070 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4071 sinfac=dsqrt(sinfac2)
4073 if (it.eq.10) goto 1
4075 C Compute the axes of tghe local cartesian coordinates system; store in
4076 c x_prime, y_prime and z_prime
4083 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4084 C & dc_norm(3,i+nres)
4086 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4087 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4090 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4093 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4094 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4095 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4096 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4097 c & " xy",scalar(x_prime(1),y_prime(1)),
4098 c & " xz",scalar(x_prime(1),z_prime(1)),
4099 c & " yy",scalar(y_prime(1),y_prime(1)),
4100 c & " yz",scalar(y_prime(1),z_prime(1)),
4101 c & " zz",scalar(z_prime(1),z_prime(1))
4103 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4104 C to local coordinate system. Store in xx, yy, zz.
4110 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4111 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4112 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4119 C Compute the energy of the ith side cbain
4121 c write (2,*) "xx",xx," yy",yy," zz",zz
4124 x(j) = sc_parmin(j,it)
4127 Cc diagnostics - remove later
4129 yy1 = dsin(alph(2))*dcos(omeg(2))
4130 zz1 = -dsin(alph(2))*dsin(omeg(2))
4131 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4132 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4134 C," --- ", xx_w,yy_w,zz_w
4137 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4138 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4140 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4141 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4143 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4144 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4145 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4146 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4147 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4149 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4150 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4151 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4152 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4153 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4155 dsc_i = 0.743d0+x(61)
4157 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4158 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4159 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4160 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4161 s1=(1+x(63))/(0.1d0 + dscp1)
4162 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4163 s2=(1+x(65))/(0.1d0 + dscp2)
4164 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4165 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4166 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4167 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4169 c & dscp1,dscp2,sumene
4170 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4171 escloc = escloc + sumene
4172 c write (2,*) "escloc",escloc
4173 if (.not. calc_grad) goto 1
4176 C This section to check the numerical derivatives of the energy of ith side
4177 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4178 C #define DEBUG in the code to turn it on.
4180 write (2,*) "sumene =",sumene
4184 write (2,*) xx,yy,zz
4185 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4186 de_dxx_num=(sumenep-sumene)/aincr
4188 write (2,*) "xx+ sumene from enesc=",sumenep
4191 write (2,*) xx,yy,zz
4192 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4193 de_dyy_num=(sumenep-sumene)/aincr
4195 write (2,*) "yy+ sumene from enesc=",sumenep
4198 write (2,*) xx,yy,zz
4199 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4200 de_dzz_num=(sumenep-sumene)/aincr
4202 write (2,*) "zz+ sumene from enesc=",sumenep
4203 costsave=cost2tab(i+1)
4204 sintsave=sint2tab(i+1)
4205 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4206 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4207 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4208 de_dt_num=(sumenep-sumene)/aincr
4209 write (2,*) " t+ sumene from enesc=",sumenep
4210 cost2tab(i+1)=costsave
4211 sint2tab(i+1)=sintsave
4212 C End of diagnostics section.
4215 C Compute the gradient of esc
4217 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4218 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4219 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4220 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4221 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4222 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4223 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4224 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4225 pom1=(sumene3*sint2tab(i+1)+sumene1)
4226 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4227 pom2=(sumene4*cost2tab(i+1)+sumene2)
4228 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4229 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4230 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4231 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4233 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4234 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4235 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4237 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4238 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4239 & +(pom1+pom2)*pom_dx
4241 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4244 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4245 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4246 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4248 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4249 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4250 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4251 & +x(59)*zz**2 +x(60)*xx*zz
4252 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4253 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4254 & +(pom1-pom2)*pom_dy
4256 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4259 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4260 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4261 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4262 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4263 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4264 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4265 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4266 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4268 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4271 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4272 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4273 & +pom1*pom_dt1+pom2*pom_dt2
4275 write(2,*), "de_dt = ", de_dt,de_dt_num
4279 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4280 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4281 cosfac2xx=cosfac2*xx
4282 sinfac2yy=sinfac2*yy
4284 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4286 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4288 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4289 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4290 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4291 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4292 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4293 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4294 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4295 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4296 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4297 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4301 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4302 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4303 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4304 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4307 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4308 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4309 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4311 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4312 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4316 dXX_Ctab(k,i)=dXX_Ci(k)
4317 dXX_C1tab(k,i)=dXX_Ci1(k)
4318 dYY_Ctab(k,i)=dYY_Ci(k)
4319 dYY_C1tab(k,i)=dYY_Ci1(k)
4320 dZZ_Ctab(k,i)=dZZ_Ci(k)
4321 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4322 dXX_XYZtab(k,i)=dXX_XYZ(k)
4323 dYY_XYZtab(k,i)=dYY_XYZ(k)
4324 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4328 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4329 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4330 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4331 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4332 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4334 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4335 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4336 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4337 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4338 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4339 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4340 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4341 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4343 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4344 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4346 C to check gradient call subroutine check_grad
4353 c------------------------------------------------------------------------------
4354 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4356 C This procedure calculates two-body contact function g(rij) and its derivative:
4359 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4362 C where x=(rij-r0ij)/delta
4364 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4367 double precision rij,r0ij,eps0ij,fcont,fprimcont
4368 double precision x,x2,x4,delta
4372 if (x.lt.-1.0D0) then
4375 else if (x.le.1.0D0) then
4378 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4379 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4386 c------------------------------------------------------------------------------
4387 subroutine splinthet(theti,delta,ss,ssder)
4388 implicit real*8 (a-h,o-z)
4389 include 'DIMENSIONS'
4390 include 'sizesclu.dat'
4391 include 'COMMON.VAR'
4392 include 'COMMON.GEO'
4395 if (theti.gt.pipol) then
4396 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4398 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4403 c------------------------------------------------------------------------------
4404 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4406 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4407 double precision ksi,ksi2,ksi3,a1,a2,a3
4408 a1=fprim0*delta/(f1-f0)
4414 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4415 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4418 c------------------------------------------------------------------------------
4419 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4421 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4422 double precision ksi,ksi2,ksi3,a1,a2,a3
4427 a2=3*(f1x-f0x)-2*fprim0x*delta
4428 a3=fprim0x*delta-2*(f1x-f0x)
4429 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4432 C-----------------------------------------------------------------------------
4434 C-----------------------------------------------------------------------------
4435 subroutine etor(etors,edihcnstr,fact)
4436 implicit real*8 (a-h,o-z)
4437 include 'DIMENSIONS'
4438 include 'sizesclu.dat'
4439 include 'COMMON.VAR'
4440 include 'COMMON.GEO'
4441 include 'COMMON.LOCAL'
4442 include 'COMMON.TORSION'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.CHAIN'
4446 include 'COMMON.NAMES'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.FFIELD'
4449 include 'COMMON.TORCNSTR'
4451 C Set lprn=.true. for debugging
4455 do i=iphi_start,iphi_end
4456 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4457 & .or. itype(i).eq.ntyp1) cycle
4458 itori=itortyp(itype(i-2))
4459 itori1=itortyp(itype(i-1))
4462 C Proline-Proline pair is a special case...
4463 if (itori.eq.3 .and. itori1.eq.3) then
4464 if (phii.gt.-dwapi3) then
4466 fac=1.0D0/(1.0D0-cosphi)
4467 etorsi=v1(1,3,3)*fac
4468 etorsi=etorsi+etorsi
4469 etors=etors+etorsi-v1(1,3,3)
4470 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4473 v1ij=v1(j+1,itori,itori1)
4474 v2ij=v2(j+1,itori,itori1)
4477 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4478 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4482 v1ij=v1(j,itori,itori1)
4483 v2ij=v2(j,itori,itori1)
4486 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4487 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4491 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4492 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4493 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4494 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4495 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4497 ! 6/20/98 - dihedral angle constraints
4500 itori=idih_constr(i)
4503 if (difi.gt.drange(i)) then
4505 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4506 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4507 else if (difi.lt.-drange(i)) then
4509 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4510 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4512 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4513 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4515 ! write (iout,*) 'edihcnstr',edihcnstr
4518 c------------------------------------------------------------------------------
4520 subroutine etor(etors,edihcnstr,fact)
4521 implicit real*8 (a-h,o-z)
4522 include 'DIMENSIONS'
4523 include 'sizesclu.dat'
4524 include 'COMMON.VAR'
4525 include 'COMMON.GEO'
4526 include 'COMMON.LOCAL'
4527 include 'COMMON.TORSION'
4528 include 'COMMON.INTERACT'
4529 include 'COMMON.DERIV'
4530 include 'COMMON.CHAIN'
4531 include 'COMMON.NAMES'
4532 include 'COMMON.IOUNITS'
4533 include 'COMMON.FFIELD'
4534 include 'COMMON.TORCNSTR'
4536 C Set lprn=.true. for debugging
4540 do i=iphi_start,iphi_end
4542 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4543 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4544 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4545 if (iabs(itype(i)).eq.20) then
4550 itori=itortyp(itype(i-2))
4551 itori1=itortyp(itype(i-1))
4554 C Regular cosine and sine terms
4555 do j=1,nterm(itori,itori1,iblock)
4556 v1ij=v1(j,itori,itori1,iblock)
4557 v2ij=v2(j,itori,itori1,iblock)
4560 etors=etors+v1ij*cosphi+v2ij*sinphi
4561 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4565 C E = SUM ----------------------------------- - v1
4566 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4568 cosphi=dcos(0.5d0*phii)
4569 sinphi=dsin(0.5d0*phii)
4570 do j=1,nlor(itori,itori1,iblock)
4571 vl1ij=vlor1(j,itori,itori1)
4572 vl2ij=vlor2(j,itori,itori1)
4573 vl3ij=vlor3(j,itori,itori1)
4574 pom=vl2ij*cosphi+vl3ij*sinphi
4575 pom1=1.0d0/(pom*pom+1.0d0)
4576 etors=etors+vl1ij*pom1
4578 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4580 C Subtract the constant term
4581 etors=etors-v0(itori,itori1,iblock)
4583 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4584 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4585 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4586 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4587 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4590 ! 6/20/98 - dihedral angle constraints
4593 itori=idih_constr(i)
4595 difi=pinorm(phii-phi0(i))
4597 if (difi.gt.drange(i)) then
4599 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4600 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4601 edihi=0.25d0*ftors*difi**4
4602 else if (difi.lt.-drange(i)) then
4604 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4605 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4606 edihi=0.25d0*ftors*difi**4
4610 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4612 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4613 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4615 ! write (iout,*) 'edihcnstr',edihcnstr
4618 c----------------------------------------------------------------------------
4619 subroutine etor_d(etors_d,fact2)
4620 C 6/23/01 Compute double torsional energy
4621 implicit real*8 (a-h,o-z)
4622 include 'DIMENSIONS'
4623 include 'sizesclu.dat'
4624 include 'COMMON.VAR'
4625 include 'COMMON.GEO'
4626 include 'COMMON.LOCAL'
4627 include 'COMMON.TORSION'
4628 include 'COMMON.INTERACT'
4629 include 'COMMON.DERIV'
4630 include 'COMMON.CHAIN'
4631 include 'COMMON.NAMES'
4632 include 'COMMON.IOUNITS'
4633 include 'COMMON.FFIELD'
4634 include 'COMMON.TORCNSTR'
4636 C Set lprn=.true. for debugging
4640 do i=iphi_start,iphi_end-1
4642 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4643 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4644 & (itype(i+1).eq.ntyp1)) cycle
4645 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4647 itori=itortyp(itype(i-2))
4648 itori1=itortyp(itype(i-1))
4649 itori2=itortyp(itype(i))
4655 if (iabs(itype(i+1)).eq.20) iblock=2
4656 C Regular cosine and sine terms
4657 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4658 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4659 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4660 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4661 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4662 cosphi1=dcos(j*phii)
4663 sinphi1=dsin(j*phii)
4664 cosphi2=dcos(j*phii1)
4665 sinphi2=dsin(j*phii1)
4666 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4667 & v2cij*cosphi2+v2sij*sinphi2
4668 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4669 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4671 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4673 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4674 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4675 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4676 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4677 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4678 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4679 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4680 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4681 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4682 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4683 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4684 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4685 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4686 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4689 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4690 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4696 c------------------------------------------------------------------------------
4697 subroutine eback_sc_corr(esccor)
4698 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4699 c conformational states; temporarily implemented as differences
4700 c between UNRES torsional potentials (dependent on three types of
4701 c residues) and the torsional potentials dependent on all 20 types
4702 c of residues computed from AM1 energy surfaces of terminally-blocked
4703 c amino-acid residues.
4704 implicit real*8 (a-h,o-z)
4705 include 'DIMENSIONS'
4706 include 'sizesclu.dat'
4707 include 'COMMON.VAR'
4708 include 'COMMON.GEO'
4709 include 'COMMON.LOCAL'
4710 include 'COMMON.TORSION'
4711 include 'COMMON.SCCOR'
4712 include 'COMMON.INTERACT'
4713 include 'COMMON.DERIV'
4714 include 'COMMON.CHAIN'
4715 include 'COMMON.NAMES'
4716 include 'COMMON.IOUNITS'
4717 include 'COMMON.FFIELD'
4718 include 'COMMON.CONTROL'
4720 C Set lprn=.true. for debugging
4723 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4725 do i=itau_start,itau_end
4726 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
4728 isccori=isccortyp(itype(i-2))
4729 isccori1=isccortyp(itype(i-1))
4731 do intertyp=1,3 !intertyp
4732 cc Added 09 May 2012 (Adasko)
4733 cc Intertyp means interaction type of backbone mainchain correlation:
4734 c 1 = SC...Ca...Ca...Ca
4735 c 2 = Ca...Ca...Ca...SC
4736 c 3 = SC...Ca...Ca...SCi
4738 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4739 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4740 & (itype(i-1).eq.ntyp1)))
4741 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4742 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4743 & .or.(itype(i).eq.ntyp1)))
4744 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4745 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4746 & (itype(i-3).eq.ntyp1)))) cycle
4747 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4748 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4750 do j=1,nterm_sccor(isccori,isccori1)
4751 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4752 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4753 cosphi=dcos(j*tauangle(intertyp,i))
4754 sinphi=dsin(j*tauangle(intertyp,i))
4755 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4756 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4758 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4759 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4761 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4762 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4763 & (v1sccor(j,1,itori,itori1),j=1,6),
4764 & (v2sccor(j,1,itori,itori1),j=1,6)
4765 gsccor_loc(i-3)=gloci
4770 c------------------------------------------------------------------------------
4771 subroutine multibody(ecorr)
4772 C This subroutine calculates multi-body contributions to energy following
4773 C the idea of Skolnick et al. If side chains I and J make a contact and
4774 C at the same time side chains I+1 and J+1 make a contact, an extra
4775 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4776 implicit real*8 (a-h,o-z)
4777 include 'DIMENSIONS'
4778 include 'COMMON.IOUNITS'
4779 include 'COMMON.DERIV'
4780 include 'COMMON.INTERACT'
4781 include 'COMMON.CONTACTS'
4782 double precision gx(3),gx1(3)
4785 C Set lprn=.true. for debugging
4789 write (iout,'(a)') 'Contact function values:'
4791 write (iout,'(i2,20(1x,i2,f10.5))')
4792 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4807 num_conti=num_cont(i)
4808 num_conti1=num_cont(i1)
4813 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4814 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4815 cd & ' ishift=',ishift
4816 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4817 C The system gains extra energy.
4818 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4819 endif ! j1==j+-ishift
4828 c------------------------------------------------------------------------------
4829 double precision function esccorr(i,j,k,l,jj,kk)
4830 implicit real*8 (a-h,o-z)
4831 include 'DIMENSIONS'
4832 include 'COMMON.IOUNITS'
4833 include 'COMMON.DERIV'
4834 include 'COMMON.INTERACT'
4835 include 'COMMON.CONTACTS'
4836 double precision gx(3),gx1(3)
4841 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4842 C Calculate the multi-body contribution to energy.
4843 C Calculate multi-body contributions to the gradient.
4844 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4845 cd & k,l,(gacont(m,kk,k),m=1,3)
4847 gx(m) =ekl*gacont(m,jj,i)
4848 gx1(m)=eij*gacont(m,kk,k)
4849 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4850 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4851 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4852 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4856 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4861 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4867 c------------------------------------------------------------------------------
4869 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4870 implicit real*8 (a-h,o-z)
4871 include 'DIMENSIONS'
4872 integer dimen1,dimen2,atom,indx
4873 double precision buffer(dimen1,dimen2)
4874 double precision zapas
4875 common /contacts_hb/ zapas(3,20,maxres,7),
4876 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4877 & num_cont_hb(maxres),jcont_hb(20,maxres)
4878 num_kont=num_cont_hb(atom)
4882 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4885 buffer(i,indx+22)=facont_hb(i,atom)
4886 buffer(i,indx+23)=ees0p(i,atom)
4887 buffer(i,indx+24)=ees0m(i,atom)
4888 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4890 buffer(1,indx+26)=dfloat(num_kont)
4893 c------------------------------------------------------------------------------
4894 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4895 implicit real*8 (a-h,o-z)
4896 include 'DIMENSIONS'
4897 integer dimen1,dimen2,atom,indx
4898 double precision buffer(dimen1,dimen2)
4899 double precision zapas
4900 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4901 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4902 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4903 num_kont=buffer(1,indx+26)
4904 num_kont_old=num_cont_hb(atom)
4905 num_cont_hb(atom)=num_kont+num_kont_old
4910 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4913 facont_hb(ii,atom)=buffer(i,indx+22)
4914 ees0p(ii,atom)=buffer(i,indx+23)
4915 ees0m(ii,atom)=buffer(i,indx+24)
4916 jcont_hb(ii,atom)=buffer(i,indx+25)
4920 c------------------------------------------------------------------------------
4922 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4923 C This subroutine calculates multi-body contributions to hydrogen-bonding
4924 implicit real*8 (a-h,o-z)
4925 include 'DIMENSIONS'
4926 include 'sizesclu.dat'
4927 include 'COMMON.IOUNITS'
4929 include 'COMMON.INFO'
4931 include 'COMMON.FFIELD'
4932 include 'COMMON.DERIV'
4933 include 'COMMON.INTERACT'
4934 include 'COMMON.CONTACTS'
4936 parameter (max_cont=maxconts)
4937 parameter (max_dim=2*(8*3+2))
4938 parameter (msglen1=max_cont*max_dim*4)
4939 parameter (msglen2=2*msglen1)
4940 integer source,CorrelType,CorrelID,Error
4941 double precision buffer(max_cont,max_dim)
4943 double precision gx(3),gx1(3)
4946 C Set lprn=.true. for debugging
4951 if (fgProcs.le.1) goto 30
4953 write (iout,'(a)') 'Contact function values:'
4955 write (iout,'(2i3,50(1x,i2,f5.2))')
4956 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4957 & j=1,num_cont_hb(i))
4960 C Caution! Following code assumes that electrostatic interactions concerning
4961 C a given atom are split among at most two processors!
4971 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4974 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4975 if (MyRank.gt.0) then
4976 C Send correlation contributions to the preceding processor
4978 nn=num_cont_hb(iatel_s)
4979 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4980 cd write (iout,*) 'The BUFFER array:'
4982 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4984 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4986 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4987 C Clear the contacts of the atom passed to the neighboring processor
4988 nn=num_cont_hb(iatel_s+1)
4990 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4992 num_cont_hb(iatel_s)=0
4994 cd write (iout,*) 'Processor ',MyID,MyRank,
4995 cd & ' is sending correlation contribution to processor',MyID-1,
4996 cd & ' msglen=',msglen
4997 cd write (*,*) 'Processor ',MyID,MyRank,
4998 cd & ' is sending correlation contribution to processor',MyID-1,
4999 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5000 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5001 cd write (iout,*) 'Processor ',MyID,
5002 cd & ' has sent correlation contribution to processor',MyID-1,
5003 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5004 cd write (*,*) 'Processor ',MyID,
5005 cd & ' has sent correlation contribution to processor',MyID-1,
5006 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5008 endif ! (MyRank.gt.0)
5012 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5013 if (MyRank.lt.fgProcs-1) then
5014 C Receive correlation contributions from the next processor
5016 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5017 cd write (iout,*) 'Processor',MyID,
5018 cd & ' is receiving correlation contribution from processor',MyID+1,
5019 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5020 cd write (*,*) 'Processor',MyID,
5021 cd & ' is receiving correlation contribution from processor',MyID+1,
5022 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5024 do while (nbytes.le.0)
5025 call mp_probe(MyID+1,CorrelType,nbytes)
5027 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5028 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5029 cd write (iout,*) 'Processor',MyID,
5030 cd & ' has received correlation contribution from processor',MyID+1,
5031 cd & ' msglen=',msglen,' nbytes=',nbytes
5032 cd write (iout,*) 'The received BUFFER array:'
5034 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5036 if (msglen.eq.msglen1) then
5037 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5038 else if (msglen.eq.msglen2) then
5039 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5040 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5043 & 'ERROR!!!! message length changed while processing correlations.'
5045 & 'ERROR!!!! message length changed while processing correlations.'
5046 call mp_stopall(Error)
5047 endif ! msglen.eq.msglen1
5048 endif ! MyRank.lt.fgProcs-1
5055 write (iout,'(a)') 'Contact function values:'
5057 write (iout,'(2i3,50(1x,i2,f5.2))')
5058 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5059 & j=1,num_cont_hb(i))
5063 C Remove the loop below after debugging !!!
5070 C Calculate the local-electrostatic correlation terms
5071 do i=iatel_s,iatel_e+1
5073 num_conti=num_cont_hb(i)
5074 num_conti1=num_cont_hb(i+1)
5079 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5080 c & ' jj=',jj,' kk=',kk
5081 if (j1.eq.j+1 .or. j1.eq.j-1) then
5082 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5083 C The system gains extra energy.
5084 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5086 else if (j1.eq.j) then
5087 C Contacts I-J and I-(J+1) occur simultaneously.
5088 C The system loses extra energy.
5089 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5094 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5095 c & ' jj=',jj,' kk=',kk
5097 C Contacts I-J and (I+1)-J occur simultaneously.
5098 C The system loses extra energy.
5099 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5106 c------------------------------------------------------------------------------
5107 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5109 C This subroutine calculates multi-body contributions to hydrogen-bonding
5110 implicit real*8 (a-h,o-z)
5111 include 'DIMENSIONS'
5112 include 'sizesclu.dat'
5113 include 'COMMON.IOUNITS'
5115 include 'COMMON.INFO'
5117 include 'COMMON.FFIELD'
5118 include 'COMMON.DERIV'
5119 include 'COMMON.INTERACT'
5120 include 'COMMON.CONTACTS'
5122 parameter (max_cont=maxconts)
5123 parameter (max_dim=2*(8*3+2))
5124 parameter (msglen1=max_cont*max_dim*4)
5125 parameter (msglen2=2*msglen1)
5126 integer source,CorrelType,CorrelID,Error
5127 double precision buffer(max_cont,max_dim)
5129 double precision gx(3),gx1(3)
5132 C Set lprn=.true. for debugging
5138 if (fgProcs.le.1) goto 30
5140 write (iout,'(a)') 'Contact function values:'
5142 write (iout,'(2i3,50(1x,i2,f5.2))')
5143 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5144 & j=1,num_cont_hb(i))
5147 C Caution! Following code assumes that electrostatic interactions concerning
5148 C a given atom are split among at most two processors!
5158 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5161 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5162 if (MyRank.gt.0) then
5163 C Send correlation contributions to the preceding processor
5165 nn=num_cont_hb(iatel_s)
5166 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5167 cd write (iout,*) 'The BUFFER array:'
5169 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5171 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5173 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5174 C Clear the contacts of the atom passed to the neighboring processor
5175 nn=num_cont_hb(iatel_s+1)
5177 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5179 num_cont_hb(iatel_s)=0
5181 cd write (iout,*) 'Processor ',MyID,MyRank,
5182 cd & ' is sending correlation contribution to processor',MyID-1,
5183 cd & ' msglen=',msglen
5184 cd write (*,*) 'Processor ',MyID,MyRank,
5185 cd & ' is sending correlation contribution to processor',MyID-1,
5186 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5187 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5188 cd write (iout,*) 'Processor ',MyID,
5189 cd & ' has sent correlation contribution to processor',MyID-1,
5190 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5191 cd write (*,*) 'Processor ',MyID,
5192 cd & ' has sent correlation contribution to processor',MyID-1,
5193 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5195 endif ! (MyRank.gt.0)
5199 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5200 if (MyRank.lt.fgProcs-1) then
5201 C Receive correlation contributions from the next processor
5203 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5204 cd write (iout,*) 'Processor',MyID,
5205 cd & ' is receiving correlation contribution from processor',MyID+1,
5206 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5207 cd write (*,*) 'Processor',MyID,
5208 cd & ' is receiving correlation contribution from processor',MyID+1,
5209 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5211 do while (nbytes.le.0)
5212 call mp_probe(MyID+1,CorrelType,nbytes)
5214 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5215 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5216 cd write (iout,*) 'Processor',MyID,
5217 cd & ' has received correlation contribution from processor',MyID+1,
5218 cd & ' msglen=',msglen,' nbytes=',nbytes
5219 cd write (iout,*) 'The received BUFFER array:'
5221 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5223 if (msglen.eq.msglen1) then
5224 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5225 else if (msglen.eq.msglen2) then
5226 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5227 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5230 & 'ERROR!!!! message length changed while processing correlations.'
5232 & 'ERROR!!!! message length changed while processing correlations.'
5233 call mp_stopall(Error)
5234 endif ! msglen.eq.msglen1
5235 endif ! MyRank.lt.fgProcs-1
5242 write (iout,'(a)') 'Contact function values:'
5244 write (iout,'(2i3,50(1x,i2,f5.2))')
5245 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5246 & j=1,num_cont_hb(i))
5252 C Remove the loop below after debugging !!!
5259 C Calculate the dipole-dipole interaction energies
5260 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5261 do i=iatel_s,iatel_e+1
5262 num_conti=num_cont_hb(i)
5269 C Calculate the local-electrostatic correlation terms
5270 do i=iatel_s,iatel_e+1
5272 num_conti=num_cont_hb(i)
5273 num_conti1=num_cont_hb(i+1)
5278 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5279 c & ' jj=',jj,' kk=',kk
5280 if (j1.eq.j+1 .or. j1.eq.j-1) then
5281 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5282 C The system gains extra energy.
5284 sqd1=dsqrt(d_cont(jj,i))
5285 sqd2=dsqrt(d_cont(kk,i1))
5286 sred_geom = sqd1*sqd2
5287 IF (sred_geom.lt.cutoff_corr) THEN
5288 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5290 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5291 c & ' jj=',jj,' kk=',kk
5292 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5293 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5295 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5296 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5299 cd write (iout,*) 'sred_geom=',sred_geom,
5300 cd & ' ekont=',ekont,' fprim=',fprimcont
5301 call calc_eello(i,j,i+1,j1,jj,kk)
5302 if (wcorr4.gt.0.0d0)
5303 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5304 if (wcorr5.gt.0.0d0)
5305 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5306 c print *,"wcorr5",ecorr5
5307 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5308 cd write(2,*)'ijkl',i,j,i+1,j1
5309 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5310 & .or. wturn6.eq.0.0d0))then
5311 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5312 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5313 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5314 cd & 'ecorr6=',ecorr6
5315 cd write (iout,'(4e15.5)') sred_geom,
5316 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5317 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5318 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5319 else if (wturn6.gt.0.0d0
5320 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5321 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5322 eturn6=eturn6+eello_turn6(i,jj,kk)
5323 cd write (2,*) 'multibody_eello:eturn6',eturn6
5327 else if (j1.eq.j) then
5328 C Contacts I-J and I-(J+1) occur simultaneously.
5329 C The system loses extra energy.
5330 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5335 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5336 c & ' jj=',jj,' kk=',kk
5338 C Contacts I-J and (I+1)-J occur simultaneously.
5339 C The system loses extra energy.
5340 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5347 c------------------------------------------------------------------------------
5348 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5349 implicit real*8 (a-h,o-z)
5350 include 'DIMENSIONS'
5351 include 'COMMON.IOUNITS'
5352 include 'COMMON.DERIV'
5353 include 'COMMON.INTERACT'
5354 include 'COMMON.CONTACTS'
5355 double precision gx(3),gx1(3)
5365 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5366 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5367 C Following 4 lines for diagnostics.
5372 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5374 c write (iout,*)'Contacts have occurred for peptide groups',
5375 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5376 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5377 C Calculate the multi-body contribution to energy.
5378 ecorr=ecorr+ekont*ees
5380 C Calculate multi-body contributions to the gradient.
5382 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5383 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5384 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5385 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5386 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5387 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5388 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5389 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5390 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5391 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5392 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5393 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5394 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5395 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5399 gradcorr(ll,m)=gradcorr(ll,m)+
5400 & ees*ekl*gacont_hbr(ll,jj,i)-
5401 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5402 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5407 gradcorr(ll,m)=gradcorr(ll,m)+
5408 & ees*eij*gacont_hbr(ll,kk,k)-
5409 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5410 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5417 C---------------------------------------------------------------------------
5418 subroutine dipole(i,j,jj)
5419 implicit real*8 (a-h,o-z)
5420 include 'DIMENSIONS'
5421 include 'sizesclu.dat'
5422 include 'COMMON.IOUNITS'
5423 include 'COMMON.CHAIN'
5424 include 'COMMON.FFIELD'
5425 include 'COMMON.DERIV'
5426 include 'COMMON.INTERACT'
5427 include 'COMMON.CONTACTS'
5428 include 'COMMON.TORSION'
5429 include 'COMMON.VAR'
5430 include 'COMMON.GEO'
5431 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5433 iti1 = itortyp(itype(i+1))
5434 if (j.lt.nres-1) then
5435 itj1 = itortyp(itype(j+1))
5440 dipi(iii,1)=Ub2(iii,i)
5441 dipderi(iii)=Ub2der(iii,i)
5442 dipi(iii,2)=b1(iii,iti1)
5443 dipj(iii,1)=Ub2(iii,j)
5444 dipderj(iii)=Ub2der(iii,j)
5445 dipj(iii,2)=b1(iii,itj1)
5449 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5452 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5455 if (.not.calc_grad) return
5460 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5464 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5469 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5470 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5472 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5474 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5476 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5480 C---------------------------------------------------------------------------
5481 subroutine calc_eello(i,j,k,l,jj,kk)
5483 C This subroutine computes matrices and vectors needed to calculate
5484 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5486 implicit real*8 (a-h,o-z)
5487 include 'DIMENSIONS'
5488 include 'sizesclu.dat'
5489 include 'COMMON.IOUNITS'
5490 include 'COMMON.CHAIN'
5491 include 'COMMON.DERIV'
5492 include 'COMMON.INTERACT'
5493 include 'COMMON.CONTACTS'
5494 include 'COMMON.TORSION'
5495 include 'COMMON.VAR'
5496 include 'COMMON.GEO'
5497 include 'COMMON.FFIELD'
5498 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5499 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5502 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5503 cd & ' jj=',jj,' kk=',kk
5504 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5507 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5508 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5511 call transpose2(aa1(1,1),aa1t(1,1))
5512 call transpose2(aa2(1,1),aa2t(1,1))
5515 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5516 & aa1tder(1,1,lll,kkk))
5517 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5518 & aa2tder(1,1,lll,kkk))
5522 C parallel orientation of the two CA-CA-CA frames.
5524 iti=itortyp(itype(i))
5528 itk1=itortyp(itype(k+1))
5529 itj=itortyp(itype(j))
5530 if (l.lt.nres-1) then
5531 itl1=itortyp(itype(l+1))
5535 C A1 kernel(j+1) A2T
5537 cd write (iout,'(3f10.5,5x,3f10.5)')
5538 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5540 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5541 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5542 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5543 C Following matrices are needed only for 6-th order cumulants
5544 IF (wcorr6.gt.0.0d0) THEN
5545 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5546 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5547 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5548 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5549 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5550 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5551 & ADtEAderx(1,1,1,1,1,1))
5553 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5554 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5555 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5556 & ADtEA1derx(1,1,1,1,1,1))
5558 C End 6-th order cumulants
5561 cd write (2,*) 'In calc_eello6'
5563 cd write (2,*) 'iii=',iii
5565 cd write (2,*) 'kkk=',kkk
5567 cd write (2,'(3(2f10.5),5x)')
5568 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5573 call transpose2(EUgder(1,1,k),auxmat(1,1))
5574 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5575 call transpose2(EUg(1,1,k),auxmat(1,1))
5576 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5577 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5581 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5582 & EAEAderx(1,1,lll,kkk,iii,1))
5586 C A1T kernel(i+1) A2
5587 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5588 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5589 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5590 C Following matrices are needed only for 6-th order cumulants
5591 IF (wcorr6.gt.0.0d0) THEN
5592 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5593 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5594 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5595 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5597 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5598 & ADtEAderx(1,1,1,1,1,2))
5599 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5600 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5601 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5602 & ADtEA1derx(1,1,1,1,1,2))
5604 C End 6-th order cumulants
5605 call transpose2(EUgder(1,1,l),auxmat(1,1))
5606 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5607 call transpose2(EUg(1,1,l),auxmat(1,1))
5608 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5609 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5613 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5614 & EAEAderx(1,1,lll,kkk,iii,2))
5619 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5620 C They are needed only when the fifth- or the sixth-order cumulants are
5622 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5623 call transpose2(AEA(1,1,1),auxmat(1,1))
5624 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5625 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5627 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5628 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5629 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5630 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5631 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5632 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5633 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5634 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5635 call transpose2(AEA(1,1,2),auxmat(1,1))
5636 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5637 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5639 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5640 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5641 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5642 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5643 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5644 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5645 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5646 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5647 C Calculate the Cartesian derivatives of the vectors.
5651 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5652 call matvec2(auxmat(1,1),b1(1,iti),
5653 & AEAb1derx(1,lll,kkk,iii,1,1))
5654 call matvec2(auxmat(1,1),Ub2(1,i),
5655 & AEAb2derx(1,lll,kkk,iii,1,1))
5656 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5657 & AEAb1derx(1,lll,kkk,iii,2,1))
5658 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5659 & AEAb2derx(1,lll,kkk,iii,2,1))
5660 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5661 call matvec2(auxmat(1,1),b1(1,itj),
5662 & AEAb1derx(1,lll,kkk,iii,1,2))
5663 call matvec2(auxmat(1,1),Ub2(1,j),
5664 & AEAb2derx(1,lll,kkk,iii,1,2))
5665 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5666 & AEAb1derx(1,lll,kkk,iii,2,2))
5667 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5668 & AEAb2derx(1,lll,kkk,iii,2,2))
5675 C Antiparallel orientation of the two CA-CA-CA frames.
5677 iti=itortyp(itype(i))
5681 itk1=itortyp(itype(k+1))
5682 itl=itortyp(itype(l))
5683 itj=itortyp(itype(j))
5684 if (j.lt.nres-1) then
5685 itj1=itortyp(itype(j+1))
5689 C A2 kernel(j-1)T A1T
5690 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5691 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5692 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5693 C Following matrices are needed only for 6-th order cumulants
5694 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5695 & j.eq.i+4 .and. l.eq.i+3)) THEN
5696 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5697 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5698 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5699 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5700 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5701 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5702 & ADtEAderx(1,1,1,1,1,1))
5703 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5704 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5705 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5706 & ADtEA1derx(1,1,1,1,1,1))
5708 C End 6-th order cumulants
5709 call transpose2(EUgder(1,1,k),auxmat(1,1))
5710 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5711 call transpose2(EUg(1,1,k),auxmat(1,1))
5712 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5713 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5717 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5718 & EAEAderx(1,1,lll,kkk,iii,1))
5722 C A2T kernel(i+1)T A1
5723 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5724 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5725 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5726 C Following matrices are needed only for 6-th order cumulants
5727 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5728 & j.eq.i+4 .and. l.eq.i+3)) THEN
5729 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5730 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5731 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5732 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5733 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5734 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5735 & ADtEAderx(1,1,1,1,1,2))
5736 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5737 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5738 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5739 & ADtEA1derx(1,1,1,1,1,2))
5741 C End 6-th order cumulants
5742 call transpose2(EUgder(1,1,j),auxmat(1,1))
5743 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5744 call transpose2(EUg(1,1,j),auxmat(1,1))
5745 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5746 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5750 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5751 & EAEAderx(1,1,lll,kkk,iii,2))
5756 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5757 C They are needed only when the fifth- or the sixth-order cumulants are
5759 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5760 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5761 call transpose2(AEA(1,1,1),auxmat(1,1))
5762 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5763 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5764 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5765 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5766 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5767 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5768 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5769 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5770 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5771 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5772 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5773 call transpose2(AEA(1,1,2),auxmat(1,1))
5774 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5775 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5776 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5777 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5778 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5779 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5780 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5781 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5782 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5783 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5784 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5785 C Calculate the Cartesian derivatives of the vectors.
5789 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5790 call matvec2(auxmat(1,1),b1(1,iti),
5791 & AEAb1derx(1,lll,kkk,iii,1,1))
5792 call matvec2(auxmat(1,1),Ub2(1,i),
5793 & AEAb2derx(1,lll,kkk,iii,1,1))
5794 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5795 & AEAb1derx(1,lll,kkk,iii,2,1))
5796 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5797 & AEAb2derx(1,lll,kkk,iii,2,1))
5798 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5799 call matvec2(auxmat(1,1),b1(1,itl),
5800 & AEAb1derx(1,lll,kkk,iii,1,2))
5801 call matvec2(auxmat(1,1),Ub2(1,l),
5802 & AEAb2derx(1,lll,kkk,iii,1,2))
5803 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5804 & AEAb1derx(1,lll,kkk,iii,2,2))
5805 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5806 & AEAb2derx(1,lll,kkk,iii,2,2))
5815 C---------------------------------------------------------------------------
5816 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5817 & KK,KKderg,AKA,AKAderg,AKAderx)
5821 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5822 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5823 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5828 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5830 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5833 cd if (lprn) write (2,*) 'In kernel'
5835 cd if (lprn) write (2,*) 'kkk=',kkk
5837 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5838 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5840 cd write (2,*) 'lll=',lll
5841 cd write (2,*) 'iii=1'
5843 cd write (2,'(3(2f10.5),5x)')
5844 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5847 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5848 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5850 cd write (2,*) 'lll=',lll
5851 cd write (2,*) 'iii=2'
5853 cd write (2,'(3(2f10.5),5x)')
5854 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5861 C---------------------------------------------------------------------------
5862 double precision function eello4(i,j,k,l,jj,kk)
5863 implicit real*8 (a-h,o-z)
5864 include 'DIMENSIONS'
5865 include 'sizesclu.dat'
5866 include 'COMMON.IOUNITS'
5867 include 'COMMON.CHAIN'
5868 include 'COMMON.DERIV'
5869 include 'COMMON.INTERACT'
5870 include 'COMMON.CONTACTS'
5871 include 'COMMON.TORSION'
5872 include 'COMMON.VAR'
5873 include 'COMMON.GEO'
5874 double precision pizda(2,2),ggg1(3),ggg2(3)
5875 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5879 cd print *,'eello4:',i,j,k,l,jj,kk
5880 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5881 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5882 cold eij=facont_hb(jj,i)
5883 cold ekl=facont_hb(kk,k)
5885 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5887 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5888 gcorr_loc(k-1)=gcorr_loc(k-1)
5889 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5891 gcorr_loc(l-1)=gcorr_loc(l-1)
5892 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5894 gcorr_loc(j-1)=gcorr_loc(j-1)
5895 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5900 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5901 & -EAEAderx(2,2,lll,kkk,iii,1)
5902 cd derx(lll,kkk,iii)=0.0d0
5906 cd gcorr_loc(l-1)=0.0d0
5907 cd gcorr_loc(j-1)=0.0d0
5908 cd gcorr_loc(k-1)=0.0d0
5910 cd write (iout,*)'Contacts have occurred for peptide groups',
5911 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5912 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5913 if (j.lt.nres-1) then
5920 if (l.lt.nres-1) then
5928 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5929 ggg1(ll)=eel4*g_contij(ll,1)
5930 ggg2(ll)=eel4*g_contij(ll,2)
5931 ghalf=0.5d0*ggg1(ll)
5933 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5934 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5935 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5936 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5937 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5938 ghalf=0.5d0*ggg2(ll)
5940 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5941 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5942 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5943 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5948 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5949 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5954 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5955 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5961 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5966 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5970 cd write (2,*) iii,gcorr_loc(iii)
5974 cd write (2,*) 'ekont',ekont
5975 cd write (iout,*) 'eello4',ekont*eel4
5978 C---------------------------------------------------------------------------
5979 double precision function eello5(i,j,k,l,jj,kk)
5980 implicit real*8 (a-h,o-z)
5981 include 'DIMENSIONS'
5982 include 'sizesclu.dat'
5983 include 'COMMON.IOUNITS'
5984 include 'COMMON.CHAIN'
5985 include 'COMMON.DERIV'
5986 include 'COMMON.INTERACT'
5987 include 'COMMON.CONTACTS'
5988 include 'COMMON.TORSION'
5989 include 'COMMON.VAR'
5990 include 'COMMON.GEO'
5991 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5992 double precision ggg1(3),ggg2(3)
5993 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5998 C /l\ / \ \ / \ / \ / C
5999 C / \ / \ \ / \ / \ / C
6000 C j| o |l1 | o | o| o | | o |o C
6001 C \ |/k\| |/ \| / |/ \| |/ \| C
6002 C \i/ \ / \ / / \ / \ C
6004 C (I) (II) (III) (IV) C
6006 C eello5_1 eello5_2 eello5_3 eello5_4 C
6008 C Antiparallel chains C
6011 C /j\ / \ \ / \ / \ / C
6012 C / \ / \ \ / \ / \ / C
6013 C j1| o |l | o | o| o | | o |o C
6014 C \ |/k\| |/ \| / |/ \| |/ \| C
6015 C \i/ \ / \ / / \ / \ C
6017 C (I) (II) (III) (IV) C
6019 C eello5_1 eello5_2 eello5_3 eello5_4 C
6021 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6023 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6024 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6029 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6031 itk=itortyp(itype(k))
6032 itl=itortyp(itype(l))
6033 itj=itortyp(itype(j))
6038 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6039 cd & eel5_3_num,eel5_4_num)
6043 derx(lll,kkk,iii)=0.0d0
6047 cd eij=facont_hb(jj,i)
6048 cd ekl=facont_hb(kk,k)
6050 cd write (iout,*)'Contacts have occurred for peptide groups',
6051 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6053 C Contribution from the graph I.
6054 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6055 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6056 call transpose2(EUg(1,1,k),auxmat(1,1))
6057 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6058 vv(1)=pizda(1,1)-pizda(2,2)
6059 vv(2)=pizda(1,2)+pizda(2,1)
6060 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6061 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6063 C Explicit gradient in virtual-dihedral angles.
6064 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6065 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6066 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6067 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6068 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6069 vv(1)=pizda(1,1)-pizda(2,2)
6070 vv(2)=pizda(1,2)+pizda(2,1)
6071 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6072 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6073 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6074 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6075 vv(1)=pizda(1,1)-pizda(2,2)
6076 vv(2)=pizda(1,2)+pizda(2,1)
6078 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6079 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6082 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6083 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6084 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6086 C Cartesian gradient
6090 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6092 vv(1)=pizda(1,1)-pizda(2,2)
6093 vv(2)=pizda(1,2)+pizda(2,1)
6094 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6095 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6096 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6103 C Contribution from graph II
6104 call transpose2(EE(1,1,itk),auxmat(1,1))
6105 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6106 vv(1)=pizda(1,1)+pizda(2,2)
6107 vv(2)=pizda(2,1)-pizda(1,2)
6108 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6109 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6111 C Explicit gradient in virtual-dihedral angles.
6112 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6113 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6114 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6115 vv(1)=pizda(1,1)+pizda(2,2)
6116 vv(2)=pizda(2,1)-pizda(1,2)
6118 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6119 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6120 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6122 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6123 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6124 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6126 C Cartesian gradient
6130 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6132 vv(1)=pizda(1,1)+pizda(2,2)
6133 vv(2)=pizda(2,1)-pizda(1,2)
6134 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6135 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6136 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6145 C Parallel orientation
6146 C Contribution from graph III
6147 call transpose2(EUg(1,1,l),auxmat(1,1))
6148 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6149 vv(1)=pizda(1,1)-pizda(2,2)
6150 vv(2)=pizda(1,2)+pizda(2,1)
6151 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6152 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6154 C Explicit gradient in virtual-dihedral angles.
6155 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6156 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6157 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6158 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6159 vv(1)=pizda(1,1)-pizda(2,2)
6160 vv(2)=pizda(1,2)+pizda(2,1)
6161 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6162 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6163 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6164 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6165 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6166 vv(1)=pizda(1,1)-pizda(2,2)
6167 vv(2)=pizda(1,2)+pizda(2,1)
6168 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6169 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6170 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6171 C Cartesian gradient
6175 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6177 vv(1)=pizda(1,1)-pizda(2,2)
6178 vv(2)=pizda(1,2)+pizda(2,1)
6179 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6180 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6181 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6187 C Contribution from graph IV
6189 call transpose2(EE(1,1,itl),auxmat(1,1))
6190 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6191 vv(1)=pizda(1,1)+pizda(2,2)
6192 vv(2)=pizda(2,1)-pizda(1,2)
6193 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6194 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6196 C Explicit gradient in virtual-dihedral angles.
6197 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6198 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6199 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6200 vv(1)=pizda(1,1)+pizda(2,2)
6201 vv(2)=pizda(2,1)-pizda(1,2)
6202 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6203 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6204 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6205 C Cartesian gradient
6209 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6211 vv(1)=pizda(1,1)+pizda(2,2)
6212 vv(2)=pizda(2,1)-pizda(1,2)
6213 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6214 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6215 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6221 C Antiparallel orientation
6222 C Contribution from graph III
6224 call transpose2(EUg(1,1,j),auxmat(1,1))
6225 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6226 vv(1)=pizda(1,1)-pizda(2,2)
6227 vv(2)=pizda(1,2)+pizda(2,1)
6228 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6229 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6231 C Explicit gradient in virtual-dihedral angles.
6232 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6233 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6234 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6235 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6236 vv(1)=pizda(1,1)-pizda(2,2)
6237 vv(2)=pizda(1,2)+pizda(2,1)
6238 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6239 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6240 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6241 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6242 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6243 vv(1)=pizda(1,1)-pizda(2,2)
6244 vv(2)=pizda(1,2)+pizda(2,1)
6245 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6246 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6247 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6248 C Cartesian gradient
6252 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6254 vv(1)=pizda(1,1)-pizda(2,2)
6255 vv(2)=pizda(1,2)+pizda(2,1)
6256 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6257 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6258 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6264 C Contribution from graph IV
6266 call transpose2(EE(1,1,itj),auxmat(1,1))
6267 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6268 vv(1)=pizda(1,1)+pizda(2,2)
6269 vv(2)=pizda(2,1)-pizda(1,2)
6270 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6271 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6273 C Explicit gradient in virtual-dihedral angles.
6274 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6275 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6276 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6277 vv(1)=pizda(1,1)+pizda(2,2)
6278 vv(2)=pizda(2,1)-pizda(1,2)
6279 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6280 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6281 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6282 C Cartesian gradient
6286 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6288 vv(1)=pizda(1,1)+pizda(2,2)
6289 vv(2)=pizda(2,1)-pizda(1,2)
6290 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6291 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6292 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6299 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6300 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6301 cd write (2,*) 'ijkl',i,j,k,l
6302 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6303 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6305 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6306 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6307 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6308 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6310 if (j.lt.nres-1) then
6317 if (l.lt.nres-1) then
6327 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6329 ggg1(ll)=eel5*g_contij(ll,1)
6330 ggg2(ll)=eel5*g_contij(ll,2)
6331 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6332 ghalf=0.5d0*ggg1(ll)
6334 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6335 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6336 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6337 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6338 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6339 ghalf=0.5d0*ggg2(ll)
6341 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6342 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6343 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6344 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6349 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6350 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6355 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6356 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6362 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6367 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6371 cd write (2,*) iii,g_corr5_loc(iii)
6375 cd write (2,*) 'ekont',ekont
6376 cd write (iout,*) 'eello5',ekont*eel5
6379 c--------------------------------------------------------------------------
6380 double precision function eello6(i,j,k,l,jj,kk)
6381 implicit real*8 (a-h,o-z)
6382 include 'DIMENSIONS'
6383 include 'sizesclu.dat'
6384 include 'COMMON.IOUNITS'
6385 include 'COMMON.CHAIN'
6386 include 'COMMON.DERIV'
6387 include 'COMMON.INTERACT'
6388 include 'COMMON.CONTACTS'
6389 include 'COMMON.TORSION'
6390 include 'COMMON.VAR'
6391 include 'COMMON.GEO'
6392 include 'COMMON.FFIELD'
6393 double precision ggg1(3),ggg2(3)
6394 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6399 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6407 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6408 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6412 derx(lll,kkk,iii)=0.0d0
6416 cd eij=facont_hb(jj,i)
6417 cd ekl=facont_hb(kk,k)
6423 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6424 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6425 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6426 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6427 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6428 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6430 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6431 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6432 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6433 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6434 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6435 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6439 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6441 C If turn contributions are considered, they will be handled separately.
6442 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6443 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6444 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6445 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6446 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6447 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6448 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6451 if (j.lt.nres-1) then
6458 if (l.lt.nres-1) then
6466 ggg1(ll)=eel6*g_contij(ll,1)
6467 ggg2(ll)=eel6*g_contij(ll,2)
6468 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6469 ghalf=0.5d0*ggg1(ll)
6471 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6472 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6473 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6474 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6475 ghalf=0.5d0*ggg2(ll)
6476 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6478 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6479 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6480 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6481 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6486 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6487 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6492 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6493 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6499 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6504 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6508 cd write (2,*) iii,g_corr6_loc(iii)
6512 cd write (2,*) 'ekont',ekont
6513 cd write (iout,*) 'eello6',ekont*eel6
6516 c--------------------------------------------------------------------------
6517 double precision function eello6_graph1(i,j,k,l,imat,swap)
6518 implicit real*8 (a-h,o-z)
6519 include 'DIMENSIONS'
6520 include 'sizesclu.dat'
6521 include 'COMMON.IOUNITS'
6522 include 'COMMON.CHAIN'
6523 include 'COMMON.DERIV'
6524 include 'COMMON.INTERACT'
6525 include 'COMMON.CONTACTS'
6526 include 'COMMON.TORSION'
6527 include 'COMMON.VAR'
6528 include 'COMMON.GEO'
6529 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6535 C Parallel Antiparallel C
6541 C \ j|/k\| / \ |/k\|l / C
6546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6547 itk=itortyp(itype(k))
6548 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6549 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6550 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6551 call transpose2(EUgC(1,1,k),auxmat(1,1))
6552 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6553 vv1(1)=pizda1(1,1)-pizda1(2,2)
6554 vv1(2)=pizda1(1,2)+pizda1(2,1)
6555 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6556 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6557 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6558 s5=scalar2(vv(1),Dtobr2(1,i))
6559 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6560 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6561 if (.not. calc_grad) return
6562 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6563 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6564 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6565 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6566 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6567 & +scalar2(vv(1),Dtobr2der(1,i)))
6568 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6569 vv1(1)=pizda1(1,1)-pizda1(2,2)
6570 vv1(2)=pizda1(1,2)+pizda1(2,1)
6571 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6572 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6574 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6575 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6576 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6577 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6578 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6580 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6581 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6582 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6583 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6584 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6586 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6587 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6588 vv1(1)=pizda1(1,1)-pizda1(2,2)
6589 vv1(2)=pizda1(1,2)+pizda1(2,1)
6590 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6591 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6592 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6593 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6602 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6603 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6604 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6605 call transpose2(EUgC(1,1,k),auxmat(1,1))
6606 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6608 vv1(1)=pizda1(1,1)-pizda1(2,2)
6609 vv1(2)=pizda1(1,2)+pizda1(2,1)
6610 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6611 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6612 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6613 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6614 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6615 s5=scalar2(vv(1),Dtobr2(1,i))
6616 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6622 c----------------------------------------------------------------------------
6623 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6624 implicit real*8 (a-h,o-z)
6625 include 'DIMENSIONS'
6626 include 'sizesclu.dat'
6627 include 'COMMON.IOUNITS'
6628 include 'COMMON.CHAIN'
6629 include 'COMMON.DERIV'
6630 include 'COMMON.INTERACT'
6631 include 'COMMON.CONTACTS'
6632 include 'COMMON.TORSION'
6633 include 'COMMON.VAR'
6634 include 'COMMON.GEO'
6636 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6637 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6640 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6642 C Parallel Antiparallel C
6648 C \ j|/k\| \ |/k\|l C
6653 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6654 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6655 C AL 7/4/01 s1 would occur in the sixth-order moment,
6656 C but not in a cluster cumulant
6658 s1=dip(1,jj,i)*dip(1,kk,k)
6660 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6661 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6662 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6663 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6664 call transpose2(EUg(1,1,k),auxmat(1,1))
6665 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6666 vv(1)=pizda(1,1)-pizda(2,2)
6667 vv(2)=pizda(1,2)+pizda(2,1)
6668 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6669 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6671 eello6_graph2=-(s1+s2+s3+s4)
6673 eello6_graph2=-(s2+s3+s4)
6676 if (.not. calc_grad) return
6677 C Derivatives in gamma(i-1)
6680 s1=dipderg(1,jj,i)*dip(1,kk,k)
6682 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6683 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6684 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6685 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6687 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6689 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6691 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6693 C Derivatives in gamma(k-1)
6695 s1=dip(1,jj,i)*dipderg(1,kk,k)
6697 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6698 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6699 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6700 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6701 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6702 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6703 vv(1)=pizda(1,1)-pizda(2,2)
6704 vv(2)=pizda(1,2)+pizda(2,1)
6705 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6707 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6709 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6711 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6712 C Derivatives in gamma(j-1) or gamma(l-1)
6715 s1=dipderg(3,jj,i)*dip(1,kk,k)
6717 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6718 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6719 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6720 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6721 vv(1)=pizda(1,1)-pizda(2,2)
6722 vv(2)=pizda(1,2)+pizda(2,1)
6723 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6726 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6728 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6731 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6732 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6734 C Derivatives in gamma(l-1) or gamma(j-1)
6737 s1=dip(1,jj,i)*dipderg(3,kk,k)
6739 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6740 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6741 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6742 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6743 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6744 vv(1)=pizda(1,1)-pizda(2,2)
6745 vv(2)=pizda(1,2)+pizda(2,1)
6746 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6749 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6751 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6754 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6755 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6757 C Cartesian derivatives.
6759 write (2,*) 'In eello6_graph2'
6761 write (2,*) 'iii=',iii
6763 write (2,*) 'kkk=',kkk
6765 write (2,'(3(2f10.5),5x)')
6766 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6776 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6778 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6781 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6783 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6784 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6786 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6787 call transpose2(EUg(1,1,k),auxmat(1,1))
6788 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6790 vv(1)=pizda(1,1)-pizda(2,2)
6791 vv(2)=pizda(1,2)+pizda(2,1)
6792 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6793 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6795 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6797 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6800 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6802 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6809 c----------------------------------------------------------------------------
6810 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6811 implicit real*8 (a-h,o-z)
6812 include 'DIMENSIONS'
6813 include 'sizesclu.dat'
6814 include 'COMMON.IOUNITS'
6815 include 'COMMON.CHAIN'
6816 include 'COMMON.DERIV'
6817 include 'COMMON.INTERACT'
6818 include 'COMMON.CONTACTS'
6819 include 'COMMON.TORSION'
6820 include 'COMMON.VAR'
6821 include 'COMMON.GEO'
6822 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6824 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6826 C Parallel Antiparallel C
6832 C j|/k\| / |/k\|l / C
6837 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6839 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6840 C energy moment and not to the cluster cumulant.
6841 iti=itortyp(itype(i))
6842 if (j.lt.nres-1) then
6843 itj1=itortyp(itype(j+1))
6847 itk=itortyp(itype(k))
6848 itk1=itortyp(itype(k+1))
6849 if (l.lt.nres-1) then
6850 itl1=itortyp(itype(l+1))
6855 s1=dip(4,jj,i)*dip(4,kk,k)
6857 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6858 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6859 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6860 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6861 call transpose2(EE(1,1,itk),auxmat(1,1))
6862 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6863 vv(1)=pizda(1,1)+pizda(2,2)
6864 vv(2)=pizda(2,1)-pizda(1,2)
6865 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6866 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6868 eello6_graph3=-(s1+s2+s3+s4)
6870 eello6_graph3=-(s2+s3+s4)
6873 if (.not. calc_grad) return
6874 C Derivatives in gamma(k-1)
6875 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6876 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6877 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6878 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6879 C Derivatives in gamma(l-1)
6880 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6881 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6882 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6883 vv(1)=pizda(1,1)+pizda(2,2)
6884 vv(2)=pizda(2,1)-pizda(1,2)
6885 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6886 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6887 C Cartesian derivatives.
6893 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6895 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6898 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6900 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6901 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6903 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6904 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6906 vv(1)=pizda(1,1)+pizda(2,2)
6907 vv(2)=pizda(2,1)-pizda(1,2)
6908 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6910 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6912 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6915 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6917 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6919 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6925 c----------------------------------------------------------------------------
6926 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6927 implicit real*8 (a-h,o-z)
6928 include 'DIMENSIONS'
6929 include 'sizesclu.dat'
6930 include 'COMMON.IOUNITS'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.DERIV'
6933 include 'COMMON.INTERACT'
6934 include 'COMMON.CONTACTS'
6935 include 'COMMON.TORSION'
6936 include 'COMMON.VAR'
6937 include 'COMMON.GEO'
6938 include 'COMMON.FFIELD'
6939 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6940 & auxvec1(2),auxmat1(2,2)
6942 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6944 C Parallel Antiparallel C
6950 C \ j|/k\| \ |/k\|l C
6955 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6957 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6958 C energy moment and not to the cluster cumulant.
6959 cd write (2,*) 'eello_graph4: wturn6',wturn6
6960 iti=itortyp(itype(i))
6961 itj=itortyp(itype(j))
6962 if (j.lt.nres-1) then
6963 itj1=itortyp(itype(j+1))
6967 itk=itortyp(itype(k))
6968 if (k.lt.nres-1) then
6969 itk1=itortyp(itype(k+1))
6973 itl=itortyp(itype(l))
6974 if (l.lt.nres-1) then
6975 itl1=itortyp(itype(l+1))
6979 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6980 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6981 cd & ' itl',itl,' itl1',itl1
6984 s1=dip(3,jj,i)*dip(3,kk,k)
6986 s1=dip(2,jj,j)*dip(2,kk,l)
6989 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6990 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6992 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6993 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6995 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6996 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6998 call transpose2(EUg(1,1,k),auxmat(1,1))
6999 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7000 vv(1)=pizda(1,1)-pizda(2,2)
7001 vv(2)=pizda(2,1)+pizda(1,2)
7002 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7003 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7005 eello6_graph4=-(s1+s2+s3+s4)
7007 eello6_graph4=-(s2+s3+s4)
7009 if (.not. calc_grad) return
7010 C Derivatives in gamma(i-1)
7014 s1=dipderg(2,jj,i)*dip(3,kk,k)
7016 s1=dipderg(4,jj,j)*dip(2,kk,l)
7019 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7021 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7022 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7024 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7025 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7027 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7028 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7029 cd write (2,*) 'turn6 derivatives'
7031 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7033 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7037 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7039 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7043 C Derivatives in gamma(k-1)
7046 s1=dip(3,jj,i)*dipderg(2,kk,k)
7048 s1=dip(2,jj,j)*dipderg(4,kk,l)
7051 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7052 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7054 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7055 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7057 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7058 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7060 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7061 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7062 vv(1)=pizda(1,1)-pizda(2,2)
7063 vv(2)=pizda(2,1)+pizda(1,2)
7064 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7065 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7067 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7069 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7073 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7075 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7078 C Derivatives in gamma(j-1) or gamma(l-1)
7079 if (l.eq.j+1 .and. l.gt.1) then
7080 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7081 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7082 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7083 vv(1)=pizda(1,1)-pizda(2,2)
7084 vv(2)=pizda(2,1)+pizda(1,2)
7085 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7086 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7087 else if (j.gt.1) then
7088 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7089 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7090 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7091 vv(1)=pizda(1,1)-pizda(2,2)
7092 vv(2)=pizda(2,1)+pizda(1,2)
7093 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7094 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7095 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7097 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7100 C Cartesian derivatives.
7107 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7109 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7113 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7115 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7119 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7121 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7123 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7124 & b1(1,itj1),auxvec(1))
7125 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7127 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7128 & b1(1,itl1),auxvec(1))
7129 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7131 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7133 vv(1)=pizda(1,1)-pizda(2,2)
7134 vv(2)=pizda(2,1)+pizda(1,2)
7135 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7137 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7139 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7142 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7145 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7148 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7150 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7152 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7156 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7158 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7163 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7171 c----------------------------------------------------------------------------
7172 double precision function eello_turn6(i,jj,kk)
7173 implicit real*8 (a-h,o-z)
7174 include 'DIMENSIONS'
7175 include 'sizesclu.dat'
7176 include 'COMMON.IOUNITS'
7177 include 'COMMON.CHAIN'
7178 include 'COMMON.DERIV'
7179 include 'COMMON.INTERACT'
7180 include 'COMMON.CONTACTS'
7181 include 'COMMON.TORSION'
7182 include 'COMMON.VAR'
7183 include 'COMMON.GEO'
7184 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7185 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7187 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7188 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7189 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7190 C the respective energy moment and not to the cluster cumulant.
7195 iti=itortyp(itype(i))
7196 itk=itortyp(itype(k))
7197 itk1=itortyp(itype(k+1))
7198 itl=itortyp(itype(l))
7199 itj=itortyp(itype(j))
7200 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7201 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7202 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7207 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7209 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7213 derx_turn(lll,kkk,iii)=0.0d0
7220 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7222 cd write (2,*) 'eello6_5',eello6_5
7224 call transpose2(AEA(1,1,1),auxmat(1,1))
7225 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7226 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7227 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7231 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7232 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7233 s2 = scalar2(b1(1,itk),vtemp1(1))
7235 call transpose2(AEA(1,1,2),atemp(1,1))
7236 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7237 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7238 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7242 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7243 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7244 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7246 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7247 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7248 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7249 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7250 ss13 = scalar2(b1(1,itk),vtemp4(1))
7251 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7255 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7261 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7263 C Derivatives in gamma(i+2)
7265 call transpose2(AEA(1,1,1),auxmatd(1,1))
7266 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7267 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7268 call transpose2(AEAderg(1,1,2),atempd(1,1))
7269 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7270 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7274 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7275 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7276 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7282 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7283 C Derivatives in gamma(i+3)
7285 call transpose2(AEA(1,1,1),auxmatd(1,1))
7286 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7287 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7288 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7292 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7293 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7294 s2d = scalar2(b1(1,itk),vtemp1d(1))
7296 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7297 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7299 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7301 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7302 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7303 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7313 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7314 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7316 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7317 & -0.5d0*ekont*(s2d+s12d)
7319 C Derivatives in gamma(i+4)
7320 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7321 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7322 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7324 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7325 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7326 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7336 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7338 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7340 C Derivatives in gamma(i+5)
7342 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7343 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7344 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7348 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7349 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7350 s2d = scalar2(b1(1,itk),vtemp1d(1))
7352 call transpose2(AEA(1,1,2),atempd(1,1))
7353 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7354 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7358 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7359 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7361 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7362 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7363 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7373 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7374 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7376 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7377 & -0.5d0*ekont*(s2d+s12d)
7379 C Cartesian derivatives
7384 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7385 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7386 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7390 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7391 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7393 s2d = scalar2(b1(1,itk),vtemp1d(1))
7395 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7396 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7397 s8d = -(atempd(1,1)+atempd(2,2))*
7398 & scalar2(cc(1,1,itl),vtemp2(1))
7402 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7404 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7405 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7412 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7415 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7419 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7420 & - 0.5d0*(s8d+s12d)
7422 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7431 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7433 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7434 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7435 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7436 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7437 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7439 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7440 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7441 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7445 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7446 cd & 16*eel_turn6_num
7448 if (j.lt.nres-1) then
7455 if (l.lt.nres-1) then
7463 ggg1(ll)=eel_turn6*g_contij(ll,1)
7464 ggg2(ll)=eel_turn6*g_contij(ll,2)
7465 ghalf=0.5d0*ggg1(ll)
7467 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7468 & +ekont*derx_turn(ll,2,1)
7469 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7470 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7471 & +ekont*derx_turn(ll,4,1)
7472 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7473 ghalf=0.5d0*ggg2(ll)
7475 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7476 & +ekont*derx_turn(ll,2,2)
7477 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7478 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7479 & +ekont*derx_turn(ll,4,2)
7480 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7485 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7490 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7496 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7501 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7505 cd write (2,*) iii,g_corr6_loc(iii)
7508 eello_turn6=ekont*eel_turn6
7509 cd write (2,*) 'ekont',ekont
7510 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7513 crc-------------------------------------------------
7514 SUBROUTINE MATVEC2(A1,V1,V2)
7515 implicit real*8 (a-h,o-z)
7516 include 'DIMENSIONS'
7517 DIMENSION A1(2,2),V1(2),V2(2)
7521 c 3 VI=VI+A1(I,K)*V1(K)
7525 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7526 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7531 C---------------------------------------
7532 SUBROUTINE MATMAT2(A1,A2,A3)
7533 implicit real*8 (a-h,o-z)
7534 include 'DIMENSIONS'
7535 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7536 c DIMENSION AI3(2,2)
7540 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7546 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7547 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7548 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7549 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7557 c-------------------------------------------------------------------------
7558 double precision function scalar2(u,v)
7560 double precision u(2),v(2)
7563 scalar2=u(1)*v(1)+u(2)*v(2)
7567 C-----------------------------------------------------------------------------
7569 subroutine transpose2(a,at)
7571 double precision a(2,2),at(2,2)
7578 c--------------------------------------------------------------------------
7579 subroutine transpose(n,a,at)
7582 double precision a(n,n),at(n,n)
7590 C---------------------------------------------------------------------------
7591 subroutine prodmat3(a1,a2,kk,transp,prod)
7594 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7596 crc double precision auxmat(2,2),prod_(2,2)
7599 crc call transpose2(kk(1,1),auxmat(1,1))
7600 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7601 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7603 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7604 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7605 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7606 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7607 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7608 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7609 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7610 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7613 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7614 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7616 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7617 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7618 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7619 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7620 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7621 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7622 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7623 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7626 c call transpose2(a2(1,1),a2t(1,1))
7629 crc print *,((prod_(i,j),i=1,2),j=1,2)
7630 crc print *,((prod(i,j),i=1,2),j=1,2)
7634 C-----------------------------------------------------------------------------
7635 double precision function scalar(u,v)
7637 double precision u(3),v(3)
7647 C-----------------------------------------------------------------------
7648 double precision function sscale(r)
7649 double precision r,gamm
7650 include "COMMON.SPLITELE"
7651 if(r.lt.r_cut-rlamb) then
7653 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7654 gamm=(r-(r_cut-rlamb))/rlamb
7655 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7661 C-----------------------------------------------------------------------
7662 C-----------------------------------------------------------------------
7663 double precision function sscagrad(r)
7664 double precision r,gamm
7665 include "COMMON.SPLITELE"
7666 if(r.lt.r_cut-rlamb) then
7668 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7669 gamm=(r-(r_cut-rlamb))/rlamb
7670 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7676 C-----------------------------------------------------------------------