1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 c & +wsccor*fact(1)*gsccor_loc(i)
235 if (dyn_ss) call dyn_set_nss
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'sizesclu.dat'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'sizesclu.dat'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.SBRIDGE'
357 include 'COMMON.NAMES'
358 include 'COMMON.IOUNITS'
359 include 'COMMON.CONTACTS'
363 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
364 c ROZNICA DODANE Z WHAM
367 c eneps_temp(j,i)=0.0d0
376 if (itypi.eq.ntyp1) cycle
377 itypi1=iabs(itype(i+1))
384 C Calculate SC interaction energy.
387 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
388 cd & 'iend=',iend(i,iint)
389 do j=istart(i,iint),iend(i,iint)
391 if (itypj.eq.ntyp1) cycle
395 C Change 12/1/95 to calculate four-body interactions
396 rij=xj*xj+yj*yj+zj*zj
398 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
399 eps0ij=eps(itypi,itypj)
401 e1=fac*fac*aa(itypi,itypj)
402 e2=fac*bb(itypi,itypj)
404 ij=icant(itypi,itypj)
406 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
407 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
410 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
411 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
412 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
413 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
414 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
415 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
416 if (bb(itypi,itypj).gt.0.0d0) then
423 C Calculate the components of the gradient in DC and X
425 fac=-rrij*(e1+evdwij)
430 gvdwx(k,i)=gvdwx(k,i)-gg(k)
431 gvdwx(k,j)=gvdwx(k,j)+gg(k)
435 gvdwc(l,k)=gvdwc(l,k)+gg(l)
440 C 12/1/95, revised on 5/20/97
442 C Calculate the contact function. The ith column of the array JCONT will
443 C contain the numbers of atoms that make contacts with the atom I (of numbers
444 C greater than I). The arrays FACONT and GACONT will contain the values of
445 C the contact function and its derivative.
447 C Uncomment next line, if the correlation interactions include EVDW explicitly.
448 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
449 C Uncomment next line, if the correlation interactions are contact function only
450 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
452 sigij=sigma(itypi,itypj)
453 r0ij=rs0(itypi,itypj)
455 C Check whether the SC's are not too far to make a contact.
458 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
459 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
461 if (fcont.gt.0.0D0) then
462 C If the SC-SC distance if close to sigma, apply spline.
463 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
464 cAdam & fcont1,fprimcont1)
465 cAdam fcont1=1.0d0-fcont1
466 cAdam if (fcont1.gt.0.0d0) then
467 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
468 cAdam fcont=fcont*fcont1
470 C Uncomment following 4 lines to have the geometric average of the epsilon0's
471 cga eps0ij=1.0d0/dsqrt(eps0ij)
473 cga gg(k)=gg(k)*eps0ij
475 cga eps0ij=-evdwij*eps0ij
476 C Uncomment for AL's type of SC correlation interactions.
478 num_conti=num_conti+1
480 facont(num_conti,i)=fcont*eps0ij
481 fprimcont=eps0ij*fprimcont/rij
483 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
484 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
485 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
486 C Uncomment following 3 lines for Skolnick's type of SC correlation.
487 gacont(1,num_conti,i)=-fprimcont*xj
488 gacont(2,num_conti,i)=-fprimcont*yj
489 gacont(3,num_conti,i)=-fprimcont*zj
490 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
491 cd write (iout,'(2i3,3f10.5)')
492 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
498 num_cont(i)=num_conti
503 gvdwc(j,i)=expon*gvdwc(j,i)
504 gvdwx(j,i)=expon*gvdwx(j,i)
508 C******************************************************************************
512 C To save time, the factor of EXPON has been extracted from ALL components
513 C of GVDWC and GRADX. Remember to multiply them by this factor before further
516 C******************************************************************************
519 C-----------------------------------------------------------------------------
520 subroutine eljk(evdw,evdw_t)
522 C This subroutine calculates the interaction energy of nonbonded side chains
523 C assuming the LJK potential of interaction.
525 implicit real*8 (a-h,o-z)
527 include 'sizesclu.dat'
528 include "DIMENSIONS.COMPAR"
531 include 'COMMON.LOCAL'
532 include 'COMMON.CHAIN'
533 include 'COMMON.DERIV'
534 include 'COMMON.INTERACT'
535 include 'COMMON.IOUNITS'
536 include 'COMMON.NAMES'
541 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
546 if (itypi.eq.ntyp1) cycle
547 itypi1=iabs(itype(i+1))
552 C Calculate SC interaction energy.
555 do j=istart(i,iint),iend(i,iint)
557 if (itypj.eq.ntyp1) cycle
561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
563 e_augm=augm(itypi,itypj)*fac_augm
566 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
567 fac=r_shift_inv**expon
568 e1=fac*fac*aa(itypi,itypj)
569 e2=fac*bb(itypi,itypj)
571 ij=icant(itypi,itypj)
572 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
573 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
574 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
575 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
576 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
577 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
578 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
579 if (bb(itypi,itypj).gt.0.0d0) then
586 C Calculate the components of the gradient in DC and X
588 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
593 gvdwx(k,i)=gvdwx(k,i)-gg(k)
594 gvdwx(k,j)=gvdwx(k,j)+gg(k)
598 gvdwc(l,k)=gvdwc(l,k)+gg(l)
608 gvdwc(j,i)=expon*gvdwc(j,i)
609 gvdwx(j,i)=expon*gvdwx(j,i)
615 C-----------------------------------------------------------------------------
616 subroutine ebp(evdw,evdw_t)
618 C This subroutine calculates the interaction energy of nonbonded side chains
619 C assuming the Berne-Pechukas potential of interaction.
621 implicit real*8 (a-h,o-z)
623 include 'sizesclu.dat'
624 include "DIMENSIONS.COMPAR"
627 include 'COMMON.LOCAL'
628 include 'COMMON.CHAIN'
629 include 'COMMON.DERIV'
630 include 'COMMON.NAMES'
631 include 'COMMON.INTERACT'
632 include 'COMMON.IOUNITS'
633 include 'COMMON.CALC'
635 c double precision rrsave(maxdim)
641 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
642 c if (icall.eq.0) then
650 if (itypi.eq.ntyp1) cycle
651 itypi1=iabs(itype(i+1))
655 dxi=dc_norm(1,nres+i)
656 dyi=dc_norm(2,nres+i)
657 dzi=dc_norm(3,nres+i)
658 dsci_inv=vbld_inv(i+nres)
660 C Calculate SC interaction energy.
663 do j=istart(i,iint),iend(i,iint)
666 if (itypj.eq.ntyp1) cycle
667 dscj_inv=vbld_inv(j+nres)
668 chi1=chi(itypi,itypj)
669 chi2=chi(itypj,itypi)
676 alf12=0.5D0*(alf1+alf2)
677 C For diagnostics only!!!
690 dxj=dc_norm(1,nres+j)
691 dyj=dc_norm(2,nres+j)
692 dzj=dc_norm(3,nres+j)
693 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
694 cd if (icall.eq.0) then
700 C Calculate the angle-dependent terms of energy & contributions to derivatives.
702 C Calculate whole angle-dependent part of epsilon and contributions
704 fac=(rrij*sigsq)**expon2
705 e1=fac*fac*aa(itypi,itypj)
706 e2=fac*bb(itypi,itypj)
707 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
708 eps2der=evdwij*eps3rt
709 eps3der=evdwij*eps2rt
710 evdwij=evdwij*eps2rt*eps3rt
711 ij=icant(itypi,itypj)
712 aux=eps1*eps2rt**2*eps3rt**2
713 if (bb(itypi,itypj).gt.0.0d0) then
720 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
721 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
722 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
723 cd & restyp(itypi),i,restyp(itypj),j,
724 cd & epsi,sigm,chi1,chi2,chip1,chip2,
725 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
726 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
729 C Calculate gradient components.
730 e1=e1*eps1*eps2rt**2*eps3rt**2
731 fac=-expon*(e1+evdwij)
734 C Calculate radial part of the gradient
738 C Calculate the angular part of the gradient and sum add the contributions
739 C to the appropriate components of the Cartesian gradient.
748 C-----------------------------------------------------------------------------
749 subroutine egb(evdw,evdw_t)
751 C This subroutine calculates the interaction energy of nonbonded side chains
752 C assuming the Gay-Berne potential of interaction.
754 implicit real*8 (a-h,o-z)
756 include 'sizesclu.dat'
757 include "DIMENSIONS.COMPAR"
760 include 'COMMON.LOCAL'
761 include 'COMMON.CHAIN'
762 include 'COMMON.DERIV'
763 include 'COMMON.NAMES'
764 include 'COMMON.INTERACT'
765 include 'COMMON.IOUNITS'
766 include 'COMMON.CALC'
767 include 'COMMON.SBRIDGE'
772 logical energy_dec /.true./
773 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
777 c if (icall.gt.0) lprn=.true.
781 if (itypi.eq.ntyp1) cycle
782 itypi1=iabs(itype(i+1))
786 dxi=dc_norm(1,nres+i)
787 dyi=dc_norm(2,nres+i)
788 dzi=dc_norm(3,nres+i)
789 dsci_inv=vbld_inv(i+nres)
791 C Calculate SC interaction energy.
794 do j=istart(i,iint),iend(i,iint)
795 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
797 c write(iout,*) "PRZED ZWYKLE", evdwij
798 call dyn_ssbond_ene(i,j,evdwij)
799 c write(iout,*) "PO ZWYKLE", evdwij
802 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
803 & 'evdw',i,j,evdwij,' ss'
804 C triple bond artifac removal
805 do k=j+1,iend(i,iint)
806 C search over all next residues
807 if (dyn_ss_mask(k)) then
808 C check if they are cysteins
809 C write(iout,*) 'k=',k
811 c write(iout,*) "PRZED TRI", evdwij
812 evdwij_przed_tri=evdwij
813 call triple_ssbond_ene(i,j,k,evdwij)
814 c if(evdwij_przed_tri.ne.evdwij) then
815 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
818 c write(iout,*) "PO TRI", evdwij
819 C call the energy function that removes the artifical triple disulfide
820 C bond the soubroutine is located in ssMD.F
822 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
823 & 'evdw',i,j,evdwij,'tss'
829 if (itypj.eq.ntyp1) cycle
830 dscj_inv=vbld_inv(j+nres)
831 sig0ij=sigma(itypi,itypj)
832 chi1=chi(itypi,itypj)
833 chi2=chi(itypj,itypi)
840 alf12=0.5D0*(alf1+alf2)
841 C For diagnostics only!!!
854 dxj=dc_norm(1,nres+j)
855 dyj=dc_norm(2,nres+j)
856 dzj=dc_norm(3,nres+j)
857 c write (iout,*) i,j,xj,yj,zj
858 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
860 C Calculate angle-dependent terms of energy and contributions to their
864 sig=sig0ij*dsqrt(sigsq)
865 rij_shift=1.0D0/rij-sig+sig0ij
866 C I hate to put IF's in the loops, but here don't have another choice!!!!
867 if (rij_shift.le.0.0D0) then
872 c---------------------------------------------------------------
873 rij_shift=1.0D0/rij_shift
875 e1=fac*fac*aa(itypi,itypj)
876 e2=fac*bb(itypi,itypj)
877 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
878 eps2der=evdwij*eps3rt
879 eps3der=evdwij*eps2rt
880 evdwij=evdwij*eps2rt*eps3rt
881 if (bb(itypi,itypj).gt.0) then
886 ij=icant(itypi,itypj)
887 aux=eps1*eps2rt**2*eps3rt**2
888 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
889 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
890 c & aux*e2/eps(itypi,itypj)
892 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
893 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
894 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
895 c & restyp(itypi),i,restyp(itypj),j,
896 c & epsi,sigm,chi1,chi2,chip1,chip2,
897 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
898 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
900 c write (iout,*) "pratial sum", evdw,evdw_t
903 C Calculate gradient components.
904 e1=e1*eps1*eps2rt**2*eps3rt**2
905 fac=-expon*(e1+evdwij)*rij_shift
908 C Calculate the radial part of the gradient
912 C Calculate angular part of the gradient.
921 C-----------------------------------------------------------------------------
922 subroutine egbv(evdw,evdw_t)
924 C This subroutine calculates the interaction energy of nonbonded side chains
925 C assuming the Gay-Berne-Vorobjev potential of interaction.
927 implicit real*8 (a-h,o-z)
929 include 'sizesclu.dat'
930 include "DIMENSIONS.COMPAR"
933 include 'COMMON.LOCAL'
934 include 'COMMON.CHAIN'
935 include 'COMMON.DERIV'
936 include 'COMMON.NAMES'
937 include 'COMMON.INTERACT'
938 include 'COMMON.IOUNITS'
939 include 'COMMON.CALC'
946 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
949 c if (icall.gt.0) lprn=.true.
953 if (itypi.eq.ntyp1) cycle
954 itypi1=iabs(itype(i+1))
958 dxi=dc_norm(1,nres+i)
959 dyi=dc_norm(2,nres+i)
960 dzi=dc_norm(3,nres+i)
961 dsci_inv=vbld_inv(i+nres)
963 C Calculate SC interaction energy.
966 do j=istart(i,iint),iend(i,iint)
969 if (itypj.eq.ntyp1) cycle
970 dscj_inv=vbld_inv(j+nres)
971 sig0ij=sigma(itypi,itypj)
973 chi1=chi(itypi,itypj)
974 chi2=chi(itypj,itypi)
981 alf12=0.5D0*(alf1+alf2)
982 C For diagnostics only!!!
995 dxj=dc_norm(1,nres+j)
996 dyj=dc_norm(2,nres+j)
997 dzj=dc_norm(3,nres+j)
998 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1000 C Calculate angle-dependent terms of energy and contributions to their
1004 sig=sig0ij*dsqrt(sigsq)
1005 rij_shift=1.0D0/rij-sig+r0ij
1006 C I hate to put IF's in the loops, but here don't have another choice!!!!
1007 if (rij_shift.le.0.0D0) then
1012 c---------------------------------------------------------------
1013 rij_shift=1.0D0/rij_shift
1014 fac=rij_shift**expon
1015 e1=fac*fac*aa(itypi,itypj)
1016 e2=fac*bb(itypi,itypj)
1017 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1018 eps2der=evdwij*eps3rt
1019 eps3der=evdwij*eps2rt
1020 fac_augm=rrij**expon
1021 e_augm=augm(itypi,itypj)*fac_augm
1022 evdwij=evdwij*eps2rt*eps3rt
1023 if (bb(itypi,itypj).gt.0.0d0) then
1024 evdw=evdw+evdwij+e_augm
1026 evdw_t=evdw_t+evdwij+e_augm
1028 ij=icant(itypi,itypj)
1029 aux=eps1*eps2rt**2*eps3rt**2
1031 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1032 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1033 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1034 c & restyp(itypi),i,restyp(itypj),j,
1035 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1036 c & chi1,chi2,chip1,chip2,
1037 c & eps1,eps2rt**2,eps3rt**2,
1038 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1042 C Calculate gradient components.
1043 e1=e1*eps1*eps2rt**2*eps3rt**2
1044 fac=-expon*(e1+evdwij)*rij_shift
1046 fac=rij*fac-2*expon*rrij*e_augm
1047 C Calculate the radial part of the gradient
1051 C Calculate angular part of the gradient.
1059 C-----------------------------------------------------------------------------
1060 subroutine sc_angular
1061 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1062 C om12. Called by ebp, egb, and egbv.
1064 include 'COMMON.CALC'
1068 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1069 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1070 om12=dxi*dxj+dyi*dyj+dzi*dzj
1072 C Calculate eps1(om12) and its derivative in om12
1073 faceps1=1.0D0-om12*chiom12
1074 faceps1_inv=1.0D0/faceps1
1075 eps1=dsqrt(faceps1_inv)
1076 C Following variable is eps1*deps1/dom12
1077 eps1_om12=faceps1_inv*chiom12
1078 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1083 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1084 sigsq=1.0D0-facsig*faceps1_inv
1085 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1086 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1087 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1088 C Calculate eps2 and its derivatives in om1, om2, and om12.
1091 chipom12=chip12*om12
1092 facp=1.0D0-om12*chipom12
1094 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1095 C Following variable is the square root of eps2
1096 eps2rt=1.0D0-facp1*facp_inv
1097 C Following three variables are the derivatives of the square root of eps
1098 C in om1, om2, and om12.
1099 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1100 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1101 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1102 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1103 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1104 C Calculate whole angle-dependent part of epsilon and contributions
1105 C to its derivatives
1108 C----------------------------------------------------------------------------
1110 implicit real*8 (a-h,o-z)
1111 include 'DIMENSIONS'
1112 include 'sizesclu.dat'
1113 include 'COMMON.CHAIN'
1114 include 'COMMON.DERIV'
1115 include 'COMMON.CALC'
1116 double precision dcosom1(3),dcosom2(3)
1117 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1118 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1119 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1120 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1122 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1123 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1126 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1129 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1130 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1131 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1132 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1133 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1134 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1137 C Calculate the components of the gradient in DC and X
1141 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1146 c------------------------------------------------------------------------------
1147 subroutine vec_and_deriv
1148 implicit real*8 (a-h,o-z)
1149 include 'DIMENSIONS'
1150 include 'sizesclu.dat'
1151 include 'COMMON.IOUNITS'
1152 include 'COMMON.GEO'
1153 include 'COMMON.VAR'
1154 include 'COMMON.LOCAL'
1155 include 'COMMON.CHAIN'
1156 include 'COMMON.VECTORS'
1157 include 'COMMON.DERIV'
1158 include 'COMMON.INTERACT'
1159 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1160 C Compute the local reference systems. For reference system (i), the
1161 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1162 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1164 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1165 if (i.eq.nres-1) then
1166 C Case of the last full residue
1167 C Compute the Z-axis
1168 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1169 costh=dcos(pi-theta(nres))
1170 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1175 C Compute the derivatives of uz
1177 uzder(2,1,1)=-dc_norm(3,i-1)
1178 uzder(3,1,1)= dc_norm(2,i-1)
1179 uzder(1,2,1)= dc_norm(3,i-1)
1181 uzder(3,2,1)=-dc_norm(1,i-1)
1182 uzder(1,3,1)=-dc_norm(2,i-1)
1183 uzder(2,3,1)= dc_norm(1,i-1)
1186 uzder(2,1,2)= dc_norm(3,i)
1187 uzder(3,1,2)=-dc_norm(2,i)
1188 uzder(1,2,2)=-dc_norm(3,i)
1190 uzder(3,2,2)= dc_norm(1,i)
1191 uzder(1,3,2)= dc_norm(2,i)
1192 uzder(2,3,2)=-dc_norm(1,i)
1195 C Compute the Y-axis
1198 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1201 C Compute the derivatives of uy
1204 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1205 & -dc_norm(k,i)*dc_norm(j,i-1)
1206 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1208 uyder(j,j,1)=uyder(j,j,1)-costh
1209 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1214 uygrad(l,k,j,i)=uyder(l,k,j)
1215 uzgrad(l,k,j,i)=uzder(l,k,j)
1219 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1220 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1221 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1222 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1226 C Compute the Z-axis
1227 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1228 costh=dcos(pi-theta(i+2))
1229 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1234 C Compute the derivatives of uz
1236 uzder(2,1,1)=-dc_norm(3,i+1)
1237 uzder(3,1,1)= dc_norm(2,i+1)
1238 uzder(1,2,1)= dc_norm(3,i+1)
1240 uzder(3,2,1)=-dc_norm(1,i+1)
1241 uzder(1,3,1)=-dc_norm(2,i+1)
1242 uzder(2,3,1)= dc_norm(1,i+1)
1245 uzder(2,1,2)= dc_norm(3,i)
1246 uzder(3,1,2)=-dc_norm(2,i)
1247 uzder(1,2,2)=-dc_norm(3,i)
1249 uzder(3,2,2)= dc_norm(1,i)
1250 uzder(1,3,2)= dc_norm(2,i)
1251 uzder(2,3,2)=-dc_norm(1,i)
1254 C Compute the Y-axis
1257 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1260 C Compute the derivatives of uy
1263 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1264 & -dc_norm(k,i)*dc_norm(j,i+1)
1265 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1267 uyder(j,j,1)=uyder(j,j,1)-costh
1268 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1273 uygrad(l,k,j,i)=uyder(l,k,j)
1274 uzgrad(l,k,j,i)=uzder(l,k,j)
1278 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1279 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1280 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1281 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1287 vbld_inv_temp(1)=vbld_inv(i+1)
1288 if (i.lt.nres-1) then
1289 vbld_inv_temp(2)=vbld_inv(i+2)
1291 vbld_inv_temp(2)=vbld_inv(i)
1296 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1297 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1305 C-----------------------------------------------------------------------------
1306 subroutine vec_and_deriv_test
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1309 include 'sizesclu.dat'
1310 include 'COMMON.IOUNITS'
1311 include 'COMMON.GEO'
1312 include 'COMMON.VAR'
1313 include 'COMMON.LOCAL'
1314 include 'COMMON.CHAIN'
1315 include 'COMMON.VECTORS'
1316 dimension uyder(3,3,2),uzder(3,3,2)
1317 C Compute the local reference systems. For reference system (i), the
1318 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1319 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1321 if (i.eq.nres-1) then
1322 C Case of the last full residue
1323 C Compute the Z-axis
1324 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1325 costh=dcos(pi-theta(nres))
1326 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1327 c write (iout,*) 'fac',fac,
1328 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1329 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1333 C Compute the derivatives of uz
1335 uzder(2,1,1)=-dc_norm(3,i-1)
1336 uzder(3,1,1)= dc_norm(2,i-1)
1337 uzder(1,2,1)= dc_norm(3,i-1)
1339 uzder(3,2,1)=-dc_norm(1,i-1)
1340 uzder(1,3,1)=-dc_norm(2,i-1)
1341 uzder(2,3,1)= dc_norm(1,i-1)
1344 uzder(2,1,2)= dc_norm(3,i)
1345 uzder(3,1,2)=-dc_norm(2,i)
1346 uzder(1,2,2)=-dc_norm(3,i)
1348 uzder(3,2,2)= dc_norm(1,i)
1349 uzder(1,3,2)= dc_norm(2,i)
1350 uzder(2,3,2)=-dc_norm(1,i)
1352 C Compute the Y-axis
1354 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1357 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1358 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1359 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1361 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1364 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1365 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1368 c write (iout,*) 'facy',facy,
1369 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1370 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1372 uy(k,i)=facy*uy(k,i)
1374 C Compute the derivatives of uy
1377 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1378 & -dc_norm(k,i)*dc_norm(j,i-1)
1379 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1381 c uyder(j,j,1)=uyder(j,j,1)-costh
1382 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1383 uyder(j,j,1)=uyder(j,j,1)
1384 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1385 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1391 uygrad(l,k,j,i)=uyder(l,k,j)
1392 uzgrad(l,k,j,i)=uzder(l,k,j)
1396 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1397 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1398 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1399 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1402 C Compute the Z-axis
1403 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1404 costh=dcos(pi-theta(i+2))
1405 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1406 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1410 C Compute the derivatives of uz
1412 uzder(2,1,1)=-dc_norm(3,i+1)
1413 uzder(3,1,1)= dc_norm(2,i+1)
1414 uzder(1,2,1)= dc_norm(3,i+1)
1416 uzder(3,2,1)=-dc_norm(1,i+1)
1417 uzder(1,3,1)=-dc_norm(2,i+1)
1418 uzder(2,3,1)= dc_norm(1,i+1)
1421 uzder(2,1,2)= dc_norm(3,i)
1422 uzder(3,1,2)=-dc_norm(2,i)
1423 uzder(1,2,2)=-dc_norm(3,i)
1425 uzder(3,2,2)= dc_norm(1,i)
1426 uzder(1,3,2)= dc_norm(2,i)
1427 uzder(2,3,2)=-dc_norm(1,i)
1429 C Compute the Y-axis
1431 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1432 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1433 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1435 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1438 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1439 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1442 c write (iout,*) 'facy',facy,
1443 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1444 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1446 uy(k,i)=facy*uy(k,i)
1448 C Compute the derivatives of uy
1451 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1452 & -dc_norm(k,i)*dc_norm(j,i+1)
1453 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1455 c uyder(j,j,1)=uyder(j,j,1)-costh
1456 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1457 uyder(j,j,1)=uyder(j,j,1)
1458 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1459 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1465 uygrad(l,k,j,i)=uyder(l,k,j)
1466 uzgrad(l,k,j,i)=uzder(l,k,j)
1470 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1471 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1472 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1473 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1480 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1481 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1488 C-----------------------------------------------------------------------------
1489 subroutine check_vecgrad
1490 implicit real*8 (a-h,o-z)
1491 include 'DIMENSIONS'
1492 include 'sizesclu.dat'
1493 include 'COMMON.IOUNITS'
1494 include 'COMMON.GEO'
1495 include 'COMMON.VAR'
1496 include 'COMMON.LOCAL'
1497 include 'COMMON.CHAIN'
1498 include 'COMMON.VECTORS'
1499 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1500 dimension uyt(3,maxres),uzt(3,maxres)
1501 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1502 double precision delta /1.0d-7/
1505 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1506 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1507 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1508 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1509 cd & (dc_norm(if90,i),if90=1,3)
1510 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1511 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1512 cd write(iout,'(a)')
1518 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1519 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1532 cd write (iout,*) 'i=',i
1534 erij(k)=dc_norm(k,i)
1538 dc_norm(k,i)=erij(k)
1540 dc_norm(j,i)=dc_norm(j,i)+delta
1541 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1543 c dc_norm(k,i)=dc_norm(k,i)/fac
1545 c write (iout,*) (dc_norm(k,i),k=1,3)
1546 c write (iout,*) (erij(k),k=1,3)
1549 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1550 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1551 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1552 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1554 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1555 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1556 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1559 dc_norm(k,i)=erij(k)
1562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1563 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1564 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1565 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1566 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1567 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1568 cd write (iout,'(a)')
1573 C--------------------------------------------------------------------------
1574 subroutine set_matrices
1575 implicit real*8 (a-h,o-z)
1576 include 'DIMENSIONS'
1577 include 'sizesclu.dat'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.GEO'
1580 include 'COMMON.VAR'
1581 include 'COMMON.LOCAL'
1582 include 'COMMON.CHAIN'
1583 include 'COMMON.DERIV'
1584 include 'COMMON.INTERACT'
1585 include 'COMMON.CONTACTS'
1586 include 'COMMON.TORSION'
1587 include 'COMMON.VECTORS'
1588 include 'COMMON.FFIELD'
1589 double precision auxvec(2),auxmat(2,2)
1591 C Compute the virtual-bond-torsional-angle dependent quantities needed
1592 C to calculate the el-loc multibody terms of various order.
1595 if (i .lt. nres+1) then
1632 if (i .gt. 3 .and. i .lt. nres+1) then
1633 obrot_der(1,i-2)=-sin1
1634 obrot_der(2,i-2)= cos1
1635 Ugder(1,1,i-2)= sin1
1636 Ugder(1,2,i-2)=-cos1
1637 Ugder(2,1,i-2)=-cos1
1638 Ugder(2,2,i-2)=-sin1
1641 obrot2_der(1,i-2)=-dwasin2
1642 obrot2_der(2,i-2)= dwacos2
1643 Ug2der(1,1,i-2)= dwasin2
1644 Ug2der(1,2,i-2)=-dwacos2
1645 Ug2der(2,1,i-2)=-dwacos2
1646 Ug2der(2,2,i-2)=-dwasin2
1648 obrot_der(1,i-2)=0.0d0
1649 obrot_der(2,i-2)=0.0d0
1650 Ugder(1,1,i-2)=0.0d0
1651 Ugder(1,2,i-2)=0.0d0
1652 Ugder(2,1,i-2)=0.0d0
1653 Ugder(2,2,i-2)=0.0d0
1654 obrot2_der(1,i-2)=0.0d0
1655 obrot2_der(2,i-2)=0.0d0
1656 Ug2der(1,1,i-2)=0.0d0
1657 Ug2der(1,2,i-2)=0.0d0
1658 Ug2der(2,1,i-2)=0.0d0
1659 Ug2der(2,2,i-2)=0.0d0
1661 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1662 if (itype(i-2).le.ntyp) then
1663 iti = itortyp(itype(i-2))
1670 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1671 if (itype(i-1).le.ntyp) then
1672 iti1 = itortyp(itype(i-1))
1679 cd write (iout,*) '*******i',i,' iti1',iti
1680 cd write (iout,*) 'b1',b1(:,iti)
1681 cd write (iout,*) 'b2',b2(:,iti)
1682 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1683 c print *,"itilde1 i iti iti1",i,iti,iti1
1684 if (i .gt. iatel_s+2) then
1685 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1686 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1687 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1688 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1689 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1690 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1691 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1701 DtUg2(l,k,i-2)=0.0d0
1705 c print *,"itilde2 i iti iti1",i,iti,iti1
1706 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1707 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1708 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1709 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1710 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1711 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1712 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1713 c print *,"itilde3 i iti iti1",i,iti,iti1
1715 muder(k,i-2)=Ub2der(k,i-2)
1717 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1718 if (itype(i-1).le.ntyp) then
1719 iti1 = itortyp(itype(i-1))
1727 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1729 C Vectors and matrices dependent on a single virtual-bond dihedral.
1730 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1731 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1732 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1733 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1734 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1735 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1736 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1737 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1738 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1739 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1740 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1742 C Matrices dependent on two consecutive virtual-bond dihedrals.
1743 C The order of matrices is from left to right.
1745 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1746 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1747 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1748 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1749 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1750 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1751 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1752 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1755 cd iti = itortyp(itype(i))
1758 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1759 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1764 C--------------------------------------------------------------------------
1765 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1767 C This subroutine calculates the average interaction energy and its gradient
1768 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1769 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1770 C The potential depends both on the distance of peptide-group centers and on
1771 C the orientation of the CA-CA virtual bonds.
1773 implicit real*8 (a-h,o-z)
1774 include 'DIMENSIONS'
1775 include 'sizesclu.dat'
1776 include 'COMMON.CONTROL'
1777 include 'COMMON.IOUNITS'
1778 include 'COMMON.GEO'
1779 include 'COMMON.VAR'
1780 include 'COMMON.LOCAL'
1781 include 'COMMON.CHAIN'
1782 include 'COMMON.DERIV'
1783 include 'COMMON.INTERACT'
1784 include 'COMMON.CONTACTS'
1785 include 'COMMON.TORSION'
1786 include 'COMMON.VECTORS'
1787 include 'COMMON.FFIELD'
1788 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1789 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1790 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1791 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1792 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1793 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1794 double precision scal_el /0.5d0/
1796 C 13-go grudnia roku pamietnego...
1797 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1798 & 0.0d0,1.0d0,0.0d0,
1799 & 0.0d0,0.0d0,1.0d0/
1800 cd write(iout,*) 'In EELEC'
1802 cd write(iout,*) 'Type',i
1803 cd write(iout,*) 'B1',B1(:,i)
1804 cd write(iout,*) 'B2',B2(:,i)
1805 cd write(iout,*) 'CC',CC(:,:,i)
1806 cd write(iout,*) 'DD',DD(:,:,i)
1807 cd write(iout,*) 'EE',EE(:,:,i)
1809 cd call check_vecgrad
1811 if (icheckgrad.eq.1) then
1813 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1815 dc_norm(k,i)=dc(k,i)*fac
1817 c write (iout,*) 'i',i,' fac',fac
1820 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1821 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1822 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1823 cd if (wel_loc.gt.0.0d0) then
1824 if (icheckgrad.eq.1) then
1825 call vec_and_deriv_test
1832 cd write (iout,*) 'i=',i
1834 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1837 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1838 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1851 cd print '(a)','Enter EELEC'
1852 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1854 gel_loc_loc(i)=0.0d0
1857 do i=iatel_s,iatel_e
1858 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1859 if (itel(i).eq.0) goto 1215
1863 dx_normi=dc_norm(1,i)
1864 dy_normi=dc_norm(2,i)
1865 dz_normi=dc_norm(3,i)
1866 xmedi=c(1,i)+0.5d0*dxi
1867 ymedi=c(2,i)+0.5d0*dyi
1868 zmedi=c(3,i)+0.5d0*dzi
1870 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1871 do j=ielstart(i),ielend(i)
1872 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1873 if (itel(j).eq.0) goto 1216
1877 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1878 aaa=app(iteli,itelj)
1879 bbb=bpp(iteli,itelj)
1880 C Diagnostics only!!!
1886 ael6i=ael6(iteli,itelj)
1887 ael3i=ael3(iteli,itelj)
1891 dx_normj=dc_norm(1,j)
1892 dy_normj=dc_norm(2,j)
1893 dz_normj=dc_norm(3,j)
1894 xj=c(1,j)+0.5D0*dxj-xmedi
1895 yj=c(2,j)+0.5D0*dyj-ymedi
1896 zj=c(3,j)+0.5D0*dzj-zmedi
1897 rij=xj*xj+yj*yj+zj*zj
1903 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1904 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1905 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1906 fac=cosa-3.0D0*cosb*cosg
1908 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1909 if (j.eq.i+2) ev1=scal_el*ev1
1914 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1917 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1918 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1919 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1922 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1923 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1924 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1925 cd & xmedi,ymedi,zmedi,xj,yj,zj
1927 C Calculate contributions to the Cartesian gradient.
1930 facvdw=-6*rrmij*(ev1+evdwij)
1931 facel=-3*rrmij*(el1+eesij)
1938 * Radial derivatives. First process both termini of the fragment (i,j)
1945 gelc(k,i)=gelc(k,i)+ghalf
1946 gelc(k,j)=gelc(k,j)+ghalf
1949 * Loop over residues i+1 thru j-1.
1953 gelc(l,k)=gelc(l,k)+ggg(l)
1961 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1962 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1965 * Loop over residues i+1 thru j-1.
1969 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1976 fac=-3*rrmij*(facvdw+facvdw+facel)
1982 * Radial derivatives. First process both termini of the fragment (i,j)
1989 gelc(k,i)=gelc(k,i)+ghalf
1990 gelc(k,j)=gelc(k,j)+ghalf
1993 * Loop over residues i+1 thru j-1.
1997 gelc(l,k)=gelc(l,k)+ggg(l)
2004 ecosa=2.0D0*fac3*fac1+fac4
2007 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2008 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2010 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2011 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2013 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2014 cd & (dcosg(k),k=1,3)
2016 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2020 gelc(k,i)=gelc(k,i)+ghalf
2021 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2022 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2023 gelc(k,j)=gelc(k,j)+ghalf
2024 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2025 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2029 gelc(l,k)=gelc(l,k)+ggg(l)
2034 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2035 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2036 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2038 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2039 C energy of a peptide unit is assumed in the form of a second-order
2040 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2041 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2042 C are computed for EVERY pair of non-contiguous peptide groups.
2044 if (j.lt.nres-1) then
2055 muij(kkk)=mu(k,i)*mu(l,j)
2058 cd write (iout,*) 'EELEC: i',i,' j',j
2059 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2060 cd write(iout,*) 'muij',muij
2061 ury=scalar(uy(1,i),erij)
2062 urz=scalar(uz(1,i),erij)
2063 vry=scalar(uy(1,j),erij)
2064 vrz=scalar(uz(1,j),erij)
2065 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2066 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2067 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2068 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2069 C For diagnostics only
2074 fac=dsqrt(-ael6i)*r3ij
2075 cd write (2,*) 'fac=',fac
2076 C For diagnostics only
2082 cd write (iout,'(4i5,4f10.5)')
2083 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2084 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2085 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2086 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2087 cd write (iout,'(4f10.5)')
2088 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2089 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2090 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2091 cd write (iout,'(2i3,9f10.5/)') i,j,
2092 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2094 C Derivatives of the elements of A in virtual-bond vectors
2095 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2102 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2103 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2104 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2105 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2106 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2107 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2108 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2109 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2110 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2111 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2112 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2113 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2123 C Compute radial contributions to the gradient
2145 C Add the contributions coming from er
2148 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2149 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2150 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2151 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2154 C Derivatives in DC(i)
2155 ghalf1=0.5d0*agg(k,1)
2156 ghalf2=0.5d0*agg(k,2)
2157 ghalf3=0.5d0*agg(k,3)
2158 ghalf4=0.5d0*agg(k,4)
2159 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2160 & -3.0d0*uryg(k,2)*vry)+ghalf1
2161 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2162 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2163 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2164 & -3.0d0*urzg(k,2)*vry)+ghalf3
2165 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2166 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2167 C Derivatives in DC(i+1)
2168 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2169 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2170 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2171 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2172 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2173 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2174 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2175 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2176 C Derivatives in DC(j)
2177 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2178 & -3.0d0*vryg(k,2)*ury)+ghalf1
2179 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2180 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2181 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2182 & -3.0d0*vryg(k,2)*urz)+ghalf3
2183 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2184 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2185 C Derivatives in DC(j+1) or DC(nres-1)
2186 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2187 & -3.0d0*vryg(k,3)*ury)
2188 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2189 & -3.0d0*vrzg(k,3)*ury)
2190 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2191 & -3.0d0*vryg(k,3)*urz)
2192 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2193 & -3.0d0*vrzg(k,3)*urz)
2198 C Derivatives in DC(i+1)
2199 cd aggi1(k,1)=agg(k,1)
2200 cd aggi1(k,2)=agg(k,2)
2201 cd aggi1(k,3)=agg(k,3)
2202 cd aggi1(k,4)=agg(k,4)
2203 C Derivatives in DC(j)
2208 C Derivatives in DC(j+1)
2213 if (j.eq.nres-1 .and. i.lt.j-2) then
2215 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2216 cd aggj1(k,l)=agg(k,l)
2222 C Check the loc-el terms by numerical integration
2232 aggi(k,l)=-aggi(k,l)
2233 aggi1(k,l)=-aggi1(k,l)
2234 aggj(k,l)=-aggj(k,l)
2235 aggj1(k,l)=-aggj1(k,l)
2238 if (j.lt.nres-1) then
2244 aggi(k,l)=-aggi(k,l)
2245 aggi1(k,l)=-aggi1(k,l)
2246 aggj(k,l)=-aggj(k,l)
2247 aggj1(k,l)=-aggj1(k,l)
2258 aggi(k,l)=-aggi(k,l)
2259 aggi1(k,l)=-aggi1(k,l)
2260 aggj(k,l)=-aggj(k,l)
2261 aggj1(k,l)=-aggj1(k,l)
2267 IF (wel_loc.gt.0.0d0) THEN
2268 C Contribution to the local-electrostatic energy coming from the i-j pair
2269 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2271 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2272 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2273 eel_loc=eel_loc+eel_loc_ij
2274 C Partial derivatives in virtual-bond dihedral angles gamma
2277 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2278 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2279 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2280 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2281 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2282 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2283 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2284 cd write(iout,*) 'agg ',agg
2285 cd write(iout,*) 'aggi ',aggi
2286 cd write(iout,*) 'aggi1',aggi1
2287 cd write(iout,*) 'aggj ',aggj
2288 cd write(iout,*) 'aggj1',aggj1
2290 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2292 ggg(l)=agg(l,1)*muij(1)+
2293 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2297 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2300 C Remaining derivatives of eello
2302 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2303 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2304 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2305 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2306 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2307 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2308 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2309 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2313 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2314 C Contributions from turns
2319 call eturn34(i,j,eello_turn3,eello_turn4)
2321 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2322 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2324 C Calculate the contact function. The ith column of the array JCONT will
2325 C contain the numbers of atoms that make contacts with the atom I (of numbers
2326 C greater than I). The arrays FACONT and GACONT will contain the values of
2327 C the contact function and its derivative.
2328 c r0ij=1.02D0*rpp(iteli,itelj)
2329 c r0ij=1.11D0*rpp(iteli,itelj)
2330 r0ij=2.20D0*rpp(iteli,itelj)
2331 c r0ij=1.55D0*rpp(iteli,itelj)
2332 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2333 if (fcont.gt.0.0D0) then
2334 num_conti=num_conti+1
2335 if (num_conti.gt.maxconts) then
2336 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2337 & ' will skip next contacts for this conf.'
2339 jcont_hb(num_conti,i)=j
2340 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2341 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2342 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2344 d_cont(num_conti,i)=rij
2345 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2346 C --- Electrostatic-interaction matrix ---
2347 a_chuj(1,1,num_conti,i)=a22
2348 a_chuj(1,2,num_conti,i)=a23
2349 a_chuj(2,1,num_conti,i)=a32
2350 a_chuj(2,2,num_conti,i)=a33
2351 C --- Gradient of rij
2353 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2356 c a_chuj(1,1,num_conti,i)=-0.61d0
2357 c a_chuj(1,2,num_conti,i)= 0.4d0
2358 c a_chuj(2,1,num_conti,i)= 0.65d0
2359 c a_chuj(2,2,num_conti,i)= 0.50d0
2360 c else if (i.eq.2) then
2361 c a_chuj(1,1,num_conti,i)= 0.0d0
2362 c a_chuj(1,2,num_conti,i)= 0.0d0
2363 c a_chuj(2,1,num_conti,i)= 0.0d0
2364 c a_chuj(2,2,num_conti,i)= 0.0d0
2366 C --- and its gradients
2367 cd write (iout,*) 'i',i,' j',j
2369 cd write (iout,*) 'iii 1 kkk',kkk
2370 cd write (iout,*) agg(kkk,:)
2373 cd write (iout,*) 'iii 2 kkk',kkk
2374 cd write (iout,*) aggi(kkk,:)
2377 cd write (iout,*) 'iii 3 kkk',kkk
2378 cd write (iout,*) aggi1(kkk,:)
2381 cd write (iout,*) 'iii 4 kkk',kkk
2382 cd write (iout,*) aggj(kkk,:)
2385 cd write (iout,*) 'iii 5 kkk',kkk
2386 cd write (iout,*) aggj1(kkk,:)
2393 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2394 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2395 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2396 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2397 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2399 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2405 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2406 C Calculate contact energies
2408 wij=cosa-3.0D0*cosb*cosg
2411 c fac3=dsqrt(-ael6i)/r0ij**3
2412 fac3=dsqrt(-ael6i)*r3ij
2413 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2414 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2416 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2417 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2418 C Diagnostics. Comment out or remove after debugging!
2419 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2420 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2421 c ees0m(num_conti,i)=0.0D0
2423 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2424 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2425 facont_hb(num_conti,i)=fcont
2427 C Angular derivatives of the contact function
2428 ees0pij1=fac3/ees0pij
2429 ees0mij1=fac3/ees0mij
2430 fac3p=-3.0D0*fac3*rrmij
2431 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2432 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2434 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2435 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2436 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2437 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2438 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2439 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2440 ecosap=ecosa1+ecosa2
2441 ecosbp=ecosb1+ecosb2
2442 ecosgp=ecosg1+ecosg2
2443 ecosam=ecosa1-ecosa2
2444 ecosbm=ecosb1-ecosb2
2445 ecosgm=ecosg1-ecosg2
2454 fprimcont=fprimcont/rij
2455 cd facont_hb(num_conti,i)=1.0D0
2456 C Following line is for diagnostics.
2459 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2460 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2463 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2464 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2466 gggp(1)=gggp(1)+ees0pijp*xj
2467 gggp(2)=gggp(2)+ees0pijp*yj
2468 gggp(3)=gggp(3)+ees0pijp*zj
2469 gggm(1)=gggm(1)+ees0mijp*xj
2470 gggm(2)=gggm(2)+ees0mijp*yj
2471 gggm(3)=gggm(3)+ees0mijp*zj
2472 C Derivatives due to the contact function
2473 gacont_hbr(1,num_conti,i)=fprimcont*xj
2474 gacont_hbr(2,num_conti,i)=fprimcont*yj
2475 gacont_hbr(3,num_conti,i)=fprimcont*zj
2477 ghalfp=0.5D0*gggp(k)
2478 ghalfm=0.5D0*gggm(k)
2479 gacontp_hb1(k,num_conti,i)=ghalfp
2480 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2481 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2482 gacontp_hb2(k,num_conti,i)=ghalfp
2483 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2484 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2485 gacontp_hb3(k,num_conti,i)=gggp(k)
2486 gacontm_hb1(k,num_conti,i)=ghalfm
2487 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2488 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2489 gacontm_hb2(k,num_conti,i)=ghalfm
2490 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2491 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2492 gacontm_hb3(k,num_conti,i)=gggm(k)
2495 C Diagnostics. Comment out or remove after debugging!
2497 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2498 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2499 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2500 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2501 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2502 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2505 endif ! num_conti.le.maxconts
2510 num_cont_hb(i)=num_conti
2514 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2515 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2517 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2518 ccc eel_loc=eel_loc+eello_turn3
2521 C-----------------------------------------------------------------------------
2522 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2523 C Third- and fourth-order contributions from turns
2524 implicit real*8 (a-h,o-z)
2525 include 'DIMENSIONS'
2526 include 'sizesclu.dat'
2527 include 'COMMON.IOUNITS'
2528 include 'COMMON.GEO'
2529 include 'COMMON.VAR'
2530 include 'COMMON.LOCAL'
2531 include 'COMMON.CHAIN'
2532 include 'COMMON.DERIV'
2533 include 'COMMON.INTERACT'
2534 include 'COMMON.CONTACTS'
2535 include 'COMMON.TORSION'
2536 include 'COMMON.VECTORS'
2537 include 'COMMON.FFIELD'
2539 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2540 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2541 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2542 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2543 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2544 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2548 C Third-order contributions
2555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2556 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2557 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2558 call transpose2(auxmat(1,1),auxmat1(1,1))
2559 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2560 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2561 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2562 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2563 cd & ' eello_turn3_num',4*eello_turn3_num
2565 C Derivatives in gamma(i)
2566 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2567 call transpose2(auxmat2(1,1),pizda(1,1))
2568 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2569 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2570 C Derivatives in gamma(i+1)
2571 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2572 call transpose2(auxmat2(1,1),pizda(1,1))
2573 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2574 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2575 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 C Cartesian derivatives
2578 a_temp(1,1)=aggi(l,1)
2579 a_temp(1,2)=aggi(l,2)
2580 a_temp(2,1)=aggi(l,3)
2581 a_temp(2,2)=aggi(l,4)
2582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2583 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2584 & +0.5d0*(pizda(1,1)+pizda(2,2))
2585 a_temp(1,1)=aggi1(l,1)
2586 a_temp(1,2)=aggi1(l,2)
2587 a_temp(2,1)=aggi1(l,3)
2588 a_temp(2,2)=aggi1(l,4)
2589 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2590 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2591 & +0.5d0*(pizda(1,1)+pizda(2,2))
2592 a_temp(1,1)=aggj(l,1)
2593 a_temp(1,2)=aggj(l,2)
2594 a_temp(2,1)=aggj(l,3)
2595 a_temp(2,2)=aggj(l,4)
2596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2597 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2598 & +0.5d0*(pizda(1,1)+pizda(2,2))
2599 a_temp(1,1)=aggj1(l,1)
2600 a_temp(1,2)=aggj1(l,2)
2601 a_temp(2,1)=aggj1(l,3)
2602 a_temp(2,2)=aggj1(l,4)
2603 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2604 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2605 & +0.5d0*(pizda(1,1)+pizda(2,2))
2608 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2611 C Fourth-order contributions
2619 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2620 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2621 iti1=itortyp(itype(i+1))
2622 iti2=itortyp(itype(i+2))
2623 iti3=itortyp(itype(i+3))
2624 call transpose2(EUg(1,1,i+1),e1t(1,1))
2625 call transpose2(Eug(1,1,i+2),e2t(1,1))
2626 call transpose2(Eug(1,1,i+3),e3t(1,1))
2627 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2628 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2629 s1=scalar2(b1(1,iti2),auxvec(1))
2630 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2631 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2632 s2=scalar2(b1(1,iti1),auxvec(1))
2633 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2634 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2635 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2636 eello_turn4=eello_turn4-(s1+s2+s3)
2637 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2638 cd & ' eello_turn4_num',8*eello_turn4_num
2639 C Derivatives in gamma(i)
2641 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2642 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2643 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2644 s1=scalar2(b1(1,iti2),auxvec(1))
2645 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2646 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2647 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2648 C Derivatives in gamma(i+1)
2649 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2650 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2651 s2=scalar2(b1(1,iti1),auxvec(1))
2652 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2653 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2654 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2655 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2656 C Derivatives in gamma(i+2)
2657 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2658 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2659 s1=scalar2(b1(1,iti2),auxvec(1))
2660 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2661 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2662 s2=scalar2(b1(1,iti1),auxvec(1))
2663 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2664 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2665 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2666 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2667 C Cartesian derivatives
2668 C Derivatives of this turn contributions in DC(i+2)
2669 if (j.lt.nres-1) then
2671 a_temp(1,1)=agg(l,1)
2672 a_temp(1,2)=agg(l,2)
2673 a_temp(2,1)=agg(l,3)
2674 a_temp(2,2)=agg(l,4)
2675 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2676 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2677 s1=scalar2(b1(1,iti2),auxvec(1))
2678 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2679 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2680 s2=scalar2(b1(1,iti1),auxvec(1))
2681 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2682 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2683 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2685 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2688 C Remaining derivatives of this turn contribution
2690 a_temp(1,1)=aggi(l,1)
2691 a_temp(1,2)=aggi(l,2)
2692 a_temp(2,1)=aggi(l,3)
2693 a_temp(2,2)=aggi(l,4)
2694 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2695 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2696 s1=scalar2(b1(1,iti2),auxvec(1))
2697 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2698 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2699 s2=scalar2(b1(1,iti1),auxvec(1))
2700 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2701 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2702 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2703 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2704 a_temp(1,1)=aggi1(l,1)
2705 a_temp(1,2)=aggi1(l,2)
2706 a_temp(2,1)=aggi1(l,3)
2707 a_temp(2,2)=aggi1(l,4)
2708 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2709 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2710 s1=scalar2(b1(1,iti2),auxvec(1))
2711 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2712 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2713 s2=scalar2(b1(1,iti1),auxvec(1))
2714 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2715 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2716 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2717 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2718 a_temp(1,1)=aggj(l,1)
2719 a_temp(1,2)=aggj(l,2)
2720 a_temp(2,1)=aggj(l,3)
2721 a_temp(2,2)=aggj(l,4)
2722 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2723 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2724 s1=scalar2(b1(1,iti2),auxvec(1))
2725 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2726 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2727 s2=scalar2(b1(1,iti1),auxvec(1))
2728 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2729 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2730 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2731 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2732 a_temp(1,1)=aggj1(l,1)
2733 a_temp(1,2)=aggj1(l,2)
2734 a_temp(2,1)=aggj1(l,3)
2735 a_temp(2,2)=aggj1(l,4)
2736 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2737 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2738 s1=scalar2(b1(1,iti2),auxvec(1))
2739 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2740 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2741 s2=scalar2(b1(1,iti1),auxvec(1))
2742 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2743 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2744 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2745 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2751 C-----------------------------------------------------------------------------
2752 subroutine vecpr(u,v,w)
2753 implicit real*8(a-h,o-z)
2754 dimension u(3),v(3),w(3)
2755 w(1)=u(2)*v(3)-u(3)*v(2)
2756 w(2)=-u(1)*v(3)+u(3)*v(1)
2757 w(3)=u(1)*v(2)-u(2)*v(1)
2760 C-----------------------------------------------------------------------------
2761 subroutine unormderiv(u,ugrad,unorm,ungrad)
2762 C This subroutine computes the derivatives of a normalized vector u, given
2763 C the derivatives computed without normalization conditions, ugrad. Returns
2766 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2767 double precision vec(3)
2768 double precision scalar
2770 c write (2,*) 'ugrad',ugrad
2773 vec(i)=scalar(ugrad(1,i),u(1))
2775 c write (2,*) 'vec',vec
2778 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2781 c write (2,*) 'ungrad',ungrad
2784 C-----------------------------------------------------------------------------
2785 subroutine escp(evdw2,evdw2_14)
2787 C This subroutine calculates the excluded-volume interaction energy between
2788 C peptide-group centers and side chains and its gradient in virtual-bond and
2789 C side-chain vectors.
2791 implicit real*8 (a-h,o-z)
2792 include 'DIMENSIONS'
2793 include 'sizesclu.dat'
2794 include 'COMMON.GEO'
2795 include 'COMMON.VAR'
2796 include 'COMMON.LOCAL'
2797 include 'COMMON.CHAIN'
2798 include 'COMMON.DERIV'
2799 include 'COMMON.INTERACT'
2800 include 'COMMON.FFIELD'
2801 include 'COMMON.IOUNITS'
2805 cd print '(a)','Enter ESCP'
2806 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2807 c & ' scal14',scal14
2808 do i=iatscp_s,iatscp_e
2809 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2811 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2812 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2813 if (iteli.eq.0) goto 1225
2814 xi=0.5D0*(c(1,i)+c(1,i+1))
2815 yi=0.5D0*(c(2,i)+c(2,i+1))
2816 zi=0.5D0*(c(3,i)+c(3,i+1))
2818 do iint=1,nscp_gr(i)
2820 do j=iscpstart(i,iint),iscpend(i,iint)
2821 itypj=iabs(itype(j))
2822 if (itypj.eq.ntyp1) cycle
2823 C Uncomment following three lines for SC-p interactions
2827 C Uncomment following three lines for Ca-p interactions
2831 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2833 e1=fac*fac*aad(itypj,iteli)
2834 e2=fac*bad(itypj,iteli)
2835 if (iabs(j-i) .le. 2) then
2838 evdw2_14=evdw2_14+e1+e2
2841 c write (iout,*) i,j,evdwij
2845 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2847 fac=-(evdwij+e1)*rrij
2852 cd write (iout,*) 'j<i'
2853 C Uncomment following three lines for SC-p interactions
2855 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2858 cd write (iout,*) 'j>i'
2861 C Uncomment following line for SC-p interactions
2862 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2866 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2870 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2871 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2874 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2884 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2885 gradx_scp(j,i)=expon*gradx_scp(j,i)
2888 C******************************************************************************
2892 C To save time the factor EXPON has been extracted from ALL components
2893 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2896 C******************************************************************************
2899 C--------------------------------------------------------------------------
2900 subroutine edis(ehpb)
2902 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2904 implicit real*8 (a-h,o-z)
2905 include 'DIMENSIONS'
2906 include 'sizesclu.dat'
2907 include 'COMMON.SBRIDGE'
2908 include 'COMMON.CHAIN'
2909 include 'COMMON.DERIV'
2910 include 'COMMON.VAR'
2911 include 'COMMON.INTERACT'
2914 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2915 cd print *,'link_start=',link_start,' link_end=',link_end
2916 if (link_end.eq.0) return
2917 do i=link_start,link_end
2918 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2919 C CA-CA distance used in regularization of structure.
2922 C iii and jjj point to the residues for which the distance is assigned.
2923 if (ii.gt.nres) then
2930 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2931 C distance and angle dependent SS bond potential.
2932 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2933 & iabs(itype(jjj)).eq.1) then
2934 call ssbond_ene(iii,jjj,eij)
2937 C Calculate the distance between the two points and its difference from the
2941 C Get the force constant corresponding to this distance.
2943 C Calculate the contribution to energy.
2944 ehpb=ehpb+waga*rdis*rdis
2946 C Evaluate gradient.
2949 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2950 cd & ' waga=',waga,' fac=',fac
2952 ggg(j)=fac*(c(j,jj)-c(j,ii))
2954 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2955 C If this is a SC-SC distance, we need to calculate the contributions to the
2956 C Cartesian gradient in the SC vectors (ghpbx).
2959 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2960 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2965 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2973 C--------------------------------------------------------------------------
2974 subroutine ssbond_ene(i,j,eij)
2976 C Calculate the distance and angle dependent SS-bond potential energy
2977 C using a free-energy function derived based on RHF/6-31G** ab initio
2978 C calculations of diethyl disulfide.
2980 C A. Liwo and U. Kozlowska, 11/24/03
2982 implicit real*8 (a-h,o-z)
2983 include 'DIMENSIONS'
2984 include 'sizesclu.dat'
2985 include 'COMMON.SBRIDGE'
2986 include 'COMMON.CHAIN'
2987 include 'COMMON.DERIV'
2988 include 'COMMON.LOCAL'
2989 include 'COMMON.INTERACT'
2990 include 'COMMON.VAR'
2991 include 'COMMON.IOUNITS'
2992 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2993 itypi=iabs(itype(i))
2997 dxi=dc_norm(1,nres+i)
2998 dyi=dc_norm(2,nres+i)
2999 dzi=dc_norm(3,nres+i)
3000 dsci_inv=dsc_inv(itypi)
3001 itypj=iabs(itype(j))
3002 dscj_inv=dsc_inv(itypj)
3006 dxj=dc_norm(1,nres+j)
3007 dyj=dc_norm(2,nres+j)
3008 dzj=dc_norm(3,nres+j)
3009 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3014 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3015 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3016 om12=dxi*dxj+dyi*dyj+dzi*dzj
3018 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3019 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3025 deltat12=om2-om1+2.0d0
3027 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3028 & +akct*deltad*deltat12
3029 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3030 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3031 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3032 c & " deltat12",deltat12," eij",eij
3033 ed=2*akcm*deltad+akct*deltat12
3035 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3036 eom1=-2*akth*deltat1-pom1-om2*pom2
3037 eom2= 2*akth*deltat2+pom1-om1*pom2
3040 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3043 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3044 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3045 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3046 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3049 C Calculate the components of the gradient in DC and X
3053 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3058 C--------------------------------------------------------------------------
3059 subroutine ebond(estr)
3061 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3063 implicit real*8 (a-h,o-z)
3064 include 'DIMENSIONS'
3065 include 'sizesclu.dat'
3066 include 'COMMON.LOCAL'
3067 include 'COMMON.GEO'
3068 include 'COMMON.INTERACT'
3069 include 'COMMON.DERIV'
3070 include 'COMMON.VAR'
3071 include 'COMMON.CHAIN'
3072 include 'COMMON.IOUNITS'
3073 include 'COMMON.NAMES'
3074 include 'COMMON.FFIELD'
3075 include 'COMMON.CONTROL'
3076 logical energy_dec /.false./
3077 double precision u(3),ud(3)
3081 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3082 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3084 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3085 & *dc(j,i-1)/vbld(i)
3087 if (energy_dec) write(iout,*)
3088 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3090 diff = vbld(i)-vbldp0
3091 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3094 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3099 estr=0.5d0*AKP*estr+estr1
3101 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3105 if (iti.ne.10 .and. iti.ne.ntyp1) then
3108 diff=vbld(i+nres)-vbldsc0(1,iti)
3109 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3110 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3111 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3113 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3117 diff=vbld(i+nres)-vbldsc0(j,iti)
3118 ud(j)=aksc(j,iti)*diff
3119 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3133 uprod2=uprod2*u(k)*u(k)
3137 usumsqder=usumsqder+ud(j)*uprod2
3139 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3140 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3141 estr=estr+uprod/usum
3143 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3151 C--------------------------------------------------------------------------
3152 subroutine ebend(etheta)
3154 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3155 C angles gamma and its derivatives in consecutive thetas and gammas.
3157 implicit real*8 (a-h,o-z)
3158 include 'DIMENSIONS'
3159 include 'sizesclu.dat'
3160 include 'COMMON.LOCAL'
3161 include 'COMMON.GEO'
3162 include 'COMMON.INTERACT'
3163 include 'COMMON.DERIV'
3164 include 'COMMON.VAR'
3165 include 'COMMON.CHAIN'
3166 include 'COMMON.IOUNITS'
3167 include 'COMMON.NAMES'
3168 include 'COMMON.FFIELD'
3169 common /calcthet/ term1,term2,termm,diffak,ratak,
3170 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3171 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3172 double precision y(2),z(2)
3174 c time11=dexp(-2*time)
3177 c write (iout,*) "nres",nres
3178 c write (*,'(a,i2)') 'EBEND ICG=',icg
3179 c write (iout,*) ithet_start,ithet_end
3180 do i=ithet_start,ithet_end
3181 if (itype(i-1).eq.ntyp1) cycle
3182 C Zero the energy function and its derivative at 0 or pi.
3183 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3185 ichir1=isign(1,itype(i-2))
3186 ichir2=isign(1,itype(i))
3187 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3188 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3189 if (itype(i-1).eq.10) then
3190 itype1=isign(10,itype(i-2))
3191 ichir11=isign(1,itype(i-2))
3192 ichir12=isign(1,itype(i-2))
3193 itype2=isign(10,itype(i))
3194 ichir21=isign(1,itype(i))
3195 ichir22=isign(1,itype(i))
3197 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3201 c call proc_proc(phii,icrc)
3202 if (icrc.eq.1) phii=150.0
3212 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3216 c call proc_proc(phii1,icrc)
3217 if (icrc.eq.1) phii1=150.0
3229 C Calculate the "mean" value of theta from the part of the distribution
3230 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3231 C In following comments this theta will be referred to as t_c.
3232 thet_pred_mean=0.0d0
3234 athetk=athet(k,it,ichir1,ichir2)
3235 bthetk=bthet(k,it,ichir1,ichir2)
3237 athetk=athet(k,itype1,ichir11,ichir12)
3238 bthetk=bthet(k,itype2,ichir21,ichir22)
3240 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3242 c write (iout,*) "thet_pred_mean",thet_pred_mean
3243 dthett=thet_pred_mean*ssd
3244 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3245 c write (iout,*) "thet_pred_mean",thet_pred_mean
3246 C Derivatives of the "mean" values in gamma1 and gamma2.
3247 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3248 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3249 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3250 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3252 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3253 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3254 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3255 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3257 if (theta(i).gt.pi-delta) then
3258 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3260 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3261 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3262 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3264 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3266 else if (theta(i).lt.delta) then
3267 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3268 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3269 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3271 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3272 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3275 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3278 etheta=etheta+ethetai
3279 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3280 c & rad2deg*phii,rad2deg*phii1,ethetai
3281 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3282 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3283 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3286 C Ufff.... We've done all this!!!
3289 C---------------------------------------------------------------------------
3290 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3292 implicit real*8 (a-h,o-z)
3293 include 'DIMENSIONS'
3294 include 'COMMON.LOCAL'
3295 include 'COMMON.IOUNITS'
3296 common /calcthet/ term1,term2,termm,diffak,ratak,
3297 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3298 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3299 C Calculate the contributions to both Gaussian lobes.
3300 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3301 C The "polynomial part" of the "standard deviation" of this part of
3305 sig=sig*thet_pred_mean+polthet(j,it)
3307 C Derivative of the "interior part" of the "standard deviation of the"
3308 C gamma-dependent Gaussian lobe in t_c.
3309 sigtc=3*polthet(3,it)
3311 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3314 C Set the parameters of both Gaussian lobes of the distribution.
3315 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3316 fac=sig*sig+sigc0(it)
3319 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3320 sigsqtc=-4.0D0*sigcsq*sigtc
3321 c print *,i,sig,sigtc,sigsqtc
3322 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3323 sigtc=-sigtc/(fac*fac)
3324 C Following variable is sigma(t_c)**(-2)
3325 sigcsq=sigcsq*sigcsq
3327 sig0inv=1.0D0/sig0i**2
3328 delthec=thetai-thet_pred_mean
3329 delthe0=thetai-theta0i
3330 term1=-0.5D0*sigcsq*delthec*delthec
3331 term2=-0.5D0*sig0inv*delthe0*delthe0
3332 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3333 C NaNs in taking the logarithm. We extract the largest exponent which is added
3334 C to the energy (this being the log of the distribution) at the end of energy
3335 C term evaluation for this virtual-bond angle.
3336 if (term1.gt.term2) then
3338 term2=dexp(term2-termm)
3342 term1=dexp(term1-termm)
3345 C The ratio between the gamma-independent and gamma-dependent lobes of
3346 C the distribution is a Gaussian function of thet_pred_mean too.
3347 diffak=gthet(2,it)-thet_pred_mean
3348 ratak=diffak/gthet(3,it)**2
3349 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3350 C Let's differentiate it in thet_pred_mean NOW.
3352 C Now put together the distribution terms to make complete distribution.
3353 termexp=term1+ak*term2
3354 termpre=sigc+ak*sig0i
3355 C Contribution of the bending energy from this theta is just the -log of
3356 C the sum of the contributions from the two lobes and the pre-exponential
3357 C factor. Simple enough, isn't it?
3358 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3359 C NOW the derivatives!!!
3360 C 6/6/97 Take into account the deformation.
3361 E_theta=(delthec*sigcsq*term1
3362 & +ak*delthe0*sig0inv*term2)/termexp
3363 E_tc=((sigtc+aktc*sig0i)/termpre
3364 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3365 & aktc*term2)/termexp)
3368 c-----------------------------------------------------------------------------
3369 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3370 implicit real*8 (a-h,o-z)
3371 include 'DIMENSIONS'
3372 include 'COMMON.LOCAL'
3373 include 'COMMON.IOUNITS'
3374 common /calcthet/ term1,term2,termm,diffak,ratak,
3375 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3376 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3377 delthec=thetai-thet_pred_mean
3378 delthe0=thetai-theta0i
3379 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3380 t3 = thetai-thet_pred_mean
3384 t14 = t12+t6*sigsqtc
3386 t21 = thetai-theta0i
3392 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3393 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3394 & *(-t12*t9-ak*sig0inv*t27)
3398 C--------------------------------------------------------------------------
3399 subroutine ebend(etheta)
3401 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3402 C angles gamma and its derivatives in consecutive thetas and gammas.
3403 C ab initio-derived potentials from
3404 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3406 implicit real*8 (a-h,o-z)
3407 include 'DIMENSIONS'
3408 include 'sizesclu.dat'
3409 include 'COMMON.LOCAL'
3410 include 'COMMON.GEO'
3411 include 'COMMON.INTERACT'
3412 include 'COMMON.DERIV'
3413 include 'COMMON.VAR'
3414 include 'COMMON.CHAIN'
3415 include 'COMMON.IOUNITS'
3416 include 'COMMON.NAMES'
3417 include 'COMMON.FFIELD'
3418 include 'COMMON.CONTROL'
3419 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3420 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3421 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3422 & sinph1ph2(maxdouble,maxdouble)
3423 logical lprn /.false./, lprn1 /.false./
3425 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3426 do i=ithet_start,ithet_end
3427 c if (itype(i-1).eq.ntyp1) cycle
3428 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3429 &(itype(i).eq.ntyp1)) cycle
3430 if (iabs(itype(i+1)).eq.20) iblock=2
3431 if (iabs(itype(i+1)).ne.20) iblock=1
3435 theti2=0.5d0*theta(i)
3436 CC Ta zmina jest niewlasciwa
3437 ityp2=ithetyp((itype(i-1)))
3439 coskt(k)=dcos(k*theti2)
3440 sinkt(k)=dsin(k*theti2)
3442 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3445 if (phii.ne.phii) phii=150.0
3449 ityp1=ithetyp((itype(i-2)))
3451 cosph1(k)=dcos(k*phii)
3452 sinph1(k)=dsin(k*phii)
3458 ityp1=ithetyp((itype(i-2)))
3463 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3466 if (phii1.ne.phii1) phii1=150.0
3471 ityp3=ithetyp((itype(i)))
3473 cosph2(k)=dcos(k*phii1)
3474 sinph2(k)=dsin(k*phii1)
3479 ityp3=ithetyp((itype(i)))
3485 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3486 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3488 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3491 ccl=cosph1(l)*cosph2(k-l)
3492 ssl=sinph1(l)*sinph2(k-l)
3493 scl=sinph1(l)*cosph2(k-l)
3494 csl=cosph1(l)*sinph2(k-l)
3495 cosph1ph2(l,k)=ccl-ssl
3496 cosph1ph2(k,l)=ccl+ssl
3497 sinph1ph2(l,k)=scl+csl
3498 sinph1ph2(k,l)=scl-csl
3502 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3503 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3504 write (iout,*) "coskt and sinkt"
3506 write (iout,*) k,coskt(k),sinkt(k)
3510 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3511 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3514 & write (iout,*) "k",k," aathet",
3515 & aathet(k,ityp1,ityp2,ityp3,iblock),
3516 & " ethetai",ethetai
3519 write (iout,*) "cosph and sinph"
3521 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3523 write (iout,*) "cosph1ph2 and sinph2ph2"
3526 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3527 & sinph1ph2(l,k),sinph1ph2(k,l)
3530 write(iout,*) "ethetai",ethetai
3534 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3535 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3536 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3537 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3538 ethetai=ethetai+sinkt(m)*aux
3539 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3540 dephii=dephii+k*sinkt(m)*(
3541 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3542 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3543 dephii1=dephii1+k*sinkt(m)*(
3544 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3545 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3547 & write (iout,*) "m",m," k",k," bbthet",
3548 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3549 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3550 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3551 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3555 & write(iout,*) "ethetai",ethetai
3559 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3560 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3561 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3562 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3563 ethetai=ethetai+sinkt(m)*aux
3564 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3565 dephii=dephii+l*sinkt(m)*(
3566 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3567 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3568 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3569 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3570 dephii1=dephii1+(k-l)*sinkt(m)*(
3571 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3572 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3573 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3574 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3576 write (iout,*) "m",m," k",k," l",l," ffthet",
3577 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3578 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3579 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3580 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3581 & " ethetai",ethetai
3582 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3583 & cosph1ph2(k,l)*sinkt(m),
3584 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3590 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3591 & i,theta(i)*rad2deg,phii*rad2deg,
3592 & phii1*rad2deg,ethetai
3593 etheta=etheta+ethetai
3594 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3595 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3596 c gloc(nphi+i-2,icg)=wang*dethetai
3597 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3603 c-----------------------------------------------------------------------------
3604 subroutine esc(escloc)
3605 C Calculate the local energy of a side chain and its derivatives in the
3606 C corresponding virtual-bond valence angles THETA and the spherical angles
3608 implicit real*8 (a-h,o-z)
3609 include 'DIMENSIONS'
3610 include 'sizesclu.dat'
3611 include 'COMMON.GEO'
3612 include 'COMMON.LOCAL'
3613 include 'COMMON.VAR'
3614 include 'COMMON.INTERACT'
3615 include 'COMMON.DERIV'
3616 include 'COMMON.CHAIN'
3617 include 'COMMON.IOUNITS'
3618 include 'COMMON.NAMES'
3619 include 'COMMON.FFIELD'
3620 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3621 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3622 common /sccalc/ time11,time12,time112,theti,it,nlobit
3625 c write (iout,'(a)') 'ESC'
3626 do i=loc_start,loc_end
3628 if (it.eq.ntyp1) cycle
3629 if (it.eq.10) goto 1
3630 nlobit=nlob(iabs(it))
3631 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3632 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3633 theti=theta(i+1)-pipol
3637 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3639 if (x(2).gt.pi-delta) then
3643 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3645 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3646 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3648 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3649 & ddersc0(1),dersc(1))
3650 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3651 & ddersc0(3),dersc(3))
3653 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3655 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3656 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3657 & dersc0(2),esclocbi,dersc02)
3658 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3660 call splinthet(x(2),0.5d0*delta,ss,ssd)
3665 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3667 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3668 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3670 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3672 c write (iout,*) escloci
3673 else if (x(2).lt.delta) then
3677 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3679 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3680 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3682 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3683 & ddersc0(1),dersc(1))
3684 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3685 & ddersc0(3),dersc(3))
3687 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3689 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3690 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3691 & dersc0(2),esclocbi,dersc02)
3692 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3697 call splinthet(x(2),0.5d0*delta,ss,ssd)
3699 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3701 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3702 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3704 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3705 c write (iout,*) escloci
3707 call enesc(x,escloci,dersc,ddummy,.false.)
3710 escloc=escloc+escloci
3711 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3713 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3715 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3716 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3721 C---------------------------------------------------------------------------
3722 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3723 implicit real*8 (a-h,o-z)
3724 include 'DIMENSIONS'
3725 include 'COMMON.GEO'
3726 include 'COMMON.LOCAL'
3727 include 'COMMON.IOUNITS'
3728 common /sccalc/ time11,time12,time112,theti,it,nlobit
3729 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3730 double precision contr(maxlob,-1:1)
3732 c write (iout,*) 'it=',it,' nlobit=',nlobit
3736 if (mixed) ddersc(j)=0.0d0
3740 C Because of periodicity of the dependence of the SC energy in omega we have
3741 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3742 C To avoid underflows, first compute & store the exponents.
3750 z(k)=x(k)-censc(k,j,it)
3755 Axk=Axk+gaussc(l,k,j,it)*z(l)
3761 expfac=expfac+Ax(k,j,iii)*z(k)
3769 C As in the case of ebend, we want to avoid underflows in exponentiation and
3770 C subsequent NaNs and INFs in energy calculation.
3771 C Find the largest exponent
3775 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3779 cd print *,'it=',it,' emin=',emin
3781 C Compute the contribution to SC energy and derivatives
3785 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3786 cd print *,'j=',j,' expfac=',expfac
3787 escloc_i=escloc_i+expfac
3789 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3793 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3794 & +gaussc(k,2,j,it))*expfac
3801 dersc(1)=dersc(1)/cos(theti)**2
3802 ddersc(1)=ddersc(1)/cos(theti)**2
3805 escloci=-(dlog(escloc_i)-emin)
3807 dersc(j)=dersc(j)/escloc_i
3811 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3816 C------------------------------------------------------------------------------
3817 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3818 implicit real*8 (a-h,o-z)
3819 include 'DIMENSIONS'
3820 include 'COMMON.GEO'
3821 include 'COMMON.LOCAL'
3822 include 'COMMON.IOUNITS'
3823 common /sccalc/ time11,time12,time112,theti,it,nlobit
3824 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3825 double precision contr(maxlob)
3836 z(k)=x(k)-censc(k,j,it)
3842 Axk=Axk+gaussc(l,k,j,it)*z(l)
3848 expfac=expfac+Ax(k,j)*z(k)
3853 C As in the case of ebend, we want to avoid underflows in exponentiation and
3854 C subsequent NaNs and INFs in energy calculation.
3855 C Find the largest exponent
3858 if (emin.gt.contr(j)) emin=contr(j)
3862 C Compute the contribution to SC energy and derivatives
3866 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3867 escloc_i=escloc_i+expfac
3869 dersc(k)=dersc(k)+Ax(k,j)*expfac
3871 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3872 & +gaussc(1,2,j,it))*expfac
3876 dersc(1)=dersc(1)/cos(theti)**2
3877 dersc12=dersc12/cos(theti)**2
3878 escloci=-(dlog(escloc_i)-emin)
3880 dersc(j)=dersc(j)/escloc_i
3882 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3886 c----------------------------------------------------------------------------------
3887 subroutine esc(escloc)
3888 C Calculate the local energy of a side chain and its derivatives in the
3889 C corresponding virtual-bond valence angles THETA and the spherical angles
3890 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3891 C added by Urszula Kozlowska. 07/11/2007
3893 implicit real*8 (a-h,o-z)
3894 include 'DIMENSIONS'
3895 include 'sizesclu.dat'
3896 include 'COMMON.GEO'
3897 include 'COMMON.LOCAL'
3898 include 'COMMON.VAR'
3899 include 'COMMON.SCROT'
3900 include 'COMMON.INTERACT'
3901 include 'COMMON.DERIV'
3902 include 'COMMON.CHAIN'
3903 include 'COMMON.IOUNITS'
3904 include 'COMMON.NAMES'
3905 include 'COMMON.FFIELD'
3906 include 'COMMON.CONTROL'
3907 include 'COMMON.VECTORS'
3908 double precision x_prime(3),y_prime(3),z_prime(3)
3909 & , sumene,dsc_i,dp2_i,x(65),
3910 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3911 & de_dxx,de_dyy,de_dzz,de_dt
3912 double precision s1_t,s1_6_t,s2_t,s2_6_t
3914 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3915 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3916 & dt_dCi(3),dt_dCi1(3)
3917 common /sccalc/ time11,time12,time112,theti,it,nlobit
3920 do i=loc_start,loc_end
3921 if (itype(i).eq.ntyp1) cycle
3922 costtab(i+1) =dcos(theta(i+1))
3923 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3924 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3925 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3926 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3927 cosfac=dsqrt(cosfac2)
3928 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3929 sinfac=dsqrt(sinfac2)
3931 if (it.eq.10) goto 1
3933 C Compute the axes of tghe local cartesian coordinates system; store in
3934 c x_prime, y_prime and z_prime
3941 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3942 C & dc_norm(3,i+nres)
3944 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3945 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3948 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3951 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3952 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3953 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3954 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3955 c & " xy",scalar(x_prime(1),y_prime(1)),
3956 c & " xz",scalar(x_prime(1),z_prime(1)),
3957 c & " yy",scalar(y_prime(1),y_prime(1)),
3958 c & " yz",scalar(y_prime(1),z_prime(1)),
3959 c & " zz",scalar(z_prime(1),z_prime(1))
3961 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3962 C to local coordinate system. Store in xx, yy, zz.
3968 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3969 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3970 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3977 C Compute the energy of the ith side cbain
3979 c write (2,*) "xx",xx," yy",yy," zz",zz
3982 x(j) = sc_parmin(j,it)
3985 Cc diagnostics - remove later
3987 yy1 = dsin(alph(2))*dcos(omeg(2))
3988 c zz1 = -dsin(alph(2))*dsin(omeg(2))
3989 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3990 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3991 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3993 C," --- ", xx_w,yy_w,zz_w
3996 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3997 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3999 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4000 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4002 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4003 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4004 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4005 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4006 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4008 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4009 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4010 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4011 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4012 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4014 dsc_i = 0.743d0+x(61)
4016 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4017 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4018 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4019 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4020 s1=(1+x(63))/(0.1d0 + dscp1)
4021 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4022 s2=(1+x(65))/(0.1d0 + dscp2)
4023 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4024 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4025 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4026 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4028 c & dscp1,dscp2,sumene
4029 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4030 escloc = escloc + sumene
4031 c write (2,*) "escloc",escloc
4032 if (.not. calc_grad) goto 1
4035 C This section to check the numerical derivatives of the energy of ith side
4036 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4037 C #define DEBUG in the code to turn it on.
4039 write (2,*) "sumene =",sumene
4043 write (2,*) xx,yy,zz
4044 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4045 de_dxx_num=(sumenep-sumene)/aincr
4047 write (2,*) "xx+ sumene from enesc=",sumenep
4050 write (2,*) xx,yy,zz
4051 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4052 de_dyy_num=(sumenep-sumene)/aincr
4054 write (2,*) "yy+ sumene from enesc=",sumenep
4057 write (2,*) xx,yy,zz
4058 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4059 de_dzz_num=(sumenep-sumene)/aincr
4061 write (2,*) "zz+ sumene from enesc=",sumenep
4062 costsave=cost2tab(i+1)
4063 sintsave=sint2tab(i+1)
4064 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4065 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4066 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4067 de_dt_num=(sumenep-sumene)/aincr
4068 write (2,*) " t+ sumene from enesc=",sumenep
4069 cost2tab(i+1)=costsave
4070 sint2tab(i+1)=sintsave
4071 C End of diagnostics section.
4074 C Compute the gradient of esc
4076 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4077 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4078 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4079 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4080 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4081 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4082 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4083 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4084 pom1=(sumene3*sint2tab(i+1)+sumene1)
4085 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4086 pom2=(sumene4*cost2tab(i+1)+sumene2)
4087 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4088 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4089 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4090 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4092 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4093 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4094 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4096 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4097 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4098 & +(pom1+pom2)*pom_dx
4100 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4103 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4104 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4105 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4107 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4108 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4109 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4110 & +x(59)*zz**2 +x(60)*xx*zz
4111 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4112 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4113 & +(pom1-pom2)*pom_dy
4115 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4118 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4119 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4120 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4121 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4122 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4123 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4124 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4125 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4127 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4130 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4131 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4132 & +pom1*pom_dt1+pom2*pom_dt2
4134 write(2,*), "de_dt = ", de_dt,de_dt_num
4138 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4139 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4140 cosfac2xx=cosfac2*xx
4141 sinfac2yy=sinfac2*yy
4143 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4145 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4147 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4148 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4149 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4150 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4151 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4152 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4153 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4154 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4155 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4156 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4160 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4161 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4162 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4163 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4166 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4167 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4168 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4170 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4171 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4175 dXX_Ctab(k,i)=dXX_Ci(k)
4176 dXX_C1tab(k,i)=dXX_Ci1(k)
4177 dYY_Ctab(k,i)=dYY_Ci(k)
4178 dYY_C1tab(k,i)=dYY_Ci1(k)
4179 dZZ_Ctab(k,i)=dZZ_Ci(k)
4180 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4181 dXX_XYZtab(k,i)=dXX_XYZ(k)
4182 dYY_XYZtab(k,i)=dYY_XYZ(k)
4183 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4187 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4188 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4189 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4190 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4191 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4193 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4194 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4195 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4196 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4197 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4198 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4199 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4200 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4202 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4203 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4205 C to check gradient call subroutine check_grad
4212 c------------------------------------------------------------------------------
4213 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4215 C This procedure calculates two-body contact function g(rij) and its derivative:
4218 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4221 C where x=(rij-r0ij)/delta
4223 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4226 double precision rij,r0ij,eps0ij,fcont,fprimcont
4227 double precision x,x2,x4,delta
4231 if (x.lt.-1.0D0) then
4234 else if (x.le.1.0D0) then
4237 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4238 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4245 c------------------------------------------------------------------------------
4246 subroutine splinthet(theti,delta,ss,ssder)
4247 implicit real*8 (a-h,o-z)
4248 include 'DIMENSIONS'
4249 include 'sizesclu.dat'
4250 include 'COMMON.VAR'
4251 include 'COMMON.GEO'
4254 if (theti.gt.pipol) then
4255 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4257 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4262 c------------------------------------------------------------------------------
4263 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4265 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4266 double precision ksi,ksi2,ksi3,a1,a2,a3
4267 a1=fprim0*delta/(f1-f0)
4273 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4274 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4277 c------------------------------------------------------------------------------
4278 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4280 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4281 double precision ksi,ksi2,ksi3,a1,a2,a3
4286 a2=3*(f1x-f0x)-2*fprim0x*delta
4287 a3=fprim0x*delta-2*(f1x-f0x)
4288 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4291 C-----------------------------------------------------------------------------
4293 C-----------------------------------------------------------------------------
4294 subroutine etor(etors,edihcnstr,fact)
4295 implicit real*8 (a-h,o-z)
4296 include 'DIMENSIONS'
4297 include 'sizesclu.dat'
4298 include 'COMMON.VAR'
4299 include 'COMMON.GEO'
4300 include 'COMMON.LOCAL'
4301 include 'COMMON.TORSION'
4302 include 'COMMON.INTERACT'
4303 include 'COMMON.DERIV'
4304 include 'COMMON.CHAIN'
4305 include 'COMMON.NAMES'
4306 include 'COMMON.IOUNITS'
4307 include 'COMMON.FFIELD'
4308 include 'COMMON.TORCNSTR'
4310 C Set lprn=.true. for debugging
4314 do i=iphi_start,iphi_end
4315 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4316 & .or. itype(i).eq.ntyp1) cycle
4317 itori=itortyp(itype(i-2))
4318 itori1=itortyp(itype(i-1))
4321 C Proline-Proline pair is a special case...
4322 if (itori.eq.3 .and. itori1.eq.3) then
4323 if (phii.gt.-dwapi3) then
4325 fac=1.0D0/(1.0D0-cosphi)
4326 etorsi=v1(1,3,3)*fac
4327 etorsi=etorsi+etorsi
4328 etors=etors+etorsi-v1(1,3,3)
4329 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4332 v1ij=v1(j+1,itori,itori1)
4333 v2ij=v2(j+1,itori,itori1)
4336 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4337 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4341 v1ij=v1(j,itori,itori1)
4342 v2ij=v2(j,itori,itori1)
4345 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4346 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4350 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4351 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4352 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4353 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4354 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4356 ! 6/20/98 - dihedral angle constraints
4359 itori=idih_constr(i)
4362 if (difi.gt.drange(i)) then
4364 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4365 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4366 else if (difi.lt.-drange(i)) then
4368 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4369 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4371 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4372 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4374 ! write (iout,*) 'edihcnstr',edihcnstr
4377 c------------------------------------------------------------------------------
4379 subroutine etor(etors,edihcnstr,fact)
4380 implicit real*8 (a-h,o-z)
4381 include 'DIMENSIONS'
4382 include 'sizesclu.dat'
4383 include 'COMMON.VAR'
4384 include 'COMMON.GEO'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.TORSION'
4387 include 'COMMON.INTERACT'
4388 include 'COMMON.DERIV'
4389 include 'COMMON.CHAIN'
4390 include 'COMMON.NAMES'
4391 include 'COMMON.IOUNITS'
4392 include 'COMMON.FFIELD'
4393 include 'COMMON.TORCNSTR'
4395 C Set lprn=.true. for debugging
4399 do i=iphi_start,iphi_end
4400 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4401 & .or. itype(i).eq.ntyp1) cycle
4402 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4403 if (iabs(itype(i)).eq.20) then
4408 itori=itortyp(itype(i-2))
4409 itori1=itortyp(itype(i-1))
4412 C Regular cosine and sine terms
4413 do j=1,nterm(itori,itori1,iblock)
4414 v1ij=v1(j,itori,itori1,iblock)
4415 v2ij=v2(j,itori,itori1,iblock)
4418 etors=etors+v1ij*cosphi+v2ij*sinphi
4419 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4423 C E = SUM ----------------------------------- - v1
4424 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4426 cosphi=dcos(0.5d0*phii)
4427 sinphi=dsin(0.5d0*phii)
4428 do j=1,nlor(itori,itori1,iblock)
4429 vl1ij=vlor1(j,itori,itori1)
4430 vl2ij=vlor2(j,itori,itori1)
4431 vl3ij=vlor3(j,itori,itori1)
4432 pom=vl2ij*cosphi+vl3ij*sinphi
4433 pom1=1.0d0/(pom*pom+1.0d0)
4434 etors=etors+vl1ij*pom1
4436 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4438 C Subtract the constant term
4439 etors=etors-v0(itori,itori1,iblock)
4441 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4442 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4443 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4444 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4445 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4448 ! 6/20/98 - dihedral angle constraints
4451 itori=idih_constr(i)
4453 difi=pinorm(phii-phi0(i))
4455 if (difi.gt.drange(i)) then
4457 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4458 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4459 edihi=0.25d0*ftors*difi**4
4460 else if (difi.lt.-drange(i)) then
4462 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4463 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4464 edihi=0.25d0*ftors*difi**4
4468 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4470 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4471 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4473 ! write (iout,*) 'edihcnstr',edihcnstr
4476 c----------------------------------------------------------------------------
4477 subroutine etor_d(etors_d,fact2)
4478 C 6/23/01 Compute double torsional energy
4479 implicit real*8 (a-h,o-z)
4480 include 'DIMENSIONS'
4481 include 'sizesclu.dat'
4482 include 'COMMON.VAR'
4483 include 'COMMON.GEO'
4484 include 'COMMON.LOCAL'
4485 include 'COMMON.TORSION'
4486 include 'COMMON.INTERACT'
4487 include 'COMMON.DERIV'
4488 include 'COMMON.CHAIN'
4489 include 'COMMON.NAMES'
4490 include 'COMMON.IOUNITS'
4491 include 'COMMON.FFIELD'
4492 include 'COMMON.TORCNSTR'
4494 C Set lprn=.true. for debugging
4498 do i=iphi_start,iphi_end-1
4499 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4500 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4501 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4503 itori=itortyp(itype(i-2))
4504 itori1=itortyp(itype(i-1))
4505 itori2=itortyp(itype(i))
4511 if (iabs(itype(i+1)).eq.20) iblock=2
4512 C Regular cosine and sine terms
4513 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4514 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4515 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4516 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4517 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4518 cosphi1=dcos(j*phii)
4519 sinphi1=dsin(j*phii)
4520 cosphi2=dcos(j*phii1)
4521 sinphi2=dsin(j*phii1)
4522 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4523 & v2cij*cosphi2+v2sij*sinphi2
4524 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4525 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4527 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4529 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4530 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4531 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4532 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4533 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4534 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4535 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4536 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4537 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4538 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4539 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4540 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4541 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4542 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4545 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4546 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4552 c------------------------------------------------------------------------------
4553 subroutine eback_sc_corr(esccor)
4554 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4555 c conformational states; temporarily implemented as differences
4556 c between UNRES torsional potentials (dependent on three types of
4557 c residues) and the torsional potentials dependent on all 20 types
4558 c of residues computed from AM1 energy surfaces of terminally-blocked
4559 c amino-acid residues.
4560 implicit real*8 (a-h,o-z)
4561 include 'DIMENSIONS'
4562 include 'sizesclu.dat'
4563 include 'COMMON.VAR'
4564 include 'COMMON.GEO'
4565 include 'COMMON.LOCAL'
4566 include 'COMMON.TORSION'
4567 include 'COMMON.SCCOR'
4568 include 'COMMON.INTERACT'
4569 include 'COMMON.DERIV'
4570 include 'COMMON.CHAIN'
4571 include 'COMMON.NAMES'
4572 include 'COMMON.IOUNITS'
4573 include 'COMMON.FFIELD'
4574 include 'COMMON.CONTROL'
4576 C Set lprn=.true. for debugging
4579 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4581 do i=itau_start,itau_end
4582 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4584 isccori=isccortyp(itype(i-2))
4585 isccori1=isccortyp(itype(i-1))
4587 do intertyp=1,3 !intertyp
4588 cc Added 09 May 2012 (Adasko)
4589 cc Intertyp means interaction type of backbone mainchain correlation:
4590 c 1 = SC...Ca...Ca...Ca
4591 c 2 = Ca...Ca...Ca...SC
4592 c 3 = SC...Ca...Ca...SCi
4594 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4595 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4596 & (itype(i-1).eq.ntyp1)))
4597 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4598 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4599 & .or.(itype(i).eq.ntyp1)))
4600 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4601 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4602 & (itype(i-3).eq.ntyp1)))) cycle
4603 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4604 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4606 do j=1,nterm_sccor(isccori,isccori1)
4607 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4608 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4609 cosphi=dcos(j*tauangle(intertyp,i))
4610 sinphi=dsin(j*tauangle(intertyp,i))
4611 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4612 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4614 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4615 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4617 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4618 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4619 & (v1sccor(j,1,itori,itori1),j=1,6),
4620 & (v2sccor(j,1,itori,itori1),j=1,6)
4621 gsccor_loc(i-3)=gloci
4626 c------------------------------------------------------------------------------
4627 subroutine multibody(ecorr)
4628 C This subroutine calculates multi-body contributions to energy following
4629 C the idea of Skolnick et al. If side chains I and J make a contact and
4630 C at the same time side chains I+1 and J+1 make a contact, an extra
4631 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 include 'COMMON.IOUNITS'
4635 include 'COMMON.DERIV'
4636 include 'COMMON.INTERACT'
4637 include 'COMMON.CONTACTS'
4638 double precision gx(3),gx1(3)
4641 C Set lprn=.true. for debugging
4645 write (iout,'(a)') 'Contact function values:'
4647 write (iout,'(i2,20(1x,i2,f10.5))')
4648 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4663 num_conti=num_cont(i)
4664 num_conti1=num_cont(i1)
4669 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4670 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4671 cd & ' ishift=',ishift
4672 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4673 C The system gains extra energy.
4674 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4675 endif ! j1==j+-ishift
4684 c------------------------------------------------------------------------------
4685 double precision function esccorr(i,j,k,l,jj,kk)
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'COMMON.IOUNITS'
4689 include 'COMMON.DERIV'
4690 include 'COMMON.INTERACT'
4691 include 'COMMON.CONTACTS'
4692 double precision gx(3),gx1(3)
4697 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4698 C Calculate the multi-body contribution to energy.
4699 C Calculate multi-body contributions to the gradient.
4700 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4701 cd & k,l,(gacont(m,kk,k),m=1,3)
4703 gx(m) =ekl*gacont(m,jj,i)
4704 gx1(m)=eij*gacont(m,kk,k)
4705 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4706 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4707 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4708 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4712 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4717 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4723 c------------------------------------------------------------------------------
4725 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4726 implicit real*8 (a-h,o-z)
4727 include 'DIMENSIONS'
4728 integer dimen1,dimen2,atom,indx
4729 double precision buffer(dimen1,dimen2)
4730 double precision zapas
4731 common /contacts_hb/ zapas(3,20,maxres,7),
4732 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4733 & num_cont_hb(maxres),jcont_hb(20,maxres)
4734 num_kont=num_cont_hb(atom)
4738 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4741 buffer(i,indx+22)=facont_hb(i,atom)
4742 buffer(i,indx+23)=ees0p(i,atom)
4743 buffer(i,indx+24)=ees0m(i,atom)
4744 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4746 buffer(1,indx+26)=dfloat(num_kont)
4749 c------------------------------------------------------------------------------
4750 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4751 implicit real*8 (a-h,o-z)
4752 include 'DIMENSIONS'
4753 integer dimen1,dimen2,atom,indx
4754 double precision buffer(dimen1,dimen2)
4755 double precision zapas
4756 common /contacts_hb/ zapas(3,20,maxres,7),
4757 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4758 & num_cont_hb(maxres),jcont_hb(20,maxres)
4759 num_kont=buffer(1,indx+26)
4760 num_kont_old=num_cont_hb(atom)
4761 num_cont_hb(atom)=num_kont+num_kont_old
4766 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4769 facont_hb(ii,atom)=buffer(i,indx+22)
4770 ees0p(ii,atom)=buffer(i,indx+23)
4771 ees0m(ii,atom)=buffer(i,indx+24)
4772 jcont_hb(ii,atom)=buffer(i,indx+25)
4776 c------------------------------------------------------------------------------
4778 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4779 C This subroutine calculates multi-body contributions to hydrogen-bonding
4780 implicit real*8 (a-h,o-z)
4781 include 'DIMENSIONS'
4782 include 'sizesclu.dat'
4783 include 'COMMON.IOUNITS'
4785 include 'COMMON.INFO'
4787 include 'COMMON.FFIELD'
4788 include 'COMMON.DERIV'
4789 include 'COMMON.INTERACT'
4790 include 'COMMON.CONTACTS'
4792 parameter (max_cont=maxconts)
4793 parameter (max_dim=2*(8*3+2))
4794 parameter (msglen1=max_cont*max_dim*4)
4795 parameter (msglen2=2*msglen1)
4796 integer source,CorrelType,CorrelID,Error
4797 double precision buffer(max_cont,max_dim)
4799 double precision gx(3),gx1(3)
4802 C Set lprn=.true. for debugging
4807 if (fgProcs.le.1) goto 30
4809 write (iout,'(a)') 'Contact function values:'
4811 write (iout,'(2i3,50(1x,i2,f5.2))')
4812 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4813 & j=1,num_cont_hb(i))
4816 C Caution! Following code assumes that electrostatic interactions concerning
4817 C a given atom are split among at most two processors!
4827 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4830 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4831 if (MyRank.gt.0) then
4832 C Send correlation contributions to the preceding processor
4834 nn=num_cont_hb(iatel_s)
4835 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4836 cd write (iout,*) 'The BUFFER array:'
4838 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4840 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4842 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4843 C Clear the contacts of the atom passed to the neighboring processor
4844 nn=num_cont_hb(iatel_s+1)
4846 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4848 num_cont_hb(iatel_s)=0
4850 cd write (iout,*) 'Processor ',MyID,MyRank,
4851 cd & ' is sending correlation contribution to processor',MyID-1,
4852 cd & ' msglen=',msglen
4853 cd write (*,*) 'Processor ',MyID,MyRank,
4854 cd & ' is sending correlation contribution to processor',MyID-1,
4855 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4856 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4857 cd write (iout,*) 'Processor ',MyID,
4858 cd & ' has sent correlation contribution to processor',MyID-1,
4859 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4860 cd write (*,*) 'Processor ',MyID,
4861 cd & ' has sent correlation contribution to processor',MyID-1,
4862 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4864 endif ! (MyRank.gt.0)
4868 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4869 if (MyRank.lt.fgProcs-1) then
4870 C Receive correlation contributions from the next processor
4872 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4873 cd write (iout,*) 'Processor',MyID,
4874 cd & ' is receiving correlation contribution from processor',MyID+1,
4875 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4876 cd write (*,*) 'Processor',MyID,
4877 cd & ' is receiving correlation contribution from processor',MyID+1,
4878 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4880 do while (nbytes.le.0)
4881 call mp_probe(MyID+1,CorrelType,nbytes)
4883 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4884 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4885 cd write (iout,*) 'Processor',MyID,
4886 cd & ' has received correlation contribution from processor',MyID+1,
4887 cd & ' msglen=',msglen,' nbytes=',nbytes
4888 cd write (iout,*) 'The received BUFFER array:'
4890 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4892 if (msglen.eq.msglen1) then
4893 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4894 else if (msglen.eq.msglen2) then
4895 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4896 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4899 & 'ERROR!!!! message length changed while processing correlations.'
4901 & 'ERROR!!!! message length changed while processing correlations.'
4902 call mp_stopall(Error)
4903 endif ! msglen.eq.msglen1
4904 endif ! MyRank.lt.fgProcs-1
4911 write (iout,'(a)') 'Contact function values:'
4913 write (iout,'(2i3,50(1x,i2,f5.2))')
4914 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4915 & j=1,num_cont_hb(i))
4919 C Remove the loop below after debugging !!!
4926 C Calculate the local-electrostatic correlation terms
4927 do i=iatel_s,iatel_e+1
4929 num_conti=num_cont_hb(i)
4930 num_conti1=num_cont_hb(i+1)
4935 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4936 c & ' jj=',jj,' kk=',kk
4937 if (j1.eq.j+1 .or. j1.eq.j-1) then
4938 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4939 C The system gains extra energy.
4940 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4942 else if (j1.eq.j) then
4943 C Contacts I-J and I-(J+1) occur simultaneously.
4944 C The system loses extra energy.
4945 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4950 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4951 c & ' jj=',jj,' kk=',kk
4953 C Contacts I-J and (I+1)-J occur simultaneously.
4954 C The system loses extra energy.
4955 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4962 c------------------------------------------------------------------------------
4963 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4965 C This subroutine calculates multi-body contributions to hydrogen-bonding
4966 implicit real*8 (a-h,o-z)
4967 include 'DIMENSIONS'
4968 include 'sizesclu.dat'
4969 include 'COMMON.IOUNITS'
4971 include 'COMMON.INFO'
4973 include 'COMMON.FFIELD'
4974 include 'COMMON.DERIV'
4975 include 'COMMON.INTERACT'
4976 include 'COMMON.CONTACTS'
4978 parameter (max_cont=maxconts)
4979 parameter (max_dim=2*(8*3+2))
4980 parameter (msglen1=max_cont*max_dim*4)
4981 parameter (msglen2=2*msglen1)
4982 integer source,CorrelType,CorrelID,Error
4983 double precision buffer(max_cont,max_dim)
4985 double precision gx(3),gx1(3)
4988 C Set lprn=.true. for debugging
4994 if (fgProcs.le.1) goto 30
4996 write (iout,'(a)') 'Contact function values:'
4998 write (iout,'(2i3,50(1x,i2,f5.2))')
4999 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5000 & j=1,num_cont_hb(i))
5003 C Caution! Following code assumes that electrostatic interactions concerning
5004 C a given atom are split among at most two processors!
5014 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5017 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5018 if (MyRank.gt.0) then
5019 C Send correlation contributions to the preceding processor
5021 nn=num_cont_hb(iatel_s)
5022 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5023 cd write (iout,*) 'The BUFFER array:'
5025 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5027 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5029 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5030 C Clear the contacts of the atom passed to the neighboring processor
5031 nn=num_cont_hb(iatel_s+1)
5033 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5035 num_cont_hb(iatel_s)=0
5037 cd write (iout,*) 'Processor ',MyID,MyRank,
5038 cd & ' is sending correlation contribution to processor',MyID-1,
5039 cd & ' msglen=',msglen
5040 cd write (*,*) 'Processor ',MyID,MyRank,
5041 cd & ' is sending correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5043 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5044 cd write (iout,*) 'Processor ',MyID,
5045 cd & ' has sent correlation contribution to processor',MyID-1,
5046 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5047 cd write (*,*) 'Processor ',MyID,
5048 cd & ' has sent correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5051 endif ! (MyRank.gt.0)
5055 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5056 if (MyRank.lt.fgProcs-1) then
5057 C Receive correlation contributions from the next processor
5059 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5060 cd write (iout,*) 'Processor',MyID,
5061 cd & ' is receiving correlation contribution from processor',MyID+1,
5062 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5063 cd write (*,*) 'Processor',MyID,
5064 cd & ' is receiving correlation contribution from processor',MyID+1,
5065 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5067 do while (nbytes.le.0)
5068 call mp_probe(MyID+1,CorrelType,nbytes)
5070 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5071 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5072 cd write (iout,*) 'Processor',MyID,
5073 cd & ' has received correlation contribution from processor',MyID+1,
5074 cd & ' msglen=',msglen,' nbytes=',nbytes
5075 cd write (iout,*) 'The received BUFFER array:'
5077 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5079 if (msglen.eq.msglen1) then
5080 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5081 else if (msglen.eq.msglen2) then
5082 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5083 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5086 & 'ERROR!!!! message length changed while processing correlations.'
5088 & 'ERROR!!!! message length changed while processing correlations.'
5089 call mp_stopall(Error)
5090 endif ! msglen.eq.msglen1
5091 endif ! MyRank.lt.fgProcs-1
5098 write (iout,'(a)') 'Contact function values:'
5100 write (iout,'(2i3,50(1x,i2,f5.2))')
5101 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5102 & j=1,num_cont_hb(i))
5108 C Remove the loop below after debugging !!!
5115 C Calculate the dipole-dipole interaction energies
5116 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5117 do i=iatel_s,iatel_e+1
5118 num_conti=num_cont_hb(i)
5125 C Calculate the local-electrostatic correlation terms
5126 do i=iatel_s,iatel_e+1
5128 num_conti=num_cont_hb(i)
5129 num_conti1=num_cont_hb(i+1)
5134 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5135 c & ' jj=',jj,' kk=',kk
5136 if (j1.eq.j+1 .or. j1.eq.j-1) then
5137 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5138 C The system gains extra energy.
5140 sqd1=dsqrt(d_cont(jj,i))
5141 sqd2=dsqrt(d_cont(kk,i1))
5142 sred_geom = sqd1*sqd2
5143 IF (sred_geom.lt.cutoff_corr) THEN
5144 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5146 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5147 c & ' jj=',jj,' kk=',kk
5148 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5149 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5151 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5152 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5155 cd write (iout,*) 'sred_geom=',sred_geom,
5156 cd & ' ekont=',ekont,' fprim=',fprimcont
5157 call calc_eello(i,j,i+1,j1,jj,kk)
5158 if (wcorr4.gt.0.0d0)
5159 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5160 if (wcorr5.gt.0.0d0)
5161 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5162 c print *,"wcorr5",ecorr5
5163 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5164 cd write(2,*)'ijkl',i,j,i+1,j1
5165 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5166 & .or. wturn6.eq.0.0d0))then
5167 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5168 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5169 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5170 cd & 'ecorr6=',ecorr6
5171 cd write (iout,'(4e15.5)') sred_geom,
5172 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5173 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5174 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5175 else if (wturn6.gt.0.0d0
5176 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5177 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5178 eturn6=eturn6+eello_turn6(i,jj,kk)
5179 cd write (2,*) 'multibody_eello:eturn6',eturn6
5183 else if (j1.eq.j) then
5184 C Contacts I-J and I-(J+1) occur simultaneously.
5185 C The system loses extra energy.
5186 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5191 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5192 c & ' jj=',jj,' kk=',kk
5194 C Contacts I-J and (I+1)-J occur simultaneously.
5195 C The system loses extra energy.
5196 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5203 c------------------------------------------------------------------------------
5204 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5205 implicit real*8 (a-h,o-z)
5206 include 'DIMENSIONS'
5207 include 'COMMON.IOUNITS'
5208 include 'COMMON.DERIV'
5209 include 'COMMON.INTERACT'
5210 include 'COMMON.CONTACTS'
5211 double precision gx(3),gx1(3)
5221 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5222 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5223 C Following 4 lines for diagnostics.
5228 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5230 c write (iout,*)'Contacts have occurred for peptide groups',
5231 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5232 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5233 C Calculate the multi-body contribution to energy.
5234 ecorr=ecorr+ekont*ees
5236 C Calculate multi-body contributions to the gradient.
5238 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5239 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5240 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5241 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5242 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5243 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5244 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5245 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5246 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5247 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5248 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5249 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5250 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5251 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5255 gradcorr(ll,m)=gradcorr(ll,m)+
5256 & ees*ekl*gacont_hbr(ll,jj,i)-
5257 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5258 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5263 gradcorr(ll,m)=gradcorr(ll,m)+
5264 & ees*eij*gacont_hbr(ll,kk,k)-
5265 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5266 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5273 C---------------------------------------------------------------------------
5274 subroutine dipole(i,j,jj)
5275 implicit real*8 (a-h,o-z)
5276 include 'DIMENSIONS'
5277 include 'sizesclu.dat'
5278 include 'COMMON.IOUNITS'
5279 include 'COMMON.CHAIN'
5280 include 'COMMON.FFIELD'
5281 include 'COMMON.DERIV'
5282 include 'COMMON.INTERACT'
5283 include 'COMMON.CONTACTS'
5284 include 'COMMON.TORSION'
5285 include 'COMMON.VAR'
5286 include 'COMMON.GEO'
5287 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5289 iti1 = itortyp(itype(i+1))
5290 if (j.lt.nres-1) then
5291 if (itype(j).le.ntyp) then
5292 itj1 = itortyp(itype(j+1))
5300 dipi(iii,1)=Ub2(iii,i)
5301 dipderi(iii)=Ub2der(iii,i)
5302 dipi(iii,2)=b1(iii,iti1)
5303 dipj(iii,1)=Ub2(iii,j)
5304 dipderj(iii)=Ub2der(iii,j)
5305 dipj(iii,2)=b1(iii,itj1)
5309 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5312 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5315 if (.not.calc_grad) return
5320 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5324 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5329 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5330 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5332 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5334 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5336 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5340 C---------------------------------------------------------------------------
5341 subroutine calc_eello(i,j,k,l,jj,kk)
5343 C This subroutine computes matrices and vectors needed to calculate
5344 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5346 implicit real*8 (a-h,o-z)
5347 include 'DIMENSIONS'
5348 include 'sizesclu.dat'
5349 include 'COMMON.IOUNITS'
5350 include 'COMMON.CHAIN'
5351 include 'COMMON.DERIV'
5352 include 'COMMON.INTERACT'
5353 include 'COMMON.CONTACTS'
5354 include 'COMMON.TORSION'
5355 include 'COMMON.VAR'
5356 include 'COMMON.GEO'
5357 include 'COMMON.FFIELD'
5358 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5359 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5362 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5363 cd & ' jj=',jj,' kk=',kk
5364 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5367 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5368 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5371 call transpose2(aa1(1,1),aa1t(1,1))
5372 call transpose2(aa2(1,1),aa2t(1,1))
5375 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5376 & aa1tder(1,1,lll,kkk))
5377 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5378 & aa2tder(1,1,lll,kkk))
5382 C parallel orientation of the two CA-CA-CA frames.
5384 if (i.gt.1 .and. itype(i).le.ntyp) then
5385 iti=itortyp(itype(i))
5389 itk1=itortyp(itype(k+1))
5390 itj=itortyp(itype(j))
5391 c if (l.lt.nres-1) then
5392 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5393 itl1=itortyp(itype(l+1))
5397 C A1 kernel(j+1) A2T
5399 cd write (iout,'(3f10.5,5x,3f10.5)')
5400 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5402 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5403 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5404 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5405 C Following matrices are needed only for 6-th order cumulants
5406 IF (wcorr6.gt.0.0d0) THEN
5407 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5408 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5409 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5410 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5411 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5412 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5413 & ADtEAderx(1,1,1,1,1,1))
5415 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5416 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5417 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5418 & ADtEA1derx(1,1,1,1,1,1))
5420 C End 6-th order cumulants
5423 cd write (2,*) 'In calc_eello6'
5425 cd write (2,*) 'iii=',iii
5427 cd write (2,*) 'kkk=',kkk
5429 cd write (2,'(3(2f10.5),5x)')
5430 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5435 call transpose2(EUgder(1,1,k),auxmat(1,1))
5436 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5437 call transpose2(EUg(1,1,k),auxmat(1,1))
5438 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5439 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5443 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5444 & EAEAderx(1,1,lll,kkk,iii,1))
5448 C A1T kernel(i+1) A2
5449 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5450 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5451 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5452 C Following matrices are needed only for 6-th order cumulants
5453 IF (wcorr6.gt.0.0d0) THEN
5454 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5455 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5456 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5457 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5458 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5459 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5460 & ADtEAderx(1,1,1,1,1,2))
5461 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5462 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5463 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5464 & ADtEA1derx(1,1,1,1,1,2))
5466 C End 6-th order cumulants
5467 call transpose2(EUgder(1,1,l),auxmat(1,1))
5468 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5469 call transpose2(EUg(1,1,l),auxmat(1,1))
5470 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5471 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5475 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5476 & EAEAderx(1,1,lll,kkk,iii,2))
5481 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5482 C They are needed only when the fifth- or the sixth-order cumulants are
5484 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5485 call transpose2(AEA(1,1,1),auxmat(1,1))
5486 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5487 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5488 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5489 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5490 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5491 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5492 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5493 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5494 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5495 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5496 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5497 call transpose2(AEA(1,1,2),auxmat(1,1))
5498 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5499 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5500 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5501 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5502 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5503 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5504 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5505 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5506 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5507 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5508 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5509 C Calculate the Cartesian derivatives of the vectors.
5513 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5514 call matvec2(auxmat(1,1),b1(1,iti),
5515 & AEAb1derx(1,lll,kkk,iii,1,1))
5516 call matvec2(auxmat(1,1),Ub2(1,i),
5517 & AEAb2derx(1,lll,kkk,iii,1,1))
5518 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5519 & AEAb1derx(1,lll,kkk,iii,2,1))
5520 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5521 & AEAb2derx(1,lll,kkk,iii,2,1))
5522 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5523 call matvec2(auxmat(1,1),b1(1,itj),
5524 & AEAb1derx(1,lll,kkk,iii,1,2))
5525 call matvec2(auxmat(1,1),Ub2(1,j),
5526 & AEAb2derx(1,lll,kkk,iii,1,2))
5527 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5528 & AEAb1derx(1,lll,kkk,iii,2,2))
5529 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5530 & AEAb2derx(1,lll,kkk,iii,2,2))
5537 C Antiparallel orientation of the two CA-CA-CA frames.
5539 if (i.gt.1 .and. itype(i).le.ntyp) then
5540 iti=itortyp(itype(i))
5544 itk1=itortyp(itype(k+1))
5545 itl=itortyp(itype(l))
5546 itj=itortyp(itype(j))
5547 c if (j.lt.nres-1) then
5548 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5549 itj1=itortyp(itype(j+1))
5553 C A2 kernel(j-1)T A1T
5554 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5555 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5556 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5557 C Following matrices are needed only for 6-th order cumulants
5558 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5559 & j.eq.i+4 .and. l.eq.i+3)) THEN
5560 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5561 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5562 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5563 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5564 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5565 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5566 & ADtEAderx(1,1,1,1,1,1))
5567 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5568 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5569 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5570 & ADtEA1derx(1,1,1,1,1,1))
5572 C End 6-th order cumulants
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 A2T kernel(i+1)T A1
5587 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5588 & a_chuj_der(1,1,1,1,jj,i),1,.true.,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 .or. (wturn6.gt.0.0d0 .and.
5592 & j.eq.i+4 .and. l.eq.i+3)) THEN
5593 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5594 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5595 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5596 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5597 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5598 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5599 & ADtEAderx(1,1,1,1,1,2))
5600 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5601 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5602 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5603 & ADtEA1derx(1,1,1,1,1,2))
5605 C End 6-th order cumulants
5606 call transpose2(EUgder(1,1,j),auxmat(1,1))
5607 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5608 call transpose2(EUg(1,1,j),auxmat(1,1))
5609 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5610 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5614 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5615 & EAEAderx(1,1,lll,kkk,iii,2))
5620 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5621 C They are needed only when the fifth- or the sixth-order cumulants are
5623 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5624 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5625 call transpose2(AEA(1,1,1),auxmat(1,1))
5626 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5627 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5628 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5629 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5630 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5631 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5632 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5633 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5634 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5635 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5636 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5637 call transpose2(AEA(1,1,2),auxmat(1,1))
5638 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5639 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5640 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5641 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5642 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5643 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5644 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5645 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5646 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5647 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5648 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5649 C Calculate the Cartesian derivatives of the vectors.
5653 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5654 call matvec2(auxmat(1,1),b1(1,iti),
5655 & AEAb1derx(1,lll,kkk,iii,1,1))
5656 call matvec2(auxmat(1,1),Ub2(1,i),
5657 & AEAb2derx(1,lll,kkk,iii,1,1))
5658 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5659 & AEAb1derx(1,lll,kkk,iii,2,1))
5660 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5661 & AEAb2derx(1,lll,kkk,iii,2,1))
5662 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5663 call matvec2(auxmat(1,1),b1(1,itl),
5664 & AEAb1derx(1,lll,kkk,iii,1,2))
5665 call matvec2(auxmat(1,1),Ub2(1,l),
5666 & AEAb2derx(1,lll,kkk,iii,1,2))
5667 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5668 & AEAb1derx(1,lll,kkk,iii,2,2))
5669 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5670 & AEAb2derx(1,lll,kkk,iii,2,2))
5679 C---------------------------------------------------------------------------
5680 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5681 & KK,KKderg,AKA,AKAderg,AKAderx)
5685 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5686 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5687 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5692 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5694 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5697 cd if (lprn) write (2,*) 'In kernel'
5699 cd if (lprn) write (2,*) 'kkk=',kkk
5701 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5702 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5704 cd write (2,*) 'lll=',lll
5705 cd write (2,*) 'iii=1'
5707 cd write (2,'(3(2f10.5),5x)')
5708 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5711 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5712 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5714 cd write (2,*) 'lll=',lll
5715 cd write (2,*) 'iii=2'
5717 cd write (2,'(3(2f10.5),5x)')
5718 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5725 C---------------------------------------------------------------------------
5726 double precision function eello4(i,j,k,l,jj,kk)
5727 implicit real*8 (a-h,o-z)
5728 include 'DIMENSIONS'
5729 include 'sizesclu.dat'
5730 include 'COMMON.IOUNITS'
5731 include 'COMMON.CHAIN'
5732 include 'COMMON.DERIV'
5733 include 'COMMON.INTERACT'
5734 include 'COMMON.CONTACTS'
5735 include 'COMMON.TORSION'
5736 include 'COMMON.VAR'
5737 include 'COMMON.GEO'
5738 double precision pizda(2,2),ggg1(3),ggg2(3)
5739 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5743 cd print *,'eello4:',i,j,k,l,jj,kk
5744 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5745 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5746 cold eij=facont_hb(jj,i)
5747 cold ekl=facont_hb(kk,k)
5749 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5751 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5752 gcorr_loc(k-1)=gcorr_loc(k-1)
5753 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5755 gcorr_loc(l-1)=gcorr_loc(l-1)
5756 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5758 gcorr_loc(j-1)=gcorr_loc(j-1)
5759 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5764 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5765 & -EAEAderx(2,2,lll,kkk,iii,1)
5766 cd derx(lll,kkk,iii)=0.0d0
5770 cd gcorr_loc(l-1)=0.0d0
5771 cd gcorr_loc(j-1)=0.0d0
5772 cd gcorr_loc(k-1)=0.0d0
5774 cd write (iout,*)'Contacts have occurred for peptide groups',
5775 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5776 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5777 if (j.lt.nres-1) then
5784 if (l.lt.nres-1) then
5792 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5793 ggg1(ll)=eel4*g_contij(ll,1)
5794 ggg2(ll)=eel4*g_contij(ll,2)
5795 ghalf=0.5d0*ggg1(ll)
5797 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5798 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5799 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5800 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5801 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5802 ghalf=0.5d0*ggg2(ll)
5804 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5805 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5806 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5807 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5812 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5813 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5818 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5819 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5825 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5830 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5834 cd write (2,*) iii,gcorr_loc(iii)
5838 cd write (2,*) 'ekont',ekont
5839 cd write (iout,*) 'eello4',ekont*eel4
5842 C---------------------------------------------------------------------------
5843 double precision function eello5(i,j,k,l,jj,kk)
5844 implicit real*8 (a-h,o-z)
5845 include 'DIMENSIONS'
5846 include 'sizesclu.dat'
5847 include 'COMMON.IOUNITS'
5848 include 'COMMON.CHAIN'
5849 include 'COMMON.DERIV'
5850 include 'COMMON.INTERACT'
5851 include 'COMMON.CONTACTS'
5852 include 'COMMON.TORSION'
5853 include 'COMMON.VAR'
5854 include 'COMMON.GEO'
5855 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5856 double precision ggg1(3),ggg2(3)
5857 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5862 C /l\ / \ \ / \ / \ / C
5863 C / \ / \ \ / \ / \ / C
5864 C j| o |l1 | o | o| o | | o |o C
5865 C \ |/k\| |/ \| / |/ \| |/ \| C
5866 C \i/ \ / \ / / \ / \ C
5868 C (I) (II) (III) (IV) C
5870 C eello5_1 eello5_2 eello5_3 eello5_4 C
5872 C Antiparallel chains C
5875 C /j\ / \ \ / \ / \ / C
5876 C / \ / \ \ / \ / \ / C
5877 C j1| o |l | o | o| o | | o |o C
5878 C \ |/k\| |/ \| / |/ \| |/ \| C
5879 C \i/ \ / \ / / \ / \ C
5881 C (I) (II) (III) (IV) C
5883 C eello5_1 eello5_2 eello5_3 eello5_4 C
5885 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5887 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5888 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5893 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5895 itk=itortyp(itype(k))
5896 itl=itortyp(itype(l))
5897 itj=itortyp(itype(j))
5902 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5903 cd & eel5_3_num,eel5_4_num)
5907 derx(lll,kkk,iii)=0.0d0
5911 cd eij=facont_hb(jj,i)
5912 cd ekl=facont_hb(kk,k)
5914 cd write (iout,*)'Contacts have occurred for peptide groups',
5915 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5917 C Contribution from the graph I.
5918 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5919 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5920 call transpose2(EUg(1,1,k),auxmat(1,1))
5921 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5922 vv(1)=pizda(1,1)-pizda(2,2)
5923 vv(2)=pizda(1,2)+pizda(2,1)
5924 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5925 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5927 C Explicit gradient in virtual-dihedral angles.
5928 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5929 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5930 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5931 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5932 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5933 vv(1)=pizda(1,1)-pizda(2,2)
5934 vv(2)=pizda(1,2)+pizda(2,1)
5935 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5936 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5937 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5938 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5939 vv(1)=pizda(1,1)-pizda(2,2)
5940 vv(2)=pizda(1,2)+pizda(2,1)
5942 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5943 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5944 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5946 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5947 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5948 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5950 C Cartesian gradient
5954 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5956 vv(1)=pizda(1,1)-pizda(2,2)
5957 vv(2)=pizda(1,2)+pizda(2,1)
5958 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5959 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5960 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5967 C Contribution from graph II
5968 call transpose2(EE(1,1,itk),auxmat(1,1))
5969 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5970 vv(1)=pizda(1,1)+pizda(2,2)
5971 vv(2)=pizda(2,1)-pizda(1,2)
5972 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5973 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5975 C Explicit gradient in virtual-dihedral angles.
5976 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5977 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5978 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5979 vv(1)=pizda(1,1)+pizda(2,2)
5980 vv(2)=pizda(2,1)-pizda(1,2)
5982 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5983 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5984 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5986 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5987 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5988 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5990 C Cartesian gradient
5994 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5996 vv(1)=pizda(1,1)+pizda(2,2)
5997 vv(2)=pizda(2,1)-pizda(1,2)
5998 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5999 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6000 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6009 C Parallel orientation
6010 C Contribution from graph III
6011 call transpose2(EUg(1,1,l),auxmat(1,1))
6012 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6013 vv(1)=pizda(1,1)-pizda(2,2)
6014 vv(2)=pizda(1,2)+pizda(2,1)
6015 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6016 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6018 C Explicit gradient in virtual-dihedral angles.
6019 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6020 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6021 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6022 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6023 vv(1)=pizda(1,1)-pizda(2,2)
6024 vv(2)=pizda(1,2)+pizda(2,1)
6025 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6026 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6027 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6028 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6029 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6030 vv(1)=pizda(1,1)-pizda(2,2)
6031 vv(2)=pizda(1,2)+pizda(2,1)
6032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6033 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6034 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6035 C Cartesian gradient
6039 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6041 vv(1)=pizda(1,1)-pizda(2,2)
6042 vv(2)=pizda(1,2)+pizda(2,1)
6043 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6044 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6045 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6051 C Contribution from graph IV
6053 call transpose2(EE(1,1,itl),auxmat(1,1))
6054 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6055 vv(1)=pizda(1,1)+pizda(2,2)
6056 vv(2)=pizda(2,1)-pizda(1,2)
6057 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6058 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6060 C Explicit gradient in virtual-dihedral angles.
6061 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6062 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6063 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6064 vv(1)=pizda(1,1)+pizda(2,2)
6065 vv(2)=pizda(2,1)-pizda(1,2)
6066 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6067 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6068 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6069 C Cartesian gradient
6073 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6075 vv(1)=pizda(1,1)+pizda(2,2)
6076 vv(2)=pizda(2,1)-pizda(1,2)
6077 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6078 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6079 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6085 C Antiparallel orientation
6086 C Contribution from graph III
6088 call transpose2(EUg(1,1,j),auxmat(1,1))
6089 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6090 vv(1)=pizda(1,1)-pizda(2,2)
6091 vv(2)=pizda(1,2)+pizda(2,1)
6092 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6093 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6095 C Explicit gradient in virtual-dihedral angles.
6096 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6097 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6098 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6099 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6100 vv(1)=pizda(1,1)-pizda(2,2)
6101 vv(2)=pizda(1,2)+pizda(2,1)
6102 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6103 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6104 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6105 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6106 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6107 vv(1)=pizda(1,1)-pizda(2,2)
6108 vv(2)=pizda(1,2)+pizda(2,1)
6109 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6110 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6111 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6112 C Cartesian gradient
6116 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6118 vv(1)=pizda(1,1)-pizda(2,2)
6119 vv(2)=pizda(1,2)+pizda(2,1)
6120 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6121 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6122 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6128 C Contribution from graph IV
6130 call transpose2(EE(1,1,itj),auxmat(1,1))
6131 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6132 vv(1)=pizda(1,1)+pizda(2,2)
6133 vv(2)=pizda(2,1)-pizda(1,2)
6134 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6135 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6137 C Explicit gradient in virtual-dihedral angles.
6138 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6139 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6140 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6141 vv(1)=pizda(1,1)+pizda(2,2)
6142 vv(2)=pizda(2,1)-pizda(1,2)
6143 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6144 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6145 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6146 C Cartesian gradient
6150 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6152 vv(1)=pizda(1,1)+pizda(2,2)
6153 vv(2)=pizda(2,1)-pizda(1,2)
6154 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6155 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6156 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6163 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6164 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6165 cd write (2,*) 'ijkl',i,j,k,l
6166 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6167 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6169 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6170 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6171 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6172 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6174 if (j.lt.nres-1) then
6181 if (l.lt.nres-1) then
6191 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6193 ggg1(ll)=eel5*g_contij(ll,1)
6194 ggg2(ll)=eel5*g_contij(ll,2)
6195 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6196 ghalf=0.5d0*ggg1(ll)
6198 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6199 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6200 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6201 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6202 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6203 ghalf=0.5d0*ggg2(ll)
6205 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6206 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6207 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6208 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6213 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6214 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6219 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6220 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6226 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6231 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6235 cd write (2,*) iii,g_corr5_loc(iii)
6239 cd write (2,*) 'ekont',ekont
6240 cd write (iout,*) 'eello5',ekont*eel5
6243 c--------------------------------------------------------------------------
6244 double precision function eello6(i,j,k,l,jj,kk)
6245 implicit real*8 (a-h,o-z)
6246 include 'DIMENSIONS'
6247 include 'sizesclu.dat'
6248 include 'COMMON.IOUNITS'
6249 include 'COMMON.CHAIN'
6250 include 'COMMON.DERIV'
6251 include 'COMMON.INTERACT'
6252 include 'COMMON.CONTACTS'
6253 include 'COMMON.TORSION'
6254 include 'COMMON.VAR'
6255 include 'COMMON.GEO'
6256 include 'COMMON.FFIELD'
6257 double precision ggg1(3),ggg2(3)
6258 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6263 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6271 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6272 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6276 derx(lll,kkk,iii)=0.0d0
6280 cd eij=facont_hb(jj,i)
6281 cd ekl=facont_hb(kk,k)
6287 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6288 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6289 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6290 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6291 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6292 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6294 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6295 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6296 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6297 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6298 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6299 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6303 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6305 C If turn contributions are considered, they will be handled separately.
6306 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6307 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6308 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6309 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6310 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6311 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6312 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6315 if (j.lt.nres-1) then
6322 if (l.lt.nres-1) then
6330 ggg1(ll)=eel6*g_contij(ll,1)
6331 ggg2(ll)=eel6*g_contij(ll,2)
6332 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6333 ghalf=0.5d0*ggg1(ll)
6335 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6336 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6337 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6338 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6339 ghalf=0.5d0*ggg2(ll)
6340 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6342 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6343 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6344 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6345 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6350 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6351 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6356 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6357 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6363 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6368 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6372 cd write (2,*) iii,g_corr6_loc(iii)
6376 cd write (2,*) 'ekont',ekont
6377 cd write (iout,*) 'eello6',ekont*eel6
6380 c--------------------------------------------------------------------------
6381 double precision function eello6_graph1(i,j,k,l,imat,swap)
6382 implicit real*8 (a-h,o-z)
6383 include 'DIMENSIONS'
6384 include 'sizesclu.dat'
6385 include 'COMMON.IOUNITS'
6386 include 'COMMON.CHAIN'
6387 include 'COMMON.DERIV'
6388 include 'COMMON.INTERACT'
6389 include 'COMMON.CONTACTS'
6390 include 'COMMON.TORSION'
6391 include 'COMMON.VAR'
6392 include 'COMMON.GEO'
6393 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6399 C Parallel Antiparallel C
6405 C \ j|/k\| / \ |/k\|l / C
6410 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6411 itk=itortyp(itype(k))
6412 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6413 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6414 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6415 call transpose2(EUgC(1,1,k),auxmat(1,1))
6416 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6417 vv1(1)=pizda1(1,1)-pizda1(2,2)
6418 vv1(2)=pizda1(1,2)+pizda1(2,1)
6419 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6420 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6421 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6422 s5=scalar2(vv(1),Dtobr2(1,i))
6423 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6424 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6425 if (.not. calc_grad) return
6426 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6427 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6428 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6429 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6430 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6431 & +scalar2(vv(1),Dtobr2der(1,i)))
6432 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6433 vv1(1)=pizda1(1,1)-pizda1(2,2)
6434 vv1(2)=pizda1(1,2)+pizda1(2,1)
6435 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6436 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6438 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6439 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6440 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6441 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6442 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6444 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6445 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6446 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6447 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6448 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6450 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6451 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6452 vv1(1)=pizda1(1,1)-pizda1(2,2)
6453 vv1(2)=pizda1(1,2)+pizda1(2,1)
6454 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6455 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6456 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6457 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6466 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6467 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6468 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6469 call transpose2(EUgC(1,1,k),auxmat(1,1))
6470 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6472 vv1(1)=pizda1(1,1)-pizda1(2,2)
6473 vv1(2)=pizda1(1,2)+pizda1(2,1)
6474 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6475 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6476 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6477 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6478 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6479 s5=scalar2(vv(1),Dtobr2(1,i))
6480 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6486 c----------------------------------------------------------------------------
6487 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6488 implicit real*8 (a-h,o-z)
6489 include 'DIMENSIONS'
6490 include 'sizesclu.dat'
6491 include 'COMMON.IOUNITS'
6492 include 'COMMON.CHAIN'
6493 include 'COMMON.DERIV'
6494 include 'COMMON.INTERACT'
6495 include 'COMMON.CONTACTS'
6496 include 'COMMON.TORSION'
6497 include 'COMMON.VAR'
6498 include 'COMMON.GEO'
6500 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6501 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6504 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6506 C Parallel Antiparallel C
6512 C \ j|/k\| \ |/k\|l C
6517 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6518 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6519 C AL 7/4/01 s1 would occur in the sixth-order moment,
6520 C but not in a cluster cumulant
6522 s1=dip(1,jj,i)*dip(1,kk,k)
6524 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6525 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6526 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6527 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6528 call transpose2(EUg(1,1,k),auxmat(1,1))
6529 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6530 vv(1)=pizda(1,1)-pizda(2,2)
6531 vv(2)=pizda(1,2)+pizda(2,1)
6532 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6533 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6535 eello6_graph2=-(s1+s2+s3+s4)
6537 eello6_graph2=-(s2+s3+s4)
6540 if (.not. calc_grad) return
6541 C Derivatives in gamma(i-1)
6544 s1=dipderg(1,jj,i)*dip(1,kk,k)
6546 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6547 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6548 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6549 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6551 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6553 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6555 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6557 C Derivatives in gamma(k-1)
6559 s1=dip(1,jj,i)*dipderg(1,kk,k)
6561 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6562 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6563 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6564 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6565 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6566 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6567 vv(1)=pizda(1,1)-pizda(2,2)
6568 vv(2)=pizda(1,2)+pizda(2,1)
6569 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6571 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6573 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6575 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6576 C Derivatives in gamma(j-1) or gamma(l-1)
6579 s1=dipderg(3,jj,i)*dip(1,kk,k)
6581 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6582 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6583 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6584 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6585 vv(1)=pizda(1,1)-pizda(2,2)
6586 vv(2)=pizda(1,2)+pizda(2,1)
6587 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6590 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6592 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6595 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6596 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6598 C Derivatives in gamma(l-1) or gamma(j-1)
6601 s1=dip(1,jj,i)*dipderg(3,kk,k)
6603 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6604 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6605 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6606 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6607 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6608 vv(1)=pizda(1,1)-pizda(2,2)
6609 vv(2)=pizda(1,2)+pizda(2,1)
6610 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6613 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6615 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6618 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6619 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6621 C Cartesian derivatives.
6623 write (2,*) 'In eello6_graph2'
6625 write (2,*) 'iii=',iii
6627 write (2,*) 'kkk=',kkk
6629 write (2,'(3(2f10.5),5x)')
6630 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6640 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6642 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6645 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6647 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6648 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6650 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6651 call transpose2(EUg(1,1,k),auxmat(1,1))
6652 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6654 vv(1)=pizda(1,1)-pizda(2,2)
6655 vv(2)=pizda(1,2)+pizda(2,1)
6656 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6657 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6659 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6661 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6664 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6666 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6673 c----------------------------------------------------------------------------
6674 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6675 implicit real*8 (a-h,o-z)
6676 include 'DIMENSIONS'
6677 include 'sizesclu.dat'
6678 include 'COMMON.IOUNITS'
6679 include 'COMMON.CHAIN'
6680 include 'COMMON.DERIV'
6681 include 'COMMON.INTERACT'
6682 include 'COMMON.CONTACTS'
6683 include 'COMMON.TORSION'
6684 include 'COMMON.VAR'
6685 include 'COMMON.GEO'
6686 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6688 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6690 C Parallel Antiparallel C
6696 C j|/k\| / |/k\|l / C
6701 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6703 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6704 C energy moment and not to the cluster cumulant.
6705 iti=itortyp(itype(i))
6706 c if (j.lt.nres-1) then
6707 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6708 itj1=itortyp(itype(j+1))
6712 itk=itortyp(itype(k))
6713 itk1=itortyp(itype(k+1))
6714 c if (l.lt.nres-1) then
6715 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6716 itl1=itortyp(itype(l+1))
6721 s1=dip(4,jj,i)*dip(4,kk,k)
6723 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6724 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6725 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6726 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6727 call transpose2(EE(1,1,itk),auxmat(1,1))
6728 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6729 vv(1)=pizda(1,1)+pizda(2,2)
6730 vv(2)=pizda(2,1)-pizda(1,2)
6731 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6732 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6734 eello6_graph3=-(s1+s2+s3+s4)
6736 eello6_graph3=-(s2+s3+s4)
6739 if (.not. calc_grad) return
6740 C Derivatives in gamma(k-1)
6741 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6742 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6743 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6744 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6745 C Derivatives in gamma(l-1)
6746 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6747 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6748 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6749 vv(1)=pizda(1,1)+pizda(2,2)
6750 vv(2)=pizda(2,1)-pizda(1,2)
6751 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6752 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6753 C Cartesian derivatives.
6759 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6761 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6764 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6766 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6767 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6769 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6770 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6772 vv(1)=pizda(1,1)+pizda(2,2)
6773 vv(2)=pizda(2,1)-pizda(1,2)
6774 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6776 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6778 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6781 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6783 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6785 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6791 c----------------------------------------------------------------------------
6792 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6793 implicit real*8 (a-h,o-z)
6794 include 'DIMENSIONS'
6795 include 'sizesclu.dat'
6796 include 'COMMON.IOUNITS'
6797 include 'COMMON.CHAIN'
6798 include 'COMMON.DERIV'
6799 include 'COMMON.INTERACT'
6800 include 'COMMON.CONTACTS'
6801 include 'COMMON.TORSION'
6802 include 'COMMON.VAR'
6803 include 'COMMON.GEO'
6804 include 'COMMON.FFIELD'
6805 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6806 & auxvec1(2),auxmat1(2,2)
6808 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6810 C Parallel Antiparallel C
6816 C \ j|/k\| \ |/k\|l C
6821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6823 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6824 C energy moment and not to the cluster cumulant.
6825 cd write (2,*) 'eello_graph4: wturn6',wturn6
6826 iti=itortyp(itype(i))
6827 itj=itortyp(itype(j))
6828 c if (j.lt.nres-1) then
6829 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6830 itj1=itortyp(itype(j+1))
6834 itk=itortyp(itype(k))
6835 c if (k.lt.nres-1) then
6836 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6837 itk1=itortyp(itype(k+1))
6841 itl=itortyp(itype(l))
6842 if (l.lt.nres-1) then
6843 itl1=itortyp(itype(l+1))
6847 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6848 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6849 cd & ' itl',itl,' itl1',itl1
6852 s1=dip(3,jj,i)*dip(3,kk,k)
6854 s1=dip(2,jj,j)*dip(2,kk,l)
6857 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6858 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6860 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6861 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6863 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6864 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6866 call transpose2(EUg(1,1,k),auxmat(1,1))
6867 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6868 vv(1)=pizda(1,1)-pizda(2,2)
6869 vv(2)=pizda(2,1)+pizda(1,2)
6870 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6871 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6873 eello6_graph4=-(s1+s2+s3+s4)
6875 eello6_graph4=-(s2+s3+s4)
6877 if (.not. calc_grad) return
6878 C Derivatives in gamma(i-1)
6882 s1=dipderg(2,jj,i)*dip(3,kk,k)
6884 s1=dipderg(4,jj,j)*dip(2,kk,l)
6887 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6889 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6890 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6892 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6893 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6895 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6896 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6897 cd write (2,*) 'turn6 derivatives'
6899 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6901 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6905 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6907 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6911 C Derivatives in gamma(k-1)
6914 s1=dip(3,jj,i)*dipderg(2,kk,k)
6916 s1=dip(2,jj,j)*dipderg(4,kk,l)
6919 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6920 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6922 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6923 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6925 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6926 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6928 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6929 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6930 vv(1)=pizda(1,1)-pizda(2,2)
6931 vv(2)=pizda(2,1)+pizda(1,2)
6932 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6933 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6935 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6937 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6941 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6943 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6946 C Derivatives in gamma(j-1) or gamma(l-1)
6947 if (l.eq.j+1 .and. l.gt.1) then
6948 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6949 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6950 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6951 vv(1)=pizda(1,1)-pizda(2,2)
6952 vv(2)=pizda(2,1)+pizda(1,2)
6953 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6954 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6955 else if (j.gt.1) then
6956 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6957 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6958 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6959 vv(1)=pizda(1,1)-pizda(2,2)
6960 vv(2)=pizda(2,1)+pizda(1,2)
6961 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6962 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6963 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6965 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6968 C Cartesian derivatives.
6975 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6977 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6981 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6983 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6987 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6989 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6991 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6992 & b1(1,itj1),auxvec(1))
6993 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6995 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6996 & b1(1,itl1),auxvec(1))
6997 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6999 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7001 vv(1)=pizda(1,1)-pizda(2,2)
7002 vv(2)=pizda(2,1)+pizda(1,2)
7003 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7005 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7007 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7010 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7013 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7016 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7018 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7020 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7024 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7026 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7029 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7031 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7039 c----------------------------------------------------------------------------
7040 double precision function eello_turn6(i,jj,kk)
7041 implicit real*8 (a-h,o-z)
7042 include 'DIMENSIONS'
7043 include 'sizesclu.dat'
7044 include 'COMMON.IOUNITS'
7045 include 'COMMON.CHAIN'
7046 include 'COMMON.DERIV'
7047 include 'COMMON.INTERACT'
7048 include 'COMMON.CONTACTS'
7049 include 'COMMON.TORSION'
7050 include 'COMMON.VAR'
7051 include 'COMMON.GEO'
7052 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7053 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7055 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7056 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7057 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7058 C the respective energy moment and not to the cluster cumulant.
7063 iti=itortyp(itype(i))
7064 itk=itortyp(itype(k))
7065 itk1=itortyp(itype(k+1))
7066 itl=itortyp(itype(l))
7067 itj=itortyp(itype(j))
7068 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7069 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7070 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7075 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7077 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7081 derx_turn(lll,kkk,iii)=0.0d0
7088 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7090 cd write (2,*) 'eello6_5',eello6_5
7092 call transpose2(AEA(1,1,1),auxmat(1,1))
7093 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7094 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7095 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7099 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7100 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7101 s2 = scalar2(b1(1,itk),vtemp1(1))
7103 call transpose2(AEA(1,1,2),atemp(1,1))
7104 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7105 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7106 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7110 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7111 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7112 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7114 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7115 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7116 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7117 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7118 ss13 = scalar2(b1(1,itk),vtemp4(1))
7119 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7123 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7129 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7131 C Derivatives in gamma(i+2)
7133 call transpose2(AEA(1,1,1),auxmatd(1,1))
7134 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7135 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7136 call transpose2(AEAderg(1,1,2),atempd(1,1))
7137 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7138 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7142 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7143 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7144 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7150 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7151 C Derivatives in gamma(i+3)
7153 call transpose2(AEA(1,1,1),auxmatd(1,1))
7154 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7155 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7156 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7160 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7161 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7162 s2d = scalar2(b1(1,itk),vtemp1d(1))
7164 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7165 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7167 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7169 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7170 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7171 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7181 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7182 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7184 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7185 & -0.5d0*ekont*(s2d+s12d)
7187 C Derivatives in gamma(i+4)
7188 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7189 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7190 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7192 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7193 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7194 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7204 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7206 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7208 C Derivatives in gamma(i+5)
7210 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7211 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7212 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7216 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7217 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7218 s2d = scalar2(b1(1,itk),vtemp1d(1))
7220 call transpose2(AEA(1,1,2),atempd(1,1))
7221 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7222 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7226 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7227 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7229 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7230 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7231 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7241 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7242 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7244 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7245 & -0.5d0*ekont*(s2d+s12d)
7247 C Cartesian derivatives
7252 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7253 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7254 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7258 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7259 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7261 s2d = scalar2(b1(1,itk),vtemp1d(1))
7263 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7264 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7265 s8d = -(atempd(1,1)+atempd(2,2))*
7266 & scalar2(cc(1,1,itl),vtemp2(1))
7270 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7272 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7273 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7280 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7283 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7287 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7288 & - 0.5d0*(s8d+s12d)
7290 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7299 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7301 call matmat2(achuj_tempd(1,1),EUg(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
7304 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7305 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7307 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7308 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7309 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7313 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7314 cd & 16*eel_turn6_num
7316 if (j.lt.nres-1) then
7323 if (l.lt.nres-1) then
7331 ggg1(ll)=eel_turn6*g_contij(ll,1)
7332 ggg2(ll)=eel_turn6*g_contij(ll,2)
7333 ghalf=0.5d0*ggg1(ll)
7335 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7336 & +ekont*derx_turn(ll,2,1)
7337 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7338 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7339 & +ekont*derx_turn(ll,4,1)
7340 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7341 ghalf=0.5d0*ggg2(ll)
7343 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7344 & +ekont*derx_turn(ll,2,2)
7345 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7346 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7347 & +ekont*derx_turn(ll,4,2)
7348 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7353 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7358 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7364 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7369 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7373 cd write (2,*) iii,g_corr6_loc(iii)
7376 eello_turn6=ekont*eel_turn6
7377 cd write (2,*) 'ekont',ekont
7378 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7381 crc-------------------------------------------------
7382 SUBROUTINE MATVEC2(A1,V1,V2)
7383 implicit real*8 (a-h,o-z)
7384 include 'DIMENSIONS'
7385 DIMENSION A1(2,2),V1(2),V2(2)
7389 c 3 VI=VI+A1(I,K)*V1(K)
7393 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7394 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7399 C---------------------------------------
7400 SUBROUTINE MATMAT2(A1,A2,A3)
7401 implicit real*8 (a-h,o-z)
7402 include 'DIMENSIONS'
7403 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7404 c DIMENSION AI3(2,2)
7408 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7414 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7415 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7416 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7417 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7425 c-------------------------------------------------------------------------
7426 double precision function scalar2(u,v)
7428 double precision u(2),v(2)
7431 scalar2=u(1)*v(1)+u(2)*v(2)
7435 C-----------------------------------------------------------------------------
7437 subroutine transpose2(a,at)
7439 double precision a(2,2),at(2,2)
7446 c--------------------------------------------------------------------------
7447 subroutine transpose(n,a,at)
7450 double precision a(n,n),at(n,n)
7458 C---------------------------------------------------------------------------
7459 subroutine prodmat3(a1,a2,kk,transp,prod)
7462 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7464 crc double precision auxmat(2,2),prod_(2,2)
7467 crc call transpose2(kk(1,1),auxmat(1,1))
7468 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7469 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7471 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7472 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7473 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7474 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7475 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7476 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7477 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7478 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7481 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7482 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7484 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7485 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7486 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7487 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7488 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7489 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7490 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7491 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7494 c call transpose2(a2(1,1),a2t(1,1))
7497 crc print *,((prod_(i,j),i=1,2),j=1,2)
7498 crc print *,((prod(i,j),i=1,2),j=1,2)
7502 C-----------------------------------------------------------------------------
7503 double precision function scalar(u,v)
7505 double precision u(3),v(3)