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 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
776 c if (icall.gt.0) lprn=.true.
780 if (itypi.eq.ntyp1) cycle
781 itypi1=iabs(itype(i+1))
785 dxi=dc_norm(1,nres+i)
786 dyi=dc_norm(2,nres+i)
787 dzi=dc_norm(3,nres+i)
788 dsci_inv=vbld_inv(i+nres)
790 C Calculate SC interaction energy.
793 do j=istart(i,iint),iend(i,iint)
794 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
796 c write(iout,*) "PRZED ZWYKLE", evdwij
797 call dyn_ssbond_ene(i,j,evdwij)
798 c write(iout,*) "PO ZWYKLE", evdwij
801 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
802 & 'evdw',i,j,evdwij,' ss'
803 C triple bond artifac removal
804 do k=j+1,iend(i,iint)
805 C search over all next residues
806 if (dyn_ss_mask(k)) then
807 C check if they are cysteins
808 C write(iout,*) 'k=',k
810 c write(iout,*) "PRZED TRI", evdwij
811 evdwij_przed_tri=evdwij
812 call triple_ssbond_ene(i,j,k,evdwij)
813 c if(evdwij_przed_tri.ne.evdwij) then
814 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
817 c write(iout,*) "PO TRI", evdwij
818 C call the energy function that removes the artifical triple disulfide
819 C bond the soubroutine is located in ssMD.F
821 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
822 & 'evdw',i,j,evdwij,'tss'
828 if (itypj.eq.ntyp1) cycle
829 dscj_inv=vbld_inv(j+nres)
830 sig0ij=sigma(itypi,itypj)
831 chi1=chi(itypi,itypj)
832 chi2=chi(itypj,itypi)
839 alf12=0.5D0*(alf1+alf2)
840 C For diagnostics only!!!
853 dxj=dc_norm(1,nres+j)
854 dyj=dc_norm(2,nres+j)
855 dzj=dc_norm(3,nres+j)
856 c write (iout,*) i,j,xj,yj,zj
857 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
859 C Calculate angle-dependent terms of energy and contributions to their
863 sig=sig0ij*dsqrt(sigsq)
864 rij_shift=1.0D0/rij-sig+sig0ij
865 C I hate to put IF's in the loops, but here don't have another choice!!!!
866 if (rij_shift.le.0.0D0) then
871 c---------------------------------------------------------------
872 rij_shift=1.0D0/rij_shift
874 e1=fac*fac*aa(itypi,itypj)
875 e2=fac*bb(itypi,itypj)
876 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
877 eps2der=evdwij*eps3rt
878 eps3der=evdwij*eps2rt
879 evdwij=evdwij*eps2rt*eps3rt
880 if (bb(itypi,itypj).gt.0) then
885 ij=icant(itypi,itypj)
886 aux=eps1*eps2rt**2*eps3rt**2
887 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
888 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
889 c & aux*e2/eps(itypi,itypj)
891 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
892 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
893 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
894 c & restyp(itypi),i,restyp(itypj),j,
895 c & epsi,sigm,chi1,chi2,chip1,chip2,
896 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
897 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
899 c write (iout,*) "pratial sum", evdw,evdw_t
902 C Calculate gradient components.
903 e1=e1*eps1*eps2rt**2*eps3rt**2
904 fac=-expon*(e1+evdwij)*rij_shift
907 C Calculate the radial part of the gradient
911 C Calculate angular part of the gradient.
920 C-----------------------------------------------------------------------------
921 subroutine egbv(evdw,evdw_t)
923 C This subroutine calculates the interaction energy of nonbonded side chains
924 C assuming the Gay-Berne-Vorobjev potential of interaction.
926 implicit real*8 (a-h,o-z)
928 include 'sizesclu.dat'
929 include "DIMENSIONS.COMPAR"
932 include 'COMMON.LOCAL'
933 include 'COMMON.CHAIN'
934 include 'COMMON.DERIV'
935 include 'COMMON.NAMES'
936 include 'COMMON.INTERACT'
937 include 'COMMON.IOUNITS'
938 include 'COMMON.CALC'
945 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
948 c if (icall.gt.0) lprn=.true.
952 if (itypi.eq.ntyp1) cycle
953 itypi1=iabs(itype(i+1))
957 dxi=dc_norm(1,nres+i)
958 dyi=dc_norm(2,nres+i)
959 dzi=dc_norm(3,nres+i)
960 dsci_inv=vbld_inv(i+nres)
962 C Calculate SC interaction energy.
965 do j=istart(i,iint),iend(i,iint)
968 if (itypj.eq.ntyp1) cycle
969 dscj_inv=vbld_inv(j+nres)
970 sig0ij=sigma(itypi,itypj)
972 chi1=chi(itypi,itypj)
973 chi2=chi(itypj,itypi)
980 alf12=0.5D0*(alf1+alf2)
981 C For diagnostics only!!!
994 dxj=dc_norm(1,nres+j)
995 dyj=dc_norm(2,nres+j)
996 dzj=dc_norm(3,nres+j)
997 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
999 C Calculate angle-dependent terms of energy and contributions to their
1003 sig=sig0ij*dsqrt(sigsq)
1004 rij_shift=1.0D0/rij-sig+r0ij
1005 C I hate to put IF's in the loops, but here don't have another choice!!!!
1006 if (rij_shift.le.0.0D0) then
1011 c---------------------------------------------------------------
1012 rij_shift=1.0D0/rij_shift
1013 fac=rij_shift**expon
1014 e1=fac*fac*aa(itypi,itypj)
1015 e2=fac*bb(itypi,itypj)
1016 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1017 eps2der=evdwij*eps3rt
1018 eps3der=evdwij*eps2rt
1019 fac_augm=rrij**expon
1020 e_augm=augm(itypi,itypj)*fac_augm
1021 evdwij=evdwij*eps2rt*eps3rt
1022 if (bb(itypi,itypj).gt.0.0d0) then
1023 evdw=evdw+evdwij+e_augm
1025 evdw_t=evdw_t+evdwij+e_augm
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1030 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1031 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1032 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1033 c & restyp(itypi),i,restyp(itypj),j,
1034 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1035 c & chi1,chi2,chip1,chip2,
1036 c & eps1,eps2rt**2,eps3rt**2,
1037 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1041 C Calculate gradient components.
1042 e1=e1*eps1*eps2rt**2*eps3rt**2
1043 fac=-expon*(e1+evdwij)*rij_shift
1045 fac=rij*fac-2*expon*rrij*e_augm
1046 C Calculate the radial part of the gradient
1050 C Calculate angular part of the gradient.
1058 C-----------------------------------------------------------------------------
1059 subroutine sc_angular
1060 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1061 C om12. Called by ebp, egb, and egbv.
1063 include 'COMMON.CALC'
1067 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1068 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1069 om12=dxi*dxj+dyi*dyj+dzi*dzj
1071 C Calculate eps1(om12) and its derivative in om12
1072 faceps1=1.0D0-om12*chiom12
1073 faceps1_inv=1.0D0/faceps1
1074 eps1=dsqrt(faceps1_inv)
1075 C Following variable is eps1*deps1/dom12
1076 eps1_om12=faceps1_inv*chiom12
1077 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1082 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1083 sigsq=1.0D0-facsig*faceps1_inv
1084 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1085 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1086 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1087 C Calculate eps2 and its derivatives in om1, om2, and om12.
1090 chipom12=chip12*om12
1091 facp=1.0D0-om12*chipom12
1093 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1094 C Following variable is the square root of eps2
1095 eps2rt=1.0D0-facp1*facp_inv
1096 C Following three variables are the derivatives of the square root of eps
1097 C in om1, om2, and om12.
1098 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1099 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1100 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1101 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1102 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1103 C Calculate whole angle-dependent part of epsilon and contributions
1104 C to its derivatives
1107 C----------------------------------------------------------------------------
1109 implicit real*8 (a-h,o-z)
1110 include 'DIMENSIONS'
1111 include 'sizesclu.dat'
1112 include 'COMMON.CHAIN'
1113 include 'COMMON.DERIV'
1114 include 'COMMON.CALC'
1115 double precision dcosom1(3),dcosom2(3)
1116 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1117 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1118 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1119 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1121 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1122 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1125 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1128 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1129 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1130 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1131 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1132 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1133 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1136 C Calculate the components of the gradient in DC and X
1140 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1145 c------------------------------------------------------------------------------
1146 subroutine vec_and_deriv
1147 implicit real*8 (a-h,o-z)
1148 include 'DIMENSIONS'
1149 include 'sizesclu.dat'
1150 include 'COMMON.IOUNITS'
1151 include 'COMMON.GEO'
1152 include 'COMMON.VAR'
1153 include 'COMMON.LOCAL'
1154 include 'COMMON.CHAIN'
1155 include 'COMMON.VECTORS'
1156 include 'COMMON.DERIV'
1157 include 'COMMON.INTERACT'
1158 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1159 C Compute the local reference systems. For reference system (i), the
1160 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1161 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1163 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1164 if (i.eq.nres-1) then
1165 C Case of the last full residue
1166 C Compute the Z-axis
1167 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1168 costh=dcos(pi-theta(nres))
1169 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1174 C Compute the derivatives of uz
1176 uzder(2,1,1)=-dc_norm(3,i-1)
1177 uzder(3,1,1)= dc_norm(2,i-1)
1178 uzder(1,2,1)= dc_norm(3,i-1)
1180 uzder(3,2,1)=-dc_norm(1,i-1)
1181 uzder(1,3,1)=-dc_norm(2,i-1)
1182 uzder(2,3,1)= dc_norm(1,i-1)
1185 uzder(2,1,2)= dc_norm(3,i)
1186 uzder(3,1,2)=-dc_norm(2,i)
1187 uzder(1,2,2)=-dc_norm(3,i)
1189 uzder(3,2,2)= dc_norm(1,i)
1190 uzder(1,3,2)= dc_norm(2,i)
1191 uzder(2,3,2)=-dc_norm(1,i)
1194 C Compute the Y-axis
1197 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1200 C Compute the derivatives of uy
1203 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1204 & -dc_norm(k,i)*dc_norm(j,i-1)
1205 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1207 uyder(j,j,1)=uyder(j,j,1)-costh
1208 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1213 uygrad(l,k,j,i)=uyder(l,k,j)
1214 uzgrad(l,k,j,i)=uzder(l,k,j)
1218 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1219 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1220 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1221 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1225 C Compute the Z-axis
1226 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1227 costh=dcos(pi-theta(i+2))
1228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1233 C Compute the derivatives of uz
1235 uzder(2,1,1)=-dc_norm(3,i+1)
1236 uzder(3,1,1)= dc_norm(2,i+1)
1237 uzder(1,2,1)= dc_norm(3,i+1)
1239 uzder(3,2,1)=-dc_norm(1,i+1)
1240 uzder(1,3,1)=-dc_norm(2,i+1)
1241 uzder(2,3,1)= dc_norm(1,i+1)
1244 uzder(2,1,2)= dc_norm(3,i)
1245 uzder(3,1,2)=-dc_norm(2,i)
1246 uzder(1,2,2)=-dc_norm(3,i)
1248 uzder(3,2,2)= dc_norm(1,i)
1249 uzder(1,3,2)= dc_norm(2,i)
1250 uzder(2,3,2)=-dc_norm(1,i)
1253 C Compute the Y-axis
1256 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1259 C Compute the derivatives of uy
1262 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1263 & -dc_norm(k,i)*dc_norm(j,i+1)
1264 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1266 uyder(j,j,1)=uyder(j,j,1)-costh
1267 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1272 uygrad(l,k,j,i)=uyder(l,k,j)
1273 uzgrad(l,k,j,i)=uzder(l,k,j)
1277 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1278 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1279 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1280 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1286 vbld_inv_temp(1)=vbld_inv(i+1)
1287 if (i.lt.nres-1) then
1288 vbld_inv_temp(2)=vbld_inv(i+2)
1290 vbld_inv_temp(2)=vbld_inv(i)
1295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1304 C-----------------------------------------------------------------------------
1305 subroutine vec_and_deriv_test
1306 implicit real*8 (a-h,o-z)
1307 include 'DIMENSIONS'
1308 include 'sizesclu.dat'
1309 include 'COMMON.IOUNITS'
1310 include 'COMMON.GEO'
1311 include 'COMMON.VAR'
1312 include 'COMMON.LOCAL'
1313 include 'COMMON.CHAIN'
1314 include 'COMMON.VECTORS'
1315 dimension uyder(3,3,2),uzder(3,3,2)
1316 C Compute the local reference systems. For reference system (i), the
1317 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1318 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1320 if (i.eq.nres-1) then
1321 C Case of the last full residue
1322 C Compute the Z-axis
1323 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1324 costh=dcos(pi-theta(nres))
1325 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1326 c write (iout,*) 'fac',fac,
1327 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1328 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1332 C Compute the derivatives of uz
1334 uzder(2,1,1)=-dc_norm(3,i-1)
1335 uzder(3,1,1)= dc_norm(2,i-1)
1336 uzder(1,2,1)= dc_norm(3,i-1)
1338 uzder(3,2,1)=-dc_norm(1,i-1)
1339 uzder(1,3,1)=-dc_norm(2,i-1)
1340 uzder(2,3,1)= dc_norm(1,i-1)
1343 uzder(2,1,2)= dc_norm(3,i)
1344 uzder(3,1,2)=-dc_norm(2,i)
1345 uzder(1,2,2)=-dc_norm(3,i)
1347 uzder(3,2,2)= dc_norm(1,i)
1348 uzder(1,3,2)= dc_norm(2,i)
1349 uzder(2,3,2)=-dc_norm(1,i)
1351 C Compute the Y-axis
1353 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1356 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1357 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1358 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1360 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1363 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1364 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1367 c write (iout,*) 'facy',facy,
1368 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1369 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1371 uy(k,i)=facy*uy(k,i)
1373 C Compute the derivatives of uy
1376 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1377 & -dc_norm(k,i)*dc_norm(j,i-1)
1378 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1380 c uyder(j,j,1)=uyder(j,j,1)-costh
1381 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1382 uyder(j,j,1)=uyder(j,j,1)
1383 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1384 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1390 uygrad(l,k,j,i)=uyder(l,k,j)
1391 uzgrad(l,k,j,i)=uzder(l,k,j)
1395 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1396 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1397 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1398 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1401 C Compute the Z-axis
1402 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1403 costh=dcos(pi-theta(i+2))
1404 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1405 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1409 C Compute the derivatives of uz
1411 uzder(2,1,1)=-dc_norm(3,i+1)
1412 uzder(3,1,1)= dc_norm(2,i+1)
1413 uzder(1,2,1)= dc_norm(3,i+1)
1415 uzder(3,2,1)=-dc_norm(1,i+1)
1416 uzder(1,3,1)=-dc_norm(2,i+1)
1417 uzder(2,3,1)= dc_norm(1,i+1)
1420 uzder(2,1,2)= dc_norm(3,i)
1421 uzder(3,1,2)=-dc_norm(2,i)
1422 uzder(1,2,2)=-dc_norm(3,i)
1424 uzder(3,2,2)= dc_norm(1,i)
1425 uzder(1,3,2)= dc_norm(2,i)
1426 uzder(2,3,2)=-dc_norm(1,i)
1428 C Compute the Y-axis
1430 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1431 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1432 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1434 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1437 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1438 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1441 c write (iout,*) 'facy',facy,
1442 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1443 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1445 uy(k,i)=facy*uy(k,i)
1447 C Compute the derivatives of uy
1450 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1451 & -dc_norm(k,i)*dc_norm(j,i+1)
1452 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1454 c uyder(j,j,1)=uyder(j,j,1)-costh
1455 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1456 uyder(j,j,1)=uyder(j,j,1)
1457 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1458 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1464 uygrad(l,k,j,i)=uyder(l,k,j)
1465 uzgrad(l,k,j,i)=uzder(l,k,j)
1469 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1470 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1471 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1472 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1479 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1480 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1487 C-----------------------------------------------------------------------------
1488 subroutine check_vecgrad
1489 implicit real*8 (a-h,o-z)
1490 include 'DIMENSIONS'
1491 include 'sizesclu.dat'
1492 include 'COMMON.IOUNITS'
1493 include 'COMMON.GEO'
1494 include 'COMMON.VAR'
1495 include 'COMMON.LOCAL'
1496 include 'COMMON.CHAIN'
1497 include 'COMMON.VECTORS'
1498 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1499 dimension uyt(3,maxres),uzt(3,maxres)
1500 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1501 double precision delta /1.0d-7/
1504 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1505 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1506 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1507 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1508 cd & (dc_norm(if90,i),if90=1,3)
1509 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1510 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1511 cd write(iout,'(a)')
1517 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1518 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1531 cd write (iout,*) 'i=',i
1533 erij(k)=dc_norm(k,i)
1537 dc_norm(k,i)=erij(k)
1539 dc_norm(j,i)=dc_norm(j,i)+delta
1540 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1542 c dc_norm(k,i)=dc_norm(k,i)/fac
1544 c write (iout,*) (dc_norm(k,i),k=1,3)
1545 c write (iout,*) (erij(k),k=1,3)
1548 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1549 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1550 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1551 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1553 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1554 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1555 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1558 dc_norm(k,i)=erij(k)
1561 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1562 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1563 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1564 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1565 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1566 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1567 cd write (iout,'(a)')
1572 C--------------------------------------------------------------------------
1573 subroutine set_matrices
1574 implicit real*8 (a-h,o-z)
1575 include 'DIMENSIONS'
1576 include 'sizesclu.dat'
1577 include 'COMMON.IOUNITS'
1578 include 'COMMON.GEO'
1579 include 'COMMON.VAR'
1580 include 'COMMON.LOCAL'
1581 include 'COMMON.CHAIN'
1582 include 'COMMON.DERIV'
1583 include 'COMMON.INTERACT'
1584 include 'COMMON.CONTACTS'
1585 include 'COMMON.TORSION'
1586 include 'COMMON.VECTORS'
1587 include 'COMMON.FFIELD'
1588 double precision auxvec(2),auxmat(2,2)
1590 C Compute the virtual-bond-torsional-angle dependent quantities needed
1591 C to calculate the el-loc multibody terms of various order.
1594 if (i .lt. nres+1) then
1631 if (i .gt. 3 .and. i .lt. nres+1) then
1632 obrot_der(1,i-2)=-sin1
1633 obrot_der(2,i-2)= cos1
1634 Ugder(1,1,i-2)= sin1
1635 Ugder(1,2,i-2)=-cos1
1636 Ugder(2,1,i-2)=-cos1
1637 Ugder(2,2,i-2)=-sin1
1640 obrot2_der(1,i-2)=-dwasin2
1641 obrot2_der(2,i-2)= dwacos2
1642 Ug2der(1,1,i-2)= dwasin2
1643 Ug2der(1,2,i-2)=-dwacos2
1644 Ug2der(2,1,i-2)=-dwacos2
1645 Ug2der(2,2,i-2)=-dwasin2
1647 obrot_der(1,i-2)=0.0d0
1648 obrot_der(2,i-2)=0.0d0
1649 Ugder(1,1,i-2)=0.0d0
1650 Ugder(1,2,i-2)=0.0d0
1651 Ugder(2,1,i-2)=0.0d0
1652 Ugder(2,2,i-2)=0.0d0
1653 obrot2_der(1,i-2)=0.0d0
1654 obrot2_der(2,i-2)=0.0d0
1655 Ug2der(1,1,i-2)=0.0d0
1656 Ug2der(1,2,i-2)=0.0d0
1657 Ug2der(2,1,i-2)=0.0d0
1658 Ug2der(2,2,i-2)=0.0d0
1660 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1661 if (itype(i-2).le.ntyp) then
1662 iti = itortyp(itype(i-2))
1669 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1670 if (itype(i-1).le.ntyp) then
1671 iti1 = itortyp(itype(i-1))
1678 cd write (iout,*) '*******i',i,' iti1',iti
1679 cd write (iout,*) 'b1',b1(:,iti)
1680 cd write (iout,*) 'b2',b2(:,iti)
1681 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1682 c print *,"itilde1 i iti iti1",i,iti,iti1
1683 if (i .gt. iatel_s+2) then
1684 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1685 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1686 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1687 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1688 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1689 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1690 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1700 DtUg2(l,k,i-2)=0.0d0
1704 c print *,"itilde2 i iti iti1",i,iti,iti1
1705 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1706 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1707 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1708 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1709 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1710 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1711 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1712 c print *,"itilde3 i iti iti1",i,iti,iti1
1714 muder(k,i-2)=Ub2der(k,i-2)
1716 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1717 if (itype(i-1).le.ntyp) then
1718 iti1 = itortyp(itype(i-1))
1726 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1728 C Vectors and matrices dependent on a single virtual-bond dihedral.
1729 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1730 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1731 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1732 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1733 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1734 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1735 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1736 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1737 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1738 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1739 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1741 C Matrices dependent on two consecutive virtual-bond dihedrals.
1742 C The order of matrices is from left to right.
1744 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1745 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1746 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1747 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1748 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1749 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1750 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1751 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1754 cd iti = itortyp(itype(i))
1757 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1758 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1763 C--------------------------------------------------------------------------
1764 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1766 C This subroutine calculates the average interaction energy and its gradient
1767 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1768 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1769 C The potential depends both on the distance of peptide-group centers and on
1770 C the orientation of the CA-CA virtual bonds.
1772 implicit real*8 (a-h,o-z)
1773 include 'DIMENSIONS'
1774 include 'sizesclu.dat'
1775 include 'COMMON.CONTROL'
1776 include 'COMMON.IOUNITS'
1777 include 'COMMON.GEO'
1778 include 'COMMON.VAR'
1779 include 'COMMON.LOCAL'
1780 include 'COMMON.CHAIN'
1781 include 'COMMON.DERIV'
1782 include 'COMMON.INTERACT'
1783 include 'COMMON.CONTACTS'
1784 include 'COMMON.TORSION'
1785 include 'COMMON.VECTORS'
1786 include 'COMMON.FFIELD'
1787 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1788 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1789 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1790 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1791 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1792 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1793 double precision scal_el /0.5d0/
1795 C 13-go grudnia roku pamietnego...
1796 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1797 & 0.0d0,1.0d0,0.0d0,
1798 & 0.0d0,0.0d0,1.0d0/
1799 cd write(iout,*) 'In EELEC'
1801 cd write(iout,*) 'Type',i
1802 cd write(iout,*) 'B1',B1(:,i)
1803 cd write(iout,*) 'B2',B2(:,i)
1804 cd write(iout,*) 'CC',CC(:,:,i)
1805 cd write(iout,*) 'DD',DD(:,:,i)
1806 cd write(iout,*) 'EE',EE(:,:,i)
1808 cd call check_vecgrad
1810 if (icheckgrad.eq.1) then
1812 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1814 dc_norm(k,i)=dc(k,i)*fac
1816 c write (iout,*) 'i',i,' fac',fac
1819 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1820 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1821 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1822 cd if (wel_loc.gt.0.0d0) then
1823 if (icheckgrad.eq.1) then
1824 call vec_and_deriv_test
1831 cd write (iout,*) 'i=',i
1833 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1836 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1837 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1850 cd print '(a)','Enter EELEC'
1851 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1853 gel_loc_loc(i)=0.0d0
1856 do i=iatel_s,iatel_e
1857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1858 if (itel(i).eq.0) goto 1215
1862 dx_normi=dc_norm(1,i)
1863 dy_normi=dc_norm(2,i)
1864 dz_normi=dc_norm(3,i)
1865 xmedi=c(1,i)+0.5d0*dxi
1866 ymedi=c(2,i)+0.5d0*dyi
1867 zmedi=c(3,i)+0.5d0*dzi
1869 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1870 do j=ielstart(i),ielend(i)
1871 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1872 if (itel(j).eq.0) goto 1216
1876 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1877 aaa=app(iteli,itelj)
1878 bbb=bpp(iteli,itelj)
1879 C Diagnostics only!!!
1885 ael6i=ael6(iteli,itelj)
1886 ael3i=ael3(iteli,itelj)
1890 dx_normj=dc_norm(1,j)
1891 dy_normj=dc_norm(2,j)
1892 dz_normj=dc_norm(3,j)
1893 xj=c(1,j)+0.5D0*dxj-xmedi
1894 yj=c(2,j)+0.5D0*dyj-ymedi
1895 zj=c(3,j)+0.5D0*dzj-zmedi
1896 rij=xj*xj+yj*yj+zj*zj
1902 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1903 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1904 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1905 fac=cosa-3.0D0*cosb*cosg
1907 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1908 if (j.eq.i+2) ev1=scal_el*ev1
1913 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1916 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1917 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1918 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1921 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1922 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1923 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1924 cd & xmedi,ymedi,zmedi,xj,yj,zj
1926 C Calculate contributions to the Cartesian gradient.
1929 facvdw=-6*rrmij*(ev1+evdwij)
1930 facel=-3*rrmij*(el1+eesij)
1937 * Radial derivatives. First process both termini of the fragment (i,j)
1944 gelc(k,i)=gelc(k,i)+ghalf
1945 gelc(k,j)=gelc(k,j)+ghalf
1948 * Loop over residues i+1 thru j-1.
1952 gelc(l,k)=gelc(l,k)+ggg(l)
1960 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1961 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1964 * Loop over residues i+1 thru j-1.
1968 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1975 fac=-3*rrmij*(facvdw+facvdw+facel)
1981 * Radial derivatives. First process both termini of the fragment (i,j)
1988 gelc(k,i)=gelc(k,i)+ghalf
1989 gelc(k,j)=gelc(k,j)+ghalf
1992 * Loop over residues i+1 thru j-1.
1996 gelc(l,k)=gelc(l,k)+ggg(l)
2003 ecosa=2.0D0*fac3*fac1+fac4
2006 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2007 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2009 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2010 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2012 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2013 cd & (dcosg(k),k=1,3)
2015 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2019 gelc(k,i)=gelc(k,i)+ghalf
2020 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2021 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2022 gelc(k,j)=gelc(k,j)+ghalf
2023 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2024 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2028 gelc(l,k)=gelc(l,k)+ggg(l)
2033 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2034 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2035 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2037 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2038 C energy of a peptide unit is assumed in the form of a second-order
2039 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2040 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2041 C are computed for EVERY pair of non-contiguous peptide groups.
2043 if (j.lt.nres-1) then
2054 muij(kkk)=mu(k,i)*mu(l,j)
2057 cd write (iout,*) 'EELEC: i',i,' j',j
2058 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2059 cd write(iout,*) 'muij',muij
2060 ury=scalar(uy(1,i),erij)
2061 urz=scalar(uz(1,i),erij)
2062 vry=scalar(uy(1,j),erij)
2063 vrz=scalar(uz(1,j),erij)
2064 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2065 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2066 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2067 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2068 C For diagnostics only
2073 fac=dsqrt(-ael6i)*r3ij
2074 cd write (2,*) 'fac=',fac
2075 C For diagnostics only
2081 cd write (iout,'(4i5,4f10.5)')
2082 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2083 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2084 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2085 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2086 cd write (iout,'(4f10.5)')
2087 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2088 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2089 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2090 cd write (iout,'(2i3,9f10.5/)') i,j,
2091 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2093 C Derivatives of the elements of A in virtual-bond vectors
2094 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2101 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2102 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2103 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2104 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2105 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2106 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2107 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2108 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2109 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2110 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2111 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2112 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2122 C Compute radial contributions to the gradient
2144 C Add the contributions coming from er
2147 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2148 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2149 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2150 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2153 C Derivatives in DC(i)
2154 ghalf1=0.5d0*agg(k,1)
2155 ghalf2=0.5d0*agg(k,2)
2156 ghalf3=0.5d0*agg(k,3)
2157 ghalf4=0.5d0*agg(k,4)
2158 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2159 & -3.0d0*uryg(k,2)*vry)+ghalf1
2160 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2161 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2162 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2163 & -3.0d0*urzg(k,2)*vry)+ghalf3
2164 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2165 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2166 C Derivatives in DC(i+1)
2167 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2168 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2169 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2170 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2171 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2172 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2173 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2174 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2175 C Derivatives in DC(j)
2176 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2177 & -3.0d0*vryg(k,2)*ury)+ghalf1
2178 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2179 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2180 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2181 & -3.0d0*vryg(k,2)*urz)+ghalf3
2182 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2183 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2184 C Derivatives in DC(j+1) or DC(nres-1)
2185 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2186 & -3.0d0*vryg(k,3)*ury)
2187 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2188 & -3.0d0*vrzg(k,3)*ury)
2189 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2190 & -3.0d0*vryg(k,3)*urz)
2191 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2192 & -3.0d0*vrzg(k,3)*urz)
2197 C Derivatives in DC(i+1)
2198 cd aggi1(k,1)=agg(k,1)
2199 cd aggi1(k,2)=agg(k,2)
2200 cd aggi1(k,3)=agg(k,3)
2201 cd aggi1(k,4)=agg(k,4)
2202 C Derivatives in DC(j)
2207 C Derivatives in DC(j+1)
2212 if (j.eq.nres-1 .and. i.lt.j-2) then
2214 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2215 cd aggj1(k,l)=agg(k,l)
2221 C Check the loc-el terms by numerical integration
2231 aggi(k,l)=-aggi(k,l)
2232 aggi1(k,l)=-aggi1(k,l)
2233 aggj(k,l)=-aggj(k,l)
2234 aggj1(k,l)=-aggj1(k,l)
2237 if (j.lt.nres-1) then
2243 aggi(k,l)=-aggi(k,l)
2244 aggi1(k,l)=-aggi1(k,l)
2245 aggj(k,l)=-aggj(k,l)
2246 aggj1(k,l)=-aggj1(k,l)
2257 aggi(k,l)=-aggi(k,l)
2258 aggi1(k,l)=-aggi1(k,l)
2259 aggj(k,l)=-aggj(k,l)
2260 aggj1(k,l)=-aggj1(k,l)
2266 IF (wel_loc.gt.0.0d0) THEN
2267 C Contribution to the local-electrostatic energy coming from the i-j pair
2268 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2270 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2271 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2272 eel_loc=eel_loc+eel_loc_ij
2273 C Partial derivatives in virtual-bond dihedral angles gamma
2276 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2277 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2278 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2279 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2280 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2281 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2282 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2283 cd write(iout,*) 'agg ',agg
2284 cd write(iout,*) 'aggi ',aggi
2285 cd write(iout,*) 'aggi1',aggi1
2286 cd write(iout,*) 'aggj ',aggj
2287 cd write(iout,*) 'aggj1',aggj1
2289 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2291 ggg(l)=agg(l,1)*muij(1)+
2292 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2296 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2299 C Remaining derivatives of eello
2301 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2302 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2303 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2304 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2305 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2306 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2307 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2308 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2312 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2313 C Contributions from turns
2318 call eturn34(i,j,eello_turn3,eello_turn4)
2320 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2321 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2323 C Calculate the contact function. The ith column of the array JCONT will
2324 C contain the numbers of atoms that make contacts with the atom I (of numbers
2325 C greater than I). The arrays FACONT and GACONT will contain the values of
2326 C the contact function and its derivative.
2327 c r0ij=1.02D0*rpp(iteli,itelj)
2328 c r0ij=1.11D0*rpp(iteli,itelj)
2329 r0ij=2.20D0*rpp(iteli,itelj)
2330 c r0ij=1.55D0*rpp(iteli,itelj)
2331 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2332 if (fcont.gt.0.0D0) then
2333 num_conti=num_conti+1
2334 if (num_conti.gt.maxconts) then
2335 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2336 & ' will skip next contacts for this conf.'
2338 jcont_hb(num_conti,i)=j
2339 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2340 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2341 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2343 d_cont(num_conti,i)=rij
2344 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2345 C --- Electrostatic-interaction matrix ---
2346 a_chuj(1,1,num_conti,i)=a22
2347 a_chuj(1,2,num_conti,i)=a23
2348 a_chuj(2,1,num_conti,i)=a32
2349 a_chuj(2,2,num_conti,i)=a33
2350 C --- Gradient of rij
2352 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2355 c a_chuj(1,1,num_conti,i)=-0.61d0
2356 c a_chuj(1,2,num_conti,i)= 0.4d0
2357 c a_chuj(2,1,num_conti,i)= 0.65d0
2358 c a_chuj(2,2,num_conti,i)= 0.50d0
2359 c else if (i.eq.2) then
2360 c a_chuj(1,1,num_conti,i)= 0.0d0
2361 c a_chuj(1,2,num_conti,i)= 0.0d0
2362 c a_chuj(2,1,num_conti,i)= 0.0d0
2363 c a_chuj(2,2,num_conti,i)= 0.0d0
2365 C --- and its gradients
2366 cd write (iout,*) 'i',i,' j',j
2368 cd write (iout,*) 'iii 1 kkk',kkk
2369 cd write (iout,*) agg(kkk,:)
2372 cd write (iout,*) 'iii 2 kkk',kkk
2373 cd write (iout,*) aggi(kkk,:)
2376 cd write (iout,*) 'iii 3 kkk',kkk
2377 cd write (iout,*) aggi1(kkk,:)
2380 cd write (iout,*) 'iii 4 kkk',kkk
2381 cd write (iout,*) aggj(kkk,:)
2384 cd write (iout,*) 'iii 5 kkk',kkk
2385 cd write (iout,*) aggj1(kkk,:)
2392 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2393 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2394 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2395 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2396 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2398 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2404 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2405 C Calculate contact energies
2407 wij=cosa-3.0D0*cosb*cosg
2410 c fac3=dsqrt(-ael6i)/r0ij**3
2411 fac3=dsqrt(-ael6i)*r3ij
2412 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2413 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2415 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2416 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2417 C Diagnostics. Comment out or remove after debugging!
2418 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2419 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2420 c ees0m(num_conti,i)=0.0D0
2422 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2423 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2424 facont_hb(num_conti,i)=fcont
2426 C Angular derivatives of the contact function
2427 ees0pij1=fac3/ees0pij
2428 ees0mij1=fac3/ees0mij
2429 fac3p=-3.0D0*fac3*rrmij
2430 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2431 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2433 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2434 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2435 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2436 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2437 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2438 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2439 ecosap=ecosa1+ecosa2
2440 ecosbp=ecosb1+ecosb2
2441 ecosgp=ecosg1+ecosg2
2442 ecosam=ecosa1-ecosa2
2443 ecosbm=ecosb1-ecosb2
2444 ecosgm=ecosg1-ecosg2
2453 fprimcont=fprimcont/rij
2454 cd facont_hb(num_conti,i)=1.0D0
2455 C Following line is for diagnostics.
2458 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2459 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2462 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2463 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2465 gggp(1)=gggp(1)+ees0pijp*xj
2466 gggp(2)=gggp(2)+ees0pijp*yj
2467 gggp(3)=gggp(3)+ees0pijp*zj
2468 gggm(1)=gggm(1)+ees0mijp*xj
2469 gggm(2)=gggm(2)+ees0mijp*yj
2470 gggm(3)=gggm(3)+ees0mijp*zj
2471 C Derivatives due to the contact function
2472 gacont_hbr(1,num_conti,i)=fprimcont*xj
2473 gacont_hbr(2,num_conti,i)=fprimcont*yj
2474 gacont_hbr(3,num_conti,i)=fprimcont*zj
2476 ghalfp=0.5D0*gggp(k)
2477 ghalfm=0.5D0*gggm(k)
2478 gacontp_hb1(k,num_conti,i)=ghalfp
2479 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2480 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2481 gacontp_hb2(k,num_conti,i)=ghalfp
2482 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2483 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2484 gacontp_hb3(k,num_conti,i)=gggp(k)
2485 gacontm_hb1(k,num_conti,i)=ghalfm
2486 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2487 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2488 gacontm_hb2(k,num_conti,i)=ghalfm
2489 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2490 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2491 gacontm_hb3(k,num_conti,i)=gggm(k)
2494 C Diagnostics. Comment out or remove after debugging!
2496 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2497 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2498 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2499 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2500 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2501 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2504 endif ! num_conti.le.maxconts
2509 num_cont_hb(i)=num_conti
2513 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2514 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2516 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2517 ccc eel_loc=eel_loc+eello_turn3
2520 C-----------------------------------------------------------------------------
2521 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2522 C Third- and fourth-order contributions from turns
2523 implicit real*8 (a-h,o-z)
2524 include 'DIMENSIONS'
2525 include 'sizesclu.dat'
2526 include 'COMMON.IOUNITS'
2527 include 'COMMON.GEO'
2528 include 'COMMON.VAR'
2529 include 'COMMON.LOCAL'
2530 include 'COMMON.CHAIN'
2531 include 'COMMON.DERIV'
2532 include 'COMMON.INTERACT'
2533 include 'COMMON.CONTACTS'
2534 include 'COMMON.TORSION'
2535 include 'COMMON.VECTORS'
2536 include 'COMMON.FFIELD'
2538 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2539 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2540 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2541 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2542 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2543 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2545 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2547 C Third-order contributions
2554 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2555 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2556 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2557 call transpose2(auxmat(1,1),auxmat1(1,1))
2558 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2559 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2560 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2561 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2562 cd & ' eello_turn3_num',4*eello_turn3_num
2564 C Derivatives in gamma(i)
2565 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2566 call transpose2(auxmat2(1,1),pizda(1,1))
2567 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2568 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2569 C Derivatives in gamma(i+1)
2570 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2571 call transpose2(auxmat2(1,1),pizda(1,1))
2572 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2573 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2574 & +0.5d0*(pizda(1,1)+pizda(2,2))
2575 C Cartesian derivatives
2577 a_temp(1,1)=aggi(l,1)
2578 a_temp(1,2)=aggi(l,2)
2579 a_temp(2,1)=aggi(l,3)
2580 a_temp(2,2)=aggi(l,4)
2581 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2582 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2583 & +0.5d0*(pizda(1,1)+pizda(2,2))
2584 a_temp(1,1)=aggi1(l,1)
2585 a_temp(1,2)=aggi1(l,2)
2586 a_temp(2,1)=aggi1(l,3)
2587 a_temp(2,2)=aggi1(l,4)
2588 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2589 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2590 & +0.5d0*(pizda(1,1)+pizda(2,2))
2591 a_temp(1,1)=aggj(l,1)
2592 a_temp(1,2)=aggj(l,2)
2593 a_temp(2,1)=aggj(l,3)
2594 a_temp(2,2)=aggj(l,4)
2595 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2596 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2597 & +0.5d0*(pizda(1,1)+pizda(2,2))
2598 a_temp(1,1)=aggj1(l,1)
2599 a_temp(1,2)=aggj1(l,2)
2600 a_temp(2,1)=aggj1(l,3)
2601 a_temp(2,2)=aggj1(l,4)
2602 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2603 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2604 & +0.5d0*(pizda(1,1)+pizda(2,2))
2607 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2608 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2610 C Fourth-order contributions
2618 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2619 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2620 iti1=itortyp(itype(i+1))
2621 iti2=itortyp(itype(i+2))
2622 iti3=itortyp(itype(i+3))
2623 call transpose2(EUg(1,1,i+1),e1t(1,1))
2624 call transpose2(Eug(1,1,i+2),e2t(1,1))
2625 call transpose2(Eug(1,1,i+3),e3t(1,1))
2626 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2627 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2628 s1=scalar2(b1(1,iti2),auxvec(1))
2629 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2630 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2631 s2=scalar2(b1(1,iti1),auxvec(1))
2632 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2633 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2635 eello_turn4=eello_turn4-(s1+s2+s3)
2636 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2637 cd & ' eello_turn4_num',8*eello_turn4_num
2638 C Derivatives in gamma(i)
2640 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2641 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2642 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2643 s1=scalar2(b1(1,iti2),auxvec(1))
2644 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2645 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2646 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2647 C Derivatives in gamma(i+1)
2648 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2649 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2650 s2=scalar2(b1(1,iti1),auxvec(1))
2651 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2652 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2653 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2654 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2655 C Derivatives in gamma(i+2)
2656 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2657 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2658 s1=scalar2(b1(1,iti2),auxvec(1))
2659 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2660 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2661 s2=scalar2(b1(1,iti1),auxvec(1))
2662 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2663 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2664 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2665 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2666 C Cartesian derivatives
2667 C Derivatives of this turn contributions in DC(i+2)
2668 if (j.lt.nres-1) then
2670 a_temp(1,1)=agg(l,1)
2671 a_temp(1,2)=agg(l,2)
2672 a_temp(2,1)=agg(l,3)
2673 a_temp(2,2)=agg(l,4)
2674 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2675 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2676 s1=scalar2(b1(1,iti2),auxvec(1))
2677 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2678 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2679 s2=scalar2(b1(1,iti1),auxvec(1))
2680 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2681 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2684 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2687 C Remaining derivatives of this turn contribution
2689 a_temp(1,1)=aggi(l,1)
2690 a_temp(1,2)=aggi(l,2)
2691 a_temp(2,1)=aggi(l,3)
2692 a_temp(2,2)=aggi(l,4)
2693 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2694 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2695 s1=scalar2(b1(1,iti2),auxvec(1))
2696 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2697 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2698 s2=scalar2(b1(1,iti1),auxvec(1))
2699 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2700 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2702 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2703 a_temp(1,1)=aggi1(l,1)
2704 a_temp(1,2)=aggi1(l,2)
2705 a_temp(2,1)=aggi1(l,3)
2706 a_temp(2,2)=aggi1(l,4)
2707 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2708 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2709 s1=scalar2(b1(1,iti2),auxvec(1))
2710 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2711 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2712 s2=scalar2(b1(1,iti1),auxvec(1))
2713 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2714 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2715 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2716 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2717 a_temp(1,1)=aggj(l,1)
2718 a_temp(1,2)=aggj(l,2)
2719 a_temp(2,1)=aggj(l,3)
2720 a_temp(2,2)=aggj(l,4)
2721 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2722 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2723 s1=scalar2(b1(1,iti2),auxvec(1))
2724 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2725 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2726 s2=scalar2(b1(1,iti1),auxvec(1))
2727 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2728 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2729 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2730 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2731 a_temp(1,1)=aggj1(l,1)
2732 a_temp(1,2)=aggj1(l,2)
2733 a_temp(2,1)=aggj1(l,3)
2734 a_temp(2,2)=aggj1(l,4)
2735 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2736 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2737 s1=scalar2(b1(1,iti2),auxvec(1))
2738 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2739 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2740 s2=scalar2(b1(1,iti1),auxvec(1))
2741 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2742 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2743 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2744 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2750 C-----------------------------------------------------------------------------
2751 subroutine vecpr(u,v,w)
2752 implicit real*8(a-h,o-z)
2753 dimension u(3),v(3),w(3)
2754 w(1)=u(2)*v(3)-u(3)*v(2)
2755 w(2)=-u(1)*v(3)+u(3)*v(1)
2756 w(3)=u(1)*v(2)-u(2)*v(1)
2759 C-----------------------------------------------------------------------------
2760 subroutine unormderiv(u,ugrad,unorm,ungrad)
2761 C This subroutine computes the derivatives of a normalized vector u, given
2762 C the derivatives computed without normalization conditions, ugrad. Returns
2765 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2766 double precision vec(3)
2767 double precision scalar
2769 c write (2,*) 'ugrad',ugrad
2772 vec(i)=scalar(ugrad(1,i),u(1))
2774 c write (2,*) 'vec',vec
2777 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2780 c write (2,*) 'ungrad',ungrad
2783 C-----------------------------------------------------------------------------
2784 subroutine escp(evdw2,evdw2_14)
2786 C This subroutine calculates the excluded-volume interaction energy between
2787 C peptide-group centers and side chains and its gradient in virtual-bond and
2788 C side-chain vectors.
2790 implicit real*8 (a-h,o-z)
2791 include 'DIMENSIONS'
2792 include 'sizesclu.dat'
2793 include 'COMMON.GEO'
2794 include 'COMMON.VAR'
2795 include 'COMMON.LOCAL'
2796 include 'COMMON.CHAIN'
2797 include 'COMMON.DERIV'
2798 include 'COMMON.INTERACT'
2799 include 'COMMON.FFIELD'
2800 include 'COMMON.IOUNITS'
2804 cd print '(a)','Enter ESCP'
2805 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2806 c & ' scal14',scal14
2807 do i=iatscp_s,iatscp_e
2808 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2810 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2811 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2812 if (iteli.eq.0) goto 1225
2813 xi=0.5D0*(c(1,i)+c(1,i+1))
2814 yi=0.5D0*(c(2,i)+c(2,i+1))
2815 zi=0.5D0*(c(3,i)+c(3,i+1))
2817 do iint=1,nscp_gr(i)
2819 do j=iscpstart(i,iint),iscpend(i,iint)
2820 itypj=iabs(itype(j))
2821 if (itypj.eq.ntyp1) cycle
2822 C Uncomment following three lines for SC-p interactions
2826 C Uncomment following three lines for Ca-p interactions
2830 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2832 e1=fac*fac*aad(itypj,iteli)
2833 e2=fac*bad(itypj,iteli)
2834 if (iabs(j-i) .le. 2) then
2837 evdw2_14=evdw2_14+e1+e2
2840 c write (iout,*) i,j,evdwij
2844 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2846 fac=-(evdwij+e1)*rrij
2851 cd write (iout,*) 'j<i'
2852 C Uncomment following three lines for SC-p interactions
2854 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2857 cd write (iout,*) 'j>i'
2860 C Uncomment following line for SC-p interactions
2861 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2865 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2869 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2870 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2873 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2883 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2884 gradx_scp(j,i)=expon*gradx_scp(j,i)
2887 C******************************************************************************
2891 C To save time the factor EXPON has been extracted from ALL components
2892 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2895 C******************************************************************************
2898 C--------------------------------------------------------------------------
2899 subroutine edis(ehpb)
2901 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2903 implicit real*8 (a-h,o-z)
2904 include 'DIMENSIONS'
2905 include 'sizesclu.dat'
2906 include 'COMMON.SBRIDGE'
2907 include 'COMMON.CHAIN'
2908 include 'COMMON.DERIV'
2909 include 'COMMON.VAR'
2910 include 'COMMON.INTERACT'
2913 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2914 cd print *,'link_start=',link_start,' link_end=',link_end
2915 if (link_end.eq.0) return
2916 do i=link_start,link_end
2917 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2918 C CA-CA distance used in regularization of structure.
2921 C iii and jjj point to the residues for which the distance is assigned.
2922 if (ii.gt.nres) then
2929 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2930 C distance and angle dependent SS bond potential.
2931 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2932 & iabs(itype(jjj)).eq.1) then
2933 call ssbond_ene(iii,jjj,eij)
2936 C Calculate the distance between the two points and its difference from the
2940 C Get the force constant corresponding to this distance.
2942 C Calculate the contribution to energy.
2943 ehpb=ehpb+waga*rdis*rdis
2945 C Evaluate gradient.
2948 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2949 cd & ' waga=',waga,' fac=',fac
2951 ggg(j)=fac*(c(j,jj)-c(j,ii))
2953 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2954 C If this is a SC-SC distance, we need to calculate the contributions to the
2955 C Cartesian gradient in the SC vectors (ghpbx).
2958 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2959 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2964 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2972 C--------------------------------------------------------------------------
2973 subroutine ssbond_ene(i,j,eij)
2975 C Calculate the distance and angle dependent SS-bond potential energy
2976 C using a free-energy function derived based on RHF/6-31G** ab initio
2977 C calculations of diethyl disulfide.
2979 C A. Liwo and U. Kozlowska, 11/24/03
2981 implicit real*8 (a-h,o-z)
2982 include 'DIMENSIONS'
2983 include 'sizesclu.dat'
2984 include 'COMMON.SBRIDGE'
2985 include 'COMMON.CHAIN'
2986 include 'COMMON.DERIV'
2987 include 'COMMON.LOCAL'
2988 include 'COMMON.INTERACT'
2989 include 'COMMON.VAR'
2990 include 'COMMON.IOUNITS'
2991 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2992 itypi=iabs(itype(i))
2996 dxi=dc_norm(1,nres+i)
2997 dyi=dc_norm(2,nres+i)
2998 dzi=dc_norm(3,nres+i)
2999 dsci_inv=dsc_inv(itypi)
3000 itypj=iabs(itype(j))
3001 dscj_inv=dsc_inv(itypj)
3005 dxj=dc_norm(1,nres+j)
3006 dyj=dc_norm(2,nres+j)
3007 dzj=dc_norm(3,nres+j)
3008 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3013 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3014 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3015 om12=dxi*dxj+dyi*dyj+dzi*dzj
3017 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3018 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3024 deltat12=om2-om1+2.0d0
3026 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3027 & +akct*deltad*deltat12
3028 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3029 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3030 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3031 c & " deltat12",deltat12," eij",eij
3032 ed=2*akcm*deltad+akct*deltat12
3034 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3035 eom1=-2*akth*deltat1-pom1-om2*pom2
3036 eom2= 2*akth*deltat2+pom1-om1*pom2
3039 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3042 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3043 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3044 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3045 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3048 C Calculate the components of the gradient in DC and X
3052 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3057 C--------------------------------------------------------------------------
3058 subroutine ebond(estr)
3060 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3062 implicit real*8 (a-h,o-z)
3063 include 'DIMENSIONS'
3064 include 'sizesclu.dat'
3065 include 'COMMON.LOCAL'
3066 include 'COMMON.GEO'
3067 include 'COMMON.INTERACT'
3068 include 'COMMON.DERIV'
3069 include 'COMMON.VAR'
3070 include 'COMMON.CHAIN'
3071 include 'COMMON.IOUNITS'
3072 include 'COMMON.NAMES'
3073 include 'COMMON.FFIELD'
3074 include 'COMMON.CONTROL'
3075 logical energy_dec /.false./
3076 double precision u(3),ud(3)
3080 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3081 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3083 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3084 & *dc(j,i-1)/vbld(i)
3086 if (energy_dec) write(iout,*)
3087 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3089 diff = vbld(i)-vbldp0
3090 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3093 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3098 estr=0.5d0*AKP*estr+estr1
3100 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3104 if (iti.ne.10 .and. iti.ne.ntyp1) then
3107 diff=vbld(i+nres)-vbldsc0(1,iti)
3108 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3109 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3110 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3112 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3116 diff=vbld(i+nres)-vbldsc0(j,iti)
3117 ud(j)=aksc(j,iti)*diff
3118 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3132 uprod2=uprod2*u(k)*u(k)
3136 usumsqder=usumsqder+ud(j)*uprod2
3138 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3139 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3140 estr=estr+uprod/usum
3142 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3150 C--------------------------------------------------------------------------
3151 subroutine ebend(etheta)
3153 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3154 C angles gamma and its derivatives in consecutive thetas and gammas.
3156 implicit real*8 (a-h,o-z)
3157 include 'DIMENSIONS'
3158 include 'sizesclu.dat'
3159 include 'COMMON.LOCAL'
3160 include 'COMMON.GEO'
3161 include 'COMMON.INTERACT'
3162 include 'COMMON.DERIV'
3163 include 'COMMON.VAR'
3164 include 'COMMON.CHAIN'
3165 include 'COMMON.IOUNITS'
3166 include 'COMMON.NAMES'
3167 include 'COMMON.FFIELD'
3168 common /calcthet/ term1,term2,termm,diffak,ratak,
3169 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3170 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3171 double precision y(2),z(2)
3173 c time11=dexp(-2*time)
3176 c write (iout,*) "nres",nres
3177 c write (*,'(a,i2)') 'EBEND ICG=',icg
3178 c write (iout,*) ithet_start,ithet_end
3179 do i=ithet_start,ithet_end
3180 if (itype(i-1).eq.ntyp1) cycle
3181 C Zero the energy function and its derivative at 0 or pi.
3182 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3184 ichir1=isign(1,itype(i-2))
3185 ichir2=isign(1,itype(i))
3186 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3187 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3188 if (itype(i-1).eq.10) then
3189 itype1=isign(10,itype(i-2))
3190 ichir11=isign(1,itype(i-2))
3191 ichir12=isign(1,itype(i-2))
3192 itype2=isign(10,itype(i))
3193 ichir21=isign(1,itype(i))
3194 ichir22=isign(1,itype(i))
3196 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3200 c call proc_proc(phii,icrc)
3201 if (icrc.eq.1) phii=150.0
3211 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3215 c call proc_proc(phii1,icrc)
3216 if (icrc.eq.1) phii1=150.0
3228 C Calculate the "mean" value of theta from the part of the distribution
3229 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3230 C In following comments this theta will be referred to as t_c.
3231 thet_pred_mean=0.0d0
3233 athetk=athet(k,it,ichir1,ichir2)
3234 bthetk=bthet(k,it,ichir1,ichir2)
3236 athetk=athet(k,itype1,ichir11,ichir12)
3237 bthetk=bthet(k,itype2,ichir21,ichir22)
3239 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3241 c write (iout,*) "thet_pred_mean",thet_pred_mean
3242 dthett=thet_pred_mean*ssd
3243 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3244 c write (iout,*) "thet_pred_mean",thet_pred_mean
3245 C Derivatives of the "mean" values in gamma1 and gamma2.
3246 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3247 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3248 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3249 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3251 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3252 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3253 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3254 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3256 if (theta(i).gt.pi-delta) then
3257 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3259 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3260 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3261 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3263 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3265 else if (theta(i).lt.delta) then
3266 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3267 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3268 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3270 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3271 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3274 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3277 etheta=etheta+ethetai
3278 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3279 c & rad2deg*phii,rad2deg*phii1,ethetai
3280 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3281 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3282 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3285 C Ufff.... We've done all this!!!
3288 C---------------------------------------------------------------------------
3289 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3291 implicit real*8 (a-h,o-z)
3292 include 'DIMENSIONS'
3293 include 'COMMON.LOCAL'
3294 include 'COMMON.IOUNITS'
3295 common /calcthet/ term1,term2,termm,diffak,ratak,
3296 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3297 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3298 C Calculate the contributions to both Gaussian lobes.
3299 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3300 C The "polynomial part" of the "standard deviation" of this part of
3304 sig=sig*thet_pred_mean+polthet(j,it)
3306 C Derivative of the "interior part" of the "standard deviation of the"
3307 C gamma-dependent Gaussian lobe in t_c.
3308 sigtc=3*polthet(3,it)
3310 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3313 C Set the parameters of both Gaussian lobes of the distribution.
3314 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3315 fac=sig*sig+sigc0(it)
3318 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3319 sigsqtc=-4.0D0*sigcsq*sigtc
3320 c print *,i,sig,sigtc,sigsqtc
3321 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3322 sigtc=-sigtc/(fac*fac)
3323 C Following variable is sigma(t_c)**(-2)
3324 sigcsq=sigcsq*sigcsq
3326 sig0inv=1.0D0/sig0i**2
3327 delthec=thetai-thet_pred_mean
3328 delthe0=thetai-theta0i
3329 term1=-0.5D0*sigcsq*delthec*delthec
3330 term2=-0.5D0*sig0inv*delthe0*delthe0
3331 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3332 C NaNs in taking the logarithm. We extract the largest exponent which is added
3333 C to the energy (this being the log of the distribution) at the end of energy
3334 C term evaluation for this virtual-bond angle.
3335 if (term1.gt.term2) then
3337 term2=dexp(term2-termm)
3341 term1=dexp(term1-termm)
3344 C The ratio between the gamma-independent and gamma-dependent lobes of
3345 C the distribution is a Gaussian function of thet_pred_mean too.
3346 diffak=gthet(2,it)-thet_pred_mean
3347 ratak=diffak/gthet(3,it)**2
3348 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3349 C Let's differentiate it in thet_pred_mean NOW.
3351 C Now put together the distribution terms to make complete distribution.
3352 termexp=term1+ak*term2
3353 termpre=sigc+ak*sig0i
3354 C Contribution of the bending energy from this theta is just the -log of
3355 C the sum of the contributions from the two lobes and the pre-exponential
3356 C factor. Simple enough, isn't it?
3357 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3358 C NOW the derivatives!!!
3359 C 6/6/97 Take into account the deformation.
3360 E_theta=(delthec*sigcsq*term1
3361 & +ak*delthe0*sig0inv*term2)/termexp
3362 E_tc=((sigtc+aktc*sig0i)/termpre
3363 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3364 & aktc*term2)/termexp)
3367 c-----------------------------------------------------------------------------
3368 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3369 implicit real*8 (a-h,o-z)
3370 include 'DIMENSIONS'
3371 include 'COMMON.LOCAL'
3372 include 'COMMON.IOUNITS'
3373 common /calcthet/ term1,term2,termm,diffak,ratak,
3374 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3375 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3376 delthec=thetai-thet_pred_mean
3377 delthe0=thetai-theta0i
3378 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3379 t3 = thetai-thet_pred_mean
3383 t14 = t12+t6*sigsqtc
3385 t21 = thetai-theta0i
3391 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3392 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3393 & *(-t12*t9-ak*sig0inv*t27)
3397 C--------------------------------------------------------------------------
3398 subroutine ebend(etheta)
3400 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3401 C angles gamma and its derivatives in consecutive thetas and gammas.
3402 C ab initio-derived potentials from
3403 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3405 implicit real*8 (a-h,o-z)
3406 include 'DIMENSIONS'
3407 include 'sizesclu.dat'
3408 include 'COMMON.LOCAL'
3409 include 'COMMON.GEO'
3410 include 'COMMON.INTERACT'
3411 include 'COMMON.DERIV'
3412 include 'COMMON.VAR'
3413 include 'COMMON.CHAIN'
3414 include 'COMMON.IOUNITS'
3415 include 'COMMON.NAMES'
3416 include 'COMMON.FFIELD'
3417 include 'COMMON.CONTROL'
3418 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3419 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3420 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3421 & sinph1ph2(maxdouble,maxdouble)
3422 logical lprn /.false./, lprn1 /.false./
3424 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3425 do i=ithet_start,ithet_end
3426 c if (itype(i-1).eq.ntyp1) cycle
3427 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3428 &(itype(i).eq.ntyp1)) cycle
3429 if (iabs(itype(i+1)).eq.20) iblock=2
3430 if (iabs(itype(i+1)).ne.20) iblock=1
3434 theti2=0.5d0*theta(i)
3435 CC Ta zmina jest niewlasciwa
3436 ityp2=ithetyp((itype(i-1)))
3438 coskt(k)=dcos(k*theti2)
3439 sinkt(k)=dsin(k*theti2)
3441 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3444 if (phii.ne.phii) phii=150.0
3448 ityp1=ithetyp((itype(i-2)))
3450 cosph1(k)=dcos(k*phii)
3451 sinph1(k)=dsin(k*phii)
3457 ityp1=ithetyp((itype(i-2)))
3462 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3465 if (phii1.ne.phii1) phii1=150.0
3470 ityp3=ithetyp((itype(i)))
3472 cosph2(k)=dcos(k*phii1)
3473 sinph2(k)=dsin(k*phii1)
3478 ityp3=ithetyp((itype(i)))
3484 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3485 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3487 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3490 ccl=cosph1(l)*cosph2(k-l)
3491 ssl=sinph1(l)*sinph2(k-l)
3492 scl=sinph1(l)*cosph2(k-l)
3493 csl=cosph1(l)*sinph2(k-l)
3494 cosph1ph2(l,k)=ccl-ssl
3495 cosph1ph2(k,l)=ccl+ssl
3496 sinph1ph2(l,k)=scl+csl
3497 sinph1ph2(k,l)=scl-csl
3501 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3502 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3503 write (iout,*) "coskt and sinkt"
3505 write (iout,*) k,coskt(k),sinkt(k)
3509 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3510 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3513 & write (iout,*) "k",k," aathet",
3514 & aathet(k,ityp1,ityp2,ityp3,iblock),
3515 & " ethetai",ethetai
3518 write (iout,*) "cosph and sinph"
3520 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3522 write (iout,*) "cosph1ph2 and sinph2ph2"
3525 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3526 & sinph1ph2(l,k),sinph1ph2(k,l)
3529 write(iout,*) "ethetai",ethetai
3533 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3534 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3535 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3536 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3537 ethetai=ethetai+sinkt(m)*aux
3538 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3539 dephii=dephii+k*sinkt(m)*(
3540 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3541 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3542 dephii1=dephii1+k*sinkt(m)*(
3543 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3544 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3546 & write (iout,*) "m",m," k",k," bbthet",
3547 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3548 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3549 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3550 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3554 & write(iout,*) "ethetai",ethetai
3558 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3559 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3560 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3561 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3562 ethetai=ethetai+sinkt(m)*aux
3563 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3564 dephii=dephii+l*sinkt(m)*(
3565 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3566 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3567 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3568 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3569 dephii1=dephii1+(k-l)*sinkt(m)*(
3570 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3571 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3572 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3573 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3575 write (iout,*) "m",m," k",k," l",l," ffthet",
3576 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3577 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3578 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3579 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3580 & " ethetai",ethetai
3581 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3582 & cosph1ph2(k,l)*sinkt(m),
3583 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3589 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3590 & i,theta(i)*rad2deg,phii*rad2deg,
3591 & phii1*rad2deg,ethetai
3592 etheta=etheta+ethetai
3593 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3594 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3595 c gloc(nphi+i-2,icg)=wang*dethetai
3596 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3602 c-----------------------------------------------------------------------------
3603 subroutine esc(escloc)
3604 C Calculate the local energy of a side chain and its derivatives in the
3605 C corresponding virtual-bond valence angles THETA and the spherical angles
3607 implicit real*8 (a-h,o-z)
3608 include 'DIMENSIONS'
3609 include 'sizesclu.dat'
3610 include 'COMMON.GEO'
3611 include 'COMMON.LOCAL'
3612 include 'COMMON.VAR'
3613 include 'COMMON.INTERACT'
3614 include 'COMMON.DERIV'
3615 include 'COMMON.CHAIN'
3616 include 'COMMON.IOUNITS'
3617 include 'COMMON.NAMES'
3618 include 'COMMON.FFIELD'
3619 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3620 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3621 common /sccalc/ time11,time12,time112,theti,it,nlobit
3624 c write (iout,'(a)') 'ESC'
3625 do i=loc_start,loc_end
3627 if (it.eq.ntyp1) cycle
3628 if (it.eq.10) goto 1
3629 nlobit=nlob(iabs(it))
3630 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3631 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3632 theti=theta(i+1)-pipol
3636 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3638 if (x(2).gt.pi-delta) then
3642 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3644 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3645 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3647 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3648 & ddersc0(1),dersc(1))
3649 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3650 & ddersc0(3),dersc(3))
3652 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3654 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3655 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3656 & dersc0(2),esclocbi,dersc02)
3657 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3659 call splinthet(x(2),0.5d0*delta,ss,ssd)
3664 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3666 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3667 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3669 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3671 c write (iout,*) escloci
3672 else if (x(2).lt.delta) then
3676 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3678 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3679 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3681 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3682 & ddersc0(1),dersc(1))
3683 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3684 & ddersc0(3),dersc(3))
3686 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3688 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3689 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3690 & dersc0(2),esclocbi,dersc02)
3691 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3696 call splinthet(x(2),0.5d0*delta,ss,ssd)
3698 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3700 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3701 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3703 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3704 c write (iout,*) escloci
3706 call enesc(x,escloci,dersc,ddummy,.false.)
3709 escloc=escloc+escloci
3710 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3712 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3714 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3715 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3720 C---------------------------------------------------------------------------
3721 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3722 implicit real*8 (a-h,o-z)
3723 include 'DIMENSIONS'
3724 include 'COMMON.GEO'
3725 include 'COMMON.LOCAL'
3726 include 'COMMON.IOUNITS'
3727 common /sccalc/ time11,time12,time112,theti,it,nlobit
3728 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3729 double precision contr(maxlob,-1:1)
3731 c write (iout,*) 'it=',it,' nlobit=',nlobit
3735 if (mixed) ddersc(j)=0.0d0
3739 C Because of periodicity of the dependence of the SC energy in omega we have
3740 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3741 C To avoid underflows, first compute & store the exponents.
3749 z(k)=x(k)-censc(k,j,it)
3754 Axk=Axk+gaussc(l,k,j,it)*z(l)
3760 expfac=expfac+Ax(k,j,iii)*z(k)
3768 C As in the case of ebend, we want to avoid underflows in exponentiation and
3769 C subsequent NaNs and INFs in energy calculation.
3770 C Find the largest exponent
3774 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3778 cd print *,'it=',it,' emin=',emin
3780 C Compute the contribution to SC energy and derivatives
3784 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3785 cd print *,'j=',j,' expfac=',expfac
3786 escloc_i=escloc_i+expfac
3788 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3792 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3793 & +gaussc(k,2,j,it))*expfac
3800 dersc(1)=dersc(1)/cos(theti)**2
3801 ddersc(1)=ddersc(1)/cos(theti)**2
3804 escloci=-(dlog(escloc_i)-emin)
3806 dersc(j)=dersc(j)/escloc_i
3810 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3815 C------------------------------------------------------------------------------
3816 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3817 implicit real*8 (a-h,o-z)
3818 include 'DIMENSIONS'
3819 include 'COMMON.GEO'
3820 include 'COMMON.LOCAL'
3821 include 'COMMON.IOUNITS'
3822 common /sccalc/ time11,time12,time112,theti,it,nlobit
3823 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3824 double precision contr(maxlob)
3835 z(k)=x(k)-censc(k,j,it)
3841 Axk=Axk+gaussc(l,k,j,it)*z(l)
3847 expfac=expfac+Ax(k,j)*z(k)
3852 C As in the case of ebend, we want to avoid underflows in exponentiation and
3853 C subsequent NaNs and INFs in energy calculation.
3854 C Find the largest exponent
3857 if (emin.gt.contr(j)) emin=contr(j)
3861 C Compute the contribution to SC energy and derivatives
3865 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3866 escloc_i=escloc_i+expfac
3868 dersc(k)=dersc(k)+Ax(k,j)*expfac
3870 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3871 & +gaussc(1,2,j,it))*expfac
3875 dersc(1)=dersc(1)/cos(theti)**2
3876 dersc12=dersc12/cos(theti)**2
3877 escloci=-(dlog(escloc_i)-emin)
3879 dersc(j)=dersc(j)/escloc_i
3881 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3885 c----------------------------------------------------------------------------------
3886 subroutine esc(escloc)
3887 C Calculate the local energy of a side chain and its derivatives in the
3888 C corresponding virtual-bond valence angles THETA and the spherical angles
3889 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3890 C added by Urszula Kozlowska. 07/11/2007
3892 implicit real*8 (a-h,o-z)
3893 include 'DIMENSIONS'
3894 include 'sizesclu.dat'
3895 include 'COMMON.GEO'
3896 include 'COMMON.LOCAL'
3897 include 'COMMON.VAR'
3898 include 'COMMON.SCROT'
3899 include 'COMMON.INTERACT'
3900 include 'COMMON.DERIV'
3901 include 'COMMON.CHAIN'
3902 include 'COMMON.IOUNITS'
3903 include 'COMMON.NAMES'
3904 include 'COMMON.FFIELD'
3905 include 'COMMON.CONTROL'
3906 include 'COMMON.VECTORS'
3907 double precision x_prime(3),y_prime(3),z_prime(3)
3908 & , sumene,dsc_i,dp2_i,x(65),
3909 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3910 & de_dxx,de_dyy,de_dzz,de_dt
3911 double precision s1_t,s1_6_t,s2_t,s2_6_t
3913 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3914 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3915 & dt_dCi(3),dt_dCi1(3)
3916 common /sccalc/ time11,time12,time112,theti,it,nlobit
3919 do i=loc_start,loc_end
3920 if (itype(i).eq.ntyp1) cycle
3921 costtab(i+1) =dcos(theta(i+1))
3922 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3923 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3924 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3925 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3926 cosfac=dsqrt(cosfac2)
3927 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3928 sinfac=dsqrt(sinfac2)
3930 if (it.eq.10) goto 1
3932 C Compute the axes of tghe local cartesian coordinates system; store in
3933 c x_prime, y_prime and z_prime
3940 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3941 C & dc_norm(3,i+nres)
3943 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3944 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3947 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3950 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3951 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3952 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3953 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3954 c & " xy",scalar(x_prime(1),y_prime(1)),
3955 c & " xz",scalar(x_prime(1),z_prime(1)),
3956 c & " yy",scalar(y_prime(1),y_prime(1)),
3957 c & " yz",scalar(y_prime(1),z_prime(1)),
3958 c & " zz",scalar(z_prime(1),z_prime(1))
3960 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3961 C to local coordinate system. Store in xx, yy, zz.
3967 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3968 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3969 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3976 C Compute the energy of the ith side cbain
3978 c write (2,*) "xx",xx," yy",yy," zz",zz
3981 x(j) = sc_parmin(j,it)
3984 Cc diagnostics - remove later
3986 yy1 = dsin(alph(2))*dcos(omeg(2))
3987 c zz1 = -dsin(alph(2))*dsin(omeg(2))
3988 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3989 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3990 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3992 C," --- ", xx_w,yy_w,zz_w
3995 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3996 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3998 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3999 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4001 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4002 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4003 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4004 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4005 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4007 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4008 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4009 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4010 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4011 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4013 dsc_i = 0.743d0+x(61)
4015 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4016 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4017 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4018 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4019 s1=(1+x(63))/(0.1d0 + dscp1)
4020 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4021 s2=(1+x(65))/(0.1d0 + dscp2)
4022 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4023 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4024 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4025 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4027 c & dscp1,dscp2,sumene
4028 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4029 escloc = escloc + sumene
4030 c write (2,*) "escloc",escloc
4031 if (.not. calc_grad) goto 1
4034 C This section to check the numerical derivatives of the energy of ith side
4035 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4036 C #define DEBUG in the code to turn it on.
4038 write (2,*) "sumene =",sumene
4042 write (2,*) xx,yy,zz
4043 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4044 de_dxx_num=(sumenep-sumene)/aincr
4046 write (2,*) "xx+ sumene from enesc=",sumenep
4049 write (2,*) xx,yy,zz
4050 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4051 de_dyy_num=(sumenep-sumene)/aincr
4053 write (2,*) "yy+ sumene from enesc=",sumenep
4056 write (2,*) xx,yy,zz
4057 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4058 de_dzz_num=(sumenep-sumene)/aincr
4060 write (2,*) "zz+ sumene from enesc=",sumenep
4061 costsave=cost2tab(i+1)
4062 sintsave=sint2tab(i+1)
4063 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4064 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4065 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4066 de_dt_num=(sumenep-sumene)/aincr
4067 write (2,*) " t+ sumene from enesc=",sumenep
4068 cost2tab(i+1)=costsave
4069 sint2tab(i+1)=sintsave
4070 C End of diagnostics section.
4073 C Compute the gradient of esc
4075 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4076 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4077 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4078 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4079 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4080 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4081 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4082 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4083 pom1=(sumene3*sint2tab(i+1)+sumene1)
4084 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4085 pom2=(sumene4*cost2tab(i+1)+sumene2)
4086 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4087 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4088 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4089 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4091 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4092 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4093 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4095 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4096 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4097 & +(pom1+pom2)*pom_dx
4099 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4102 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4103 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4104 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4106 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4107 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4108 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4109 & +x(59)*zz**2 +x(60)*xx*zz
4110 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4111 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4112 & +(pom1-pom2)*pom_dy
4114 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4117 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4118 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4119 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4120 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4121 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4122 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4123 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4124 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4126 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4129 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4130 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4131 & +pom1*pom_dt1+pom2*pom_dt2
4133 write(2,*), "de_dt = ", de_dt,de_dt_num
4137 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4138 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4139 cosfac2xx=cosfac2*xx
4140 sinfac2yy=sinfac2*yy
4142 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4144 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4146 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4147 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4148 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4149 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4150 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4151 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4152 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4153 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4154 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4155 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4159 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4160 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4161 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4162 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4165 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4166 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4167 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4169 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4170 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4174 dXX_Ctab(k,i)=dXX_Ci(k)
4175 dXX_C1tab(k,i)=dXX_Ci1(k)
4176 dYY_Ctab(k,i)=dYY_Ci(k)
4177 dYY_C1tab(k,i)=dYY_Ci1(k)
4178 dZZ_Ctab(k,i)=dZZ_Ci(k)
4179 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4180 dXX_XYZtab(k,i)=dXX_XYZ(k)
4181 dYY_XYZtab(k,i)=dYY_XYZ(k)
4182 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4186 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4187 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4188 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4189 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4190 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4192 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4193 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4194 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4195 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4196 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4197 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4198 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4199 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4201 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4202 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4204 C to check gradient call subroutine check_grad
4211 c------------------------------------------------------------------------------
4212 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4214 C This procedure calculates two-body contact function g(rij) and its derivative:
4217 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4220 C where x=(rij-r0ij)/delta
4222 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4225 double precision rij,r0ij,eps0ij,fcont,fprimcont
4226 double precision x,x2,x4,delta
4230 if (x.lt.-1.0D0) then
4233 else if (x.le.1.0D0) then
4236 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4237 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4244 c------------------------------------------------------------------------------
4245 subroutine splinthet(theti,delta,ss,ssder)
4246 implicit real*8 (a-h,o-z)
4247 include 'DIMENSIONS'
4248 include 'sizesclu.dat'
4249 include 'COMMON.VAR'
4250 include 'COMMON.GEO'
4253 if (theti.gt.pipol) then
4254 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4256 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4261 c------------------------------------------------------------------------------
4262 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4264 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4265 double precision ksi,ksi2,ksi3,a1,a2,a3
4266 a1=fprim0*delta/(f1-f0)
4272 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4273 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4276 c------------------------------------------------------------------------------
4277 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4279 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4280 double precision ksi,ksi2,ksi3,a1,a2,a3
4285 a2=3*(f1x-f0x)-2*fprim0x*delta
4286 a3=fprim0x*delta-2*(f1x-f0x)
4287 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4290 C-----------------------------------------------------------------------------
4292 C-----------------------------------------------------------------------------
4293 subroutine etor(etors,edihcnstr,fact)
4294 implicit real*8 (a-h,o-z)
4295 include 'DIMENSIONS'
4296 include 'sizesclu.dat'
4297 include 'COMMON.VAR'
4298 include 'COMMON.GEO'
4299 include 'COMMON.LOCAL'
4300 include 'COMMON.TORSION'
4301 include 'COMMON.INTERACT'
4302 include 'COMMON.DERIV'
4303 include 'COMMON.CHAIN'
4304 include 'COMMON.NAMES'
4305 include 'COMMON.IOUNITS'
4306 include 'COMMON.FFIELD'
4307 include 'COMMON.TORCNSTR'
4309 C Set lprn=.true. for debugging
4313 do i=iphi_start,iphi_end
4314 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4315 & .or. itype(i).eq.ntyp1) cycle
4316 itori=itortyp(itype(i-2))
4317 itori1=itortyp(itype(i-1))
4320 C Proline-Proline pair is a special case...
4321 if (itori.eq.3 .and. itori1.eq.3) then
4322 if (phii.gt.-dwapi3) then
4324 fac=1.0D0/(1.0D0-cosphi)
4325 etorsi=v1(1,3,3)*fac
4326 etorsi=etorsi+etorsi
4327 etors=etors+etorsi-v1(1,3,3)
4328 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4331 v1ij=v1(j+1,itori,itori1)
4332 v2ij=v2(j+1,itori,itori1)
4335 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4336 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4340 v1ij=v1(j,itori,itori1)
4341 v2ij=v2(j,itori,itori1)
4344 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4345 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4349 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4350 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4351 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4352 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4353 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4355 ! 6/20/98 - dihedral angle constraints
4358 itori=idih_constr(i)
4361 if (difi.gt.drange(i)) then
4363 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4364 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4365 else if (difi.lt.-drange(i)) then
4367 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4368 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4370 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4371 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4373 ! write (iout,*) 'edihcnstr',edihcnstr
4376 c------------------------------------------------------------------------------
4378 subroutine etor(etors,edihcnstr,fact)
4379 implicit real*8 (a-h,o-z)
4380 include 'DIMENSIONS'
4381 include 'sizesclu.dat'
4382 include 'COMMON.VAR'
4383 include 'COMMON.GEO'
4384 include 'COMMON.LOCAL'
4385 include 'COMMON.TORSION'
4386 include 'COMMON.INTERACT'
4387 include 'COMMON.DERIV'
4388 include 'COMMON.CHAIN'
4389 include 'COMMON.NAMES'
4390 include 'COMMON.IOUNITS'
4391 include 'COMMON.FFIELD'
4392 include 'COMMON.TORCNSTR'
4394 C Set lprn=.true. for debugging
4398 do i=iphi_start,iphi_end
4399 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4400 & .or. itype(i).eq.ntyp1) cycle
4401 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4402 if (iabs(itype(i)).eq.20) then
4407 itori=itortyp(itype(i-2))
4408 itori1=itortyp(itype(i-1))
4411 C Regular cosine and sine terms
4412 do j=1,nterm(itori,itori1,iblock)
4413 v1ij=v1(j,itori,itori1,iblock)
4414 v2ij=v2(j,itori,itori1,iblock)
4417 etors=etors+v1ij*cosphi+v2ij*sinphi
4418 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4422 C E = SUM ----------------------------------- - v1
4423 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4425 cosphi=dcos(0.5d0*phii)
4426 sinphi=dsin(0.5d0*phii)
4427 do j=1,nlor(itori,itori1,iblock)
4428 vl1ij=vlor1(j,itori,itori1)
4429 vl2ij=vlor2(j,itori,itori1)
4430 vl3ij=vlor3(j,itori,itori1)
4431 pom=vl2ij*cosphi+vl3ij*sinphi
4432 pom1=1.0d0/(pom*pom+1.0d0)
4433 etors=etors+vl1ij*pom1
4435 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4437 C Subtract the constant term
4438 etors=etors-v0(itori,itori1,iblock)
4440 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4441 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4442 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4443 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4444 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4447 ! 6/20/98 - dihedral angle constraints
4450 itori=idih_constr(i)
4452 difi=pinorm(phii-phi0(i))
4454 if (difi.gt.drange(i)) then
4456 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4457 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4458 edihi=0.25d0*ftors*difi**4
4459 else if (difi.lt.-drange(i)) then
4461 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4462 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4463 edihi=0.25d0*ftors*difi**4
4467 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4469 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4470 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4472 ! write (iout,*) 'edihcnstr',edihcnstr
4475 c----------------------------------------------------------------------------
4476 subroutine etor_d(etors_d,fact2)
4477 C 6/23/01 Compute double torsional energy
4478 implicit real*8 (a-h,o-z)
4479 include 'DIMENSIONS'
4480 include 'sizesclu.dat'
4481 include 'COMMON.VAR'
4482 include 'COMMON.GEO'
4483 include 'COMMON.LOCAL'
4484 include 'COMMON.TORSION'
4485 include 'COMMON.INTERACT'
4486 include 'COMMON.DERIV'
4487 include 'COMMON.CHAIN'
4488 include 'COMMON.NAMES'
4489 include 'COMMON.IOUNITS'
4490 include 'COMMON.FFIELD'
4491 include 'COMMON.TORCNSTR'
4493 C Set lprn=.true. for debugging
4497 do i=iphi_start,iphi_end-1
4498 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4499 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4500 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4502 itori=itortyp(itype(i-2))
4503 itori1=itortyp(itype(i-1))
4504 itori2=itortyp(itype(i))
4510 if (iabs(itype(i+1)).eq.20) iblock=2
4511 C Regular cosine and sine terms
4512 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4513 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4514 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4515 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4516 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4517 cosphi1=dcos(j*phii)
4518 sinphi1=dsin(j*phii)
4519 cosphi2=dcos(j*phii1)
4520 sinphi2=dsin(j*phii1)
4521 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4522 & v2cij*cosphi2+v2sij*sinphi2
4523 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4524 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4526 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4528 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4529 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4530 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4531 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4532 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4533 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4534 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4535 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4536 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4537 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4538 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4539 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4540 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4541 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4544 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4545 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4551 c------------------------------------------------------------------------------
4552 subroutine eback_sc_corr(esccor)
4553 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4554 c conformational states; temporarily implemented as differences
4555 c between UNRES torsional potentials (dependent on three types of
4556 c residues) and the torsional potentials dependent on all 20 types
4557 c of residues computed from AM1 energy surfaces of terminally-blocked
4558 c amino-acid residues.
4559 implicit real*8 (a-h,o-z)
4560 include 'DIMENSIONS'
4561 include 'sizesclu.dat'
4562 include 'COMMON.VAR'
4563 include 'COMMON.GEO'
4564 include 'COMMON.LOCAL'
4565 include 'COMMON.TORSION'
4566 include 'COMMON.SCCOR'
4567 include 'COMMON.INTERACT'
4568 include 'COMMON.DERIV'
4569 include 'COMMON.CHAIN'
4570 include 'COMMON.NAMES'
4571 include 'COMMON.IOUNITS'
4572 include 'COMMON.FFIELD'
4573 include 'COMMON.CONTROL'
4575 C Set lprn=.true. for debugging
4578 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4580 do i=itau_start,itau_end
4581 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4583 isccori=isccortyp(itype(i-2))
4584 isccori1=isccortyp(itype(i-1))
4586 do intertyp=1,3 !intertyp
4587 cc Added 09 May 2012 (Adasko)
4588 cc Intertyp means interaction type of backbone mainchain correlation:
4589 c 1 = SC...Ca...Ca...Ca
4590 c 2 = Ca...Ca...Ca...SC
4591 c 3 = SC...Ca...Ca...SCi
4593 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4594 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4595 & (itype(i-1).eq.ntyp1)))
4596 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4597 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4598 & .or.(itype(i).eq.ntyp1)))
4599 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4600 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4601 & (itype(i-3).eq.ntyp1)))) cycle
4602 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4603 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4605 do j=1,nterm_sccor(isccori,isccori1)
4606 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4607 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4608 cosphi=dcos(j*tauangle(intertyp,i))
4609 sinphi=dsin(j*tauangle(intertyp,i))
4610 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4611 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4613 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4614 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4616 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4617 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4618 & (v1sccor(j,1,itori,itori1),j=1,6),
4619 & (v2sccor(j,1,itori,itori1),j=1,6)
4620 gsccor_loc(i-3)=gloci
4625 c------------------------------------------------------------------------------
4626 subroutine multibody(ecorr)
4627 C This subroutine calculates multi-body contributions to energy following
4628 C the idea of Skolnick et al. If side chains I and J make a contact and
4629 C at the same time side chains I+1 and J+1 make a contact, an extra
4630 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 include 'COMMON.IOUNITS'
4634 include 'COMMON.DERIV'
4635 include 'COMMON.INTERACT'
4636 include 'COMMON.CONTACTS'
4637 double precision gx(3),gx1(3)
4640 C Set lprn=.true. for debugging
4644 write (iout,'(a)') 'Contact function values:'
4646 write (iout,'(i2,20(1x,i2,f10.5))')
4647 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4662 num_conti=num_cont(i)
4663 num_conti1=num_cont(i1)
4668 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4669 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4670 cd & ' ishift=',ishift
4671 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4672 C The system gains extra energy.
4673 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4674 endif ! j1==j+-ishift
4683 c------------------------------------------------------------------------------
4684 double precision function esccorr(i,j,k,l,jj,kk)
4685 implicit real*8 (a-h,o-z)
4686 include 'DIMENSIONS'
4687 include 'COMMON.IOUNITS'
4688 include 'COMMON.DERIV'
4689 include 'COMMON.INTERACT'
4690 include 'COMMON.CONTACTS'
4691 double precision gx(3),gx1(3)
4696 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4697 C Calculate the multi-body contribution to energy.
4698 C Calculate multi-body contributions to the gradient.
4699 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4700 cd & k,l,(gacont(m,kk,k),m=1,3)
4702 gx(m) =ekl*gacont(m,jj,i)
4703 gx1(m)=eij*gacont(m,kk,k)
4704 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4705 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4706 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4707 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4711 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4716 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4722 c------------------------------------------------------------------------------
4724 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4725 implicit real*8 (a-h,o-z)
4726 include 'DIMENSIONS'
4727 integer dimen1,dimen2,atom,indx
4728 double precision buffer(dimen1,dimen2)
4729 double precision zapas
4730 common /contacts_hb/ zapas(3,20,maxres,7),
4731 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4732 & num_cont_hb(maxres),jcont_hb(20,maxres)
4733 num_kont=num_cont_hb(atom)
4737 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4740 buffer(i,indx+22)=facont_hb(i,atom)
4741 buffer(i,indx+23)=ees0p(i,atom)
4742 buffer(i,indx+24)=ees0m(i,atom)
4743 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4745 buffer(1,indx+26)=dfloat(num_kont)
4748 c------------------------------------------------------------------------------
4749 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4750 implicit real*8 (a-h,o-z)
4751 include 'DIMENSIONS'
4752 integer dimen1,dimen2,atom,indx
4753 double precision buffer(dimen1,dimen2)
4754 double precision zapas
4755 common /contacts_hb/ zapas(3,20,maxres,7),
4756 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4757 & num_cont_hb(maxres),jcont_hb(20,maxres)
4758 num_kont=buffer(1,indx+26)
4759 num_kont_old=num_cont_hb(atom)
4760 num_cont_hb(atom)=num_kont+num_kont_old
4765 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4768 facont_hb(ii,atom)=buffer(i,indx+22)
4769 ees0p(ii,atom)=buffer(i,indx+23)
4770 ees0m(ii,atom)=buffer(i,indx+24)
4771 jcont_hb(ii,atom)=buffer(i,indx+25)
4775 c------------------------------------------------------------------------------
4777 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4778 C This subroutine calculates multi-body contributions to hydrogen-bonding
4779 implicit real*8 (a-h,o-z)
4780 include 'DIMENSIONS'
4781 include 'sizesclu.dat'
4782 include 'COMMON.IOUNITS'
4784 include 'COMMON.INFO'
4786 include 'COMMON.FFIELD'
4787 include 'COMMON.DERIV'
4788 include 'COMMON.INTERACT'
4789 include 'COMMON.CONTACTS'
4791 parameter (max_cont=maxconts)
4792 parameter (max_dim=2*(8*3+2))
4793 parameter (msglen1=max_cont*max_dim*4)
4794 parameter (msglen2=2*msglen1)
4795 integer source,CorrelType,CorrelID,Error
4796 double precision buffer(max_cont,max_dim)
4798 double precision gx(3),gx1(3)
4801 C Set lprn=.true. for debugging
4806 if (fgProcs.le.1) goto 30
4808 write (iout,'(a)') 'Contact function values:'
4810 write (iout,'(2i3,50(1x,i2,f5.2))')
4811 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4812 & j=1,num_cont_hb(i))
4815 C Caution! Following code assumes that electrostatic interactions concerning
4816 C a given atom are split among at most two processors!
4826 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4829 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4830 if (MyRank.gt.0) then
4831 C Send correlation contributions to the preceding processor
4833 nn=num_cont_hb(iatel_s)
4834 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4835 cd write (iout,*) 'The BUFFER array:'
4837 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4839 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4841 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4842 C Clear the contacts of the atom passed to the neighboring processor
4843 nn=num_cont_hb(iatel_s+1)
4845 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4847 num_cont_hb(iatel_s)=0
4849 cd write (iout,*) 'Processor ',MyID,MyRank,
4850 cd & ' is sending correlation contribution to processor',MyID-1,
4851 cd & ' msglen=',msglen
4852 cd write (*,*) 'Processor ',MyID,MyRank,
4853 cd & ' is sending correlation contribution to processor',MyID-1,
4854 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4855 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4856 cd write (iout,*) 'Processor ',MyID,
4857 cd & ' has sent correlation contribution to processor',MyID-1,
4858 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4859 cd write (*,*) 'Processor ',MyID,
4860 cd & ' has sent correlation contribution to processor',MyID-1,
4861 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4863 endif ! (MyRank.gt.0)
4867 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4868 if (MyRank.lt.fgProcs-1) then
4869 C Receive correlation contributions from the next processor
4871 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4872 cd write (iout,*) 'Processor',MyID,
4873 cd & ' is receiving correlation contribution from processor',MyID+1,
4874 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4875 cd write (*,*) 'Processor',MyID,
4876 cd & ' is receiving correlation contribution from processor',MyID+1,
4877 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4879 do while (nbytes.le.0)
4880 call mp_probe(MyID+1,CorrelType,nbytes)
4882 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4883 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4884 cd write (iout,*) 'Processor',MyID,
4885 cd & ' has received correlation contribution from processor',MyID+1,
4886 cd & ' msglen=',msglen,' nbytes=',nbytes
4887 cd write (iout,*) 'The received BUFFER array:'
4889 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4891 if (msglen.eq.msglen1) then
4892 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4893 else if (msglen.eq.msglen2) then
4894 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4895 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4898 & 'ERROR!!!! message length changed while processing correlations.'
4900 & 'ERROR!!!! message length changed while processing correlations.'
4901 call mp_stopall(Error)
4902 endif ! msglen.eq.msglen1
4903 endif ! MyRank.lt.fgProcs-1
4910 write (iout,'(a)') 'Contact function values:'
4912 write (iout,'(2i3,50(1x,i2,f5.2))')
4913 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4914 & j=1,num_cont_hb(i))
4918 C Remove the loop below after debugging !!!
4925 C Calculate the local-electrostatic correlation terms
4926 do i=iatel_s,iatel_e+1
4928 num_conti=num_cont_hb(i)
4929 num_conti1=num_cont_hb(i+1)
4934 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4935 c & ' jj=',jj,' kk=',kk
4936 if (j1.eq.j+1 .or. j1.eq.j-1) then
4937 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4938 C The system gains extra energy.
4939 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4941 else if (j1.eq.j) then
4942 C Contacts I-J and I-(J+1) occur simultaneously.
4943 C The system loses extra energy.
4944 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4949 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4950 c & ' jj=',jj,' kk=',kk
4952 C Contacts I-J and (I+1)-J occur simultaneously.
4953 C The system loses extra energy.
4954 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4961 c------------------------------------------------------------------------------
4962 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4964 C This subroutine calculates multi-body contributions to hydrogen-bonding
4965 implicit real*8 (a-h,o-z)
4966 include 'DIMENSIONS'
4967 include 'sizesclu.dat'
4968 include 'COMMON.IOUNITS'
4970 include 'COMMON.INFO'
4972 include 'COMMON.FFIELD'
4973 include 'COMMON.DERIV'
4974 include 'COMMON.INTERACT'
4975 include 'COMMON.CONTACTS'
4977 parameter (max_cont=maxconts)
4978 parameter (max_dim=2*(8*3+2))
4979 parameter (msglen1=max_cont*max_dim*4)
4980 parameter (msglen2=2*msglen1)
4981 integer source,CorrelType,CorrelID,Error
4982 double precision buffer(max_cont,max_dim)
4984 double precision gx(3),gx1(3)
4987 C Set lprn=.true. for debugging
4993 if (fgProcs.le.1) goto 30
4995 write (iout,'(a)') 'Contact function values:'
4997 write (iout,'(2i3,50(1x,i2,f5.2))')
4998 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4999 & j=1,num_cont_hb(i))
5002 C Caution! Following code assumes that electrostatic interactions concerning
5003 C a given atom are split among at most two processors!
5013 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5016 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5017 if (MyRank.gt.0) then
5018 C Send correlation contributions to the preceding processor
5020 nn=num_cont_hb(iatel_s)
5021 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5022 cd write (iout,*) 'The BUFFER array:'
5024 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5026 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5028 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5029 C Clear the contacts of the atom passed to the neighboring processor
5030 nn=num_cont_hb(iatel_s+1)
5032 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5034 num_cont_hb(iatel_s)=0
5036 cd write (iout,*) 'Processor ',MyID,MyRank,
5037 cd & ' is sending correlation contribution to processor',MyID-1,
5038 cd & ' msglen=',msglen
5039 cd write (*,*) 'Processor ',MyID,MyRank,
5040 cd & ' is sending correlation contribution to processor',MyID-1,
5041 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5042 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5043 cd write (iout,*) 'Processor ',MyID,
5044 cd & ' has sent correlation contribution to processor',MyID-1,
5045 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5046 cd write (*,*) 'Processor ',MyID,
5047 cd & ' has sent correlation contribution to processor',MyID-1,
5048 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5050 endif ! (MyRank.gt.0)
5054 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5055 if (MyRank.lt.fgProcs-1) then
5056 C Receive correlation contributions from the next processor
5058 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5059 cd write (iout,*) 'Processor',MyID,
5060 cd & ' is receiving correlation contribution from processor',MyID+1,
5061 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5062 cd write (*,*) 'Processor',MyID,
5063 cd & ' is receiving correlation contribution from processor',MyID+1,
5064 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5066 do while (nbytes.le.0)
5067 call mp_probe(MyID+1,CorrelType,nbytes)
5069 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5070 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5071 cd write (iout,*) 'Processor',MyID,
5072 cd & ' has received correlation contribution from processor',MyID+1,
5073 cd & ' msglen=',msglen,' nbytes=',nbytes
5074 cd write (iout,*) 'The received BUFFER array:'
5076 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5078 if (msglen.eq.msglen1) then
5079 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5080 else if (msglen.eq.msglen2) then
5081 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5082 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5085 & 'ERROR!!!! message length changed while processing correlations.'
5087 & 'ERROR!!!! message length changed while processing correlations.'
5088 call mp_stopall(Error)
5089 endif ! msglen.eq.msglen1
5090 endif ! MyRank.lt.fgProcs-1
5097 write (iout,'(a)') 'Contact function values:'
5099 write (iout,'(2i3,50(1x,i2,f5.2))')
5100 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5101 & j=1,num_cont_hb(i))
5107 C Remove the loop below after debugging !!!
5114 C Calculate the dipole-dipole interaction energies
5115 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5116 do i=iatel_s,iatel_e+1
5117 num_conti=num_cont_hb(i)
5124 C Calculate the local-electrostatic correlation terms
5125 do i=iatel_s,iatel_e+1
5127 num_conti=num_cont_hb(i)
5128 num_conti1=num_cont_hb(i+1)
5133 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5134 c & ' jj=',jj,' kk=',kk
5135 if (j1.eq.j+1 .or. j1.eq.j-1) then
5136 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5137 C The system gains extra energy.
5139 sqd1=dsqrt(d_cont(jj,i))
5140 sqd2=dsqrt(d_cont(kk,i1))
5141 sred_geom = sqd1*sqd2
5142 IF (sred_geom.lt.cutoff_corr) THEN
5143 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5145 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5146 c & ' jj=',jj,' kk=',kk
5147 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5148 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5150 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5151 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5154 cd write (iout,*) 'sred_geom=',sred_geom,
5155 cd & ' ekont=',ekont,' fprim=',fprimcont
5156 call calc_eello(i,j,i+1,j1,jj,kk)
5157 if (wcorr4.gt.0.0d0)
5158 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5159 if (wcorr5.gt.0.0d0)
5160 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5161 c print *,"wcorr5",ecorr5
5162 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5163 cd write(2,*)'ijkl',i,j,i+1,j1
5164 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5165 & .or. wturn6.eq.0.0d0))then
5166 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5167 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5168 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5169 cd & 'ecorr6=',ecorr6
5170 cd write (iout,'(4e15.5)') sred_geom,
5171 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5172 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5173 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5174 else if (wturn6.gt.0.0d0
5175 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5176 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5177 eturn6=eturn6+eello_turn6(i,jj,kk)
5178 cd write (2,*) 'multibody_eello:eturn6',eturn6
5182 else if (j1.eq.j) then
5183 C Contacts I-J and I-(J+1) occur simultaneously.
5184 C The system loses extra energy.
5185 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5190 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5191 c & ' jj=',jj,' kk=',kk
5193 C Contacts I-J and (I+1)-J occur simultaneously.
5194 C The system loses extra energy.
5195 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5202 c------------------------------------------------------------------------------
5203 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5204 implicit real*8 (a-h,o-z)
5205 include 'DIMENSIONS'
5206 include 'COMMON.IOUNITS'
5207 include 'COMMON.DERIV'
5208 include 'COMMON.INTERACT'
5209 include 'COMMON.CONTACTS'
5210 double precision gx(3),gx1(3)
5220 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5221 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5222 C Following 4 lines for diagnostics.
5227 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5229 c write (iout,*)'Contacts have occurred for peptide groups',
5230 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5231 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5232 C Calculate the multi-body contribution to energy.
5233 ecorr=ecorr+ekont*ees
5235 C Calculate multi-body contributions to the gradient.
5237 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5238 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5239 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5240 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5241 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5242 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5243 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5244 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5245 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5246 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5247 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5248 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5249 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5250 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5254 gradcorr(ll,m)=gradcorr(ll,m)+
5255 & ees*ekl*gacont_hbr(ll,jj,i)-
5256 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5257 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5262 gradcorr(ll,m)=gradcorr(ll,m)+
5263 & ees*eij*gacont_hbr(ll,kk,k)-
5264 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5265 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5272 C---------------------------------------------------------------------------
5273 subroutine dipole(i,j,jj)
5274 implicit real*8 (a-h,o-z)
5275 include 'DIMENSIONS'
5276 include 'sizesclu.dat'
5277 include 'COMMON.IOUNITS'
5278 include 'COMMON.CHAIN'
5279 include 'COMMON.FFIELD'
5280 include 'COMMON.DERIV'
5281 include 'COMMON.INTERACT'
5282 include 'COMMON.CONTACTS'
5283 include 'COMMON.TORSION'
5284 include 'COMMON.VAR'
5285 include 'COMMON.GEO'
5286 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5288 iti1 = itortyp(itype(i+1))
5289 if (j.lt.nres-1) then
5290 if (itype(j).le.ntyp) then
5291 itj1 = itortyp(itype(j+1))
5299 dipi(iii,1)=Ub2(iii,i)
5300 dipderi(iii)=Ub2der(iii,i)
5301 dipi(iii,2)=b1(iii,iti1)
5302 dipj(iii,1)=Ub2(iii,j)
5303 dipderj(iii)=Ub2der(iii,j)
5304 dipj(iii,2)=b1(iii,itj1)
5308 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5311 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5314 if (.not.calc_grad) return
5319 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5323 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5328 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5329 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5331 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5333 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5335 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5339 C---------------------------------------------------------------------------
5340 subroutine calc_eello(i,j,k,l,jj,kk)
5342 C This subroutine computes matrices and vectors needed to calculate
5343 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5345 implicit real*8 (a-h,o-z)
5346 include 'DIMENSIONS'
5347 include 'sizesclu.dat'
5348 include 'COMMON.IOUNITS'
5349 include 'COMMON.CHAIN'
5350 include 'COMMON.DERIV'
5351 include 'COMMON.INTERACT'
5352 include 'COMMON.CONTACTS'
5353 include 'COMMON.TORSION'
5354 include 'COMMON.VAR'
5355 include 'COMMON.GEO'
5356 include 'COMMON.FFIELD'
5357 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5358 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5361 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5362 cd & ' jj=',jj,' kk=',kk
5363 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5366 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5367 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5370 call transpose2(aa1(1,1),aa1t(1,1))
5371 call transpose2(aa2(1,1),aa2t(1,1))
5374 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5375 & aa1tder(1,1,lll,kkk))
5376 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5377 & aa2tder(1,1,lll,kkk))
5381 C parallel orientation of the two CA-CA-CA frames.
5383 if (i.gt.1 .and. itype(i).le.ntyp) then
5384 iti=itortyp(itype(i))
5388 itk1=itortyp(itype(k+1))
5389 itj=itortyp(itype(j))
5390 c if (l.lt.nres-1) then
5391 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5392 itl1=itortyp(itype(l+1))
5396 C A1 kernel(j+1) A2T
5398 cd write (iout,'(3f10.5,5x,3f10.5)')
5399 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5401 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5402 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5403 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5404 C Following matrices are needed only for 6-th order cumulants
5405 IF (wcorr6.gt.0.0d0) THEN
5406 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5407 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5408 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5409 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5410 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5411 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5412 & ADtEAderx(1,1,1,1,1,1))
5414 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5415 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5416 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5417 & ADtEA1derx(1,1,1,1,1,1))
5419 C End 6-th order cumulants
5422 cd write (2,*) 'In calc_eello6'
5424 cd write (2,*) 'iii=',iii
5426 cd write (2,*) 'kkk=',kkk
5428 cd write (2,'(3(2f10.5),5x)')
5429 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5434 call transpose2(EUgder(1,1,k),auxmat(1,1))
5435 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5436 call transpose2(EUg(1,1,k),auxmat(1,1))
5437 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5438 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5442 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5443 & EAEAderx(1,1,lll,kkk,iii,1))
5447 C A1T kernel(i+1) A2
5448 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5449 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5450 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5451 C Following matrices are needed only for 6-th order cumulants
5452 IF (wcorr6.gt.0.0d0) THEN
5453 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5454 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5455 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5456 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5457 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5458 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5459 & ADtEAderx(1,1,1,1,1,2))
5460 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5461 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5462 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5463 & ADtEA1derx(1,1,1,1,1,2))
5465 C End 6-th order cumulants
5466 call transpose2(EUgder(1,1,l),auxmat(1,1))
5467 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5468 call transpose2(EUg(1,1,l),auxmat(1,1))
5469 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5470 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5474 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5475 & EAEAderx(1,1,lll,kkk,iii,2))
5480 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5481 C They are needed only when the fifth- or the sixth-order cumulants are
5483 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5484 call transpose2(AEA(1,1,1),auxmat(1,1))
5485 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5486 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5487 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5488 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5489 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5490 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5491 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5492 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5493 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5494 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5495 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5496 call transpose2(AEA(1,1,2),auxmat(1,1))
5497 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5498 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5499 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5500 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5501 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5502 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5503 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5504 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5505 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5506 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5507 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5508 C Calculate the Cartesian derivatives of the vectors.
5512 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5513 call matvec2(auxmat(1,1),b1(1,iti),
5514 & AEAb1derx(1,lll,kkk,iii,1,1))
5515 call matvec2(auxmat(1,1),Ub2(1,i),
5516 & AEAb2derx(1,lll,kkk,iii,1,1))
5517 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5518 & AEAb1derx(1,lll,kkk,iii,2,1))
5519 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5520 & AEAb2derx(1,lll,kkk,iii,2,1))
5521 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5522 call matvec2(auxmat(1,1),b1(1,itj),
5523 & AEAb1derx(1,lll,kkk,iii,1,2))
5524 call matvec2(auxmat(1,1),Ub2(1,j),
5525 & AEAb2derx(1,lll,kkk,iii,1,2))
5526 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5527 & AEAb1derx(1,lll,kkk,iii,2,2))
5528 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5529 & AEAb2derx(1,lll,kkk,iii,2,2))
5536 C Antiparallel orientation of the two CA-CA-CA frames.
5538 if (i.gt.1 .and. itype(i).le.ntyp) then
5539 iti=itortyp(itype(i))
5543 itk1=itortyp(itype(k+1))
5544 itl=itortyp(itype(l))
5545 itj=itortyp(itype(j))
5546 c if (j.lt.nres-1) then
5547 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5548 itj1=itortyp(itype(j+1))
5552 C A2 kernel(j-1)T A1T
5553 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5554 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5555 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5556 C Following matrices are needed only for 6-th order cumulants
5557 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5558 & j.eq.i+4 .and. l.eq.i+3)) THEN
5559 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5560 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5561 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5562 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5563 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5564 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5565 & ADtEAderx(1,1,1,1,1,1))
5566 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5567 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5568 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5569 & ADtEA1derx(1,1,1,1,1,1))
5571 C End 6-th order cumulants
5572 call transpose2(EUgder(1,1,k),auxmat(1,1))
5573 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5574 call transpose2(EUg(1,1,k),auxmat(1,1))
5575 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5576 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5580 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5581 & EAEAderx(1,1,lll,kkk,iii,1))
5585 C A2T kernel(i+1)T A1
5586 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5587 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5588 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5589 C Following matrices are needed only for 6-th order cumulants
5590 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5591 & j.eq.i+4 .and. l.eq.i+3)) THEN
5592 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5593 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5594 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5595 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5597 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5598 & ADtEAderx(1,1,1,1,1,2))
5599 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5600 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5601 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5602 & ADtEA1derx(1,1,1,1,1,2))
5604 C End 6-th order cumulants
5605 call transpose2(EUgder(1,1,j),auxmat(1,1))
5606 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5607 call transpose2(EUg(1,1,j),auxmat(1,1))
5608 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5609 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5613 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5614 & EAEAderx(1,1,lll,kkk,iii,2))
5619 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5620 C They are needed only when the fifth- or the sixth-order cumulants are
5622 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5623 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5624 call transpose2(AEA(1,1,1),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5627 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5628 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5629 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5630 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5631 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5632 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5633 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5634 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5635 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5636 call transpose2(AEA(1,1,2),auxmat(1,1))
5637 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5639 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5640 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5641 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5642 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5643 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5644 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5645 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5646 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5647 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5648 C Calculate the Cartesian derivatives of the vectors.
5652 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5653 call matvec2(auxmat(1,1),b1(1,iti),
5654 & AEAb1derx(1,lll,kkk,iii,1,1))
5655 call matvec2(auxmat(1,1),Ub2(1,i),
5656 & AEAb2derx(1,lll,kkk,iii,1,1))
5657 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5658 & AEAb1derx(1,lll,kkk,iii,2,1))
5659 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5660 & AEAb2derx(1,lll,kkk,iii,2,1))
5661 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5662 call matvec2(auxmat(1,1),b1(1,itl),
5663 & AEAb1derx(1,lll,kkk,iii,1,2))
5664 call matvec2(auxmat(1,1),Ub2(1,l),
5665 & AEAb2derx(1,lll,kkk,iii,1,2))
5666 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5667 & AEAb1derx(1,lll,kkk,iii,2,2))
5668 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5669 & AEAb2derx(1,lll,kkk,iii,2,2))
5678 C---------------------------------------------------------------------------
5679 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5680 & KK,KKderg,AKA,AKAderg,AKAderx)
5684 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5685 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5686 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5691 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5693 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5696 cd if (lprn) write (2,*) 'In kernel'
5698 cd if (lprn) write (2,*) 'kkk=',kkk
5700 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5701 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5703 cd write (2,*) 'lll=',lll
5704 cd write (2,*) 'iii=1'
5706 cd write (2,'(3(2f10.5),5x)')
5707 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5710 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5711 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5713 cd write (2,*) 'lll=',lll
5714 cd write (2,*) 'iii=2'
5716 cd write (2,'(3(2f10.5),5x)')
5717 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5724 C---------------------------------------------------------------------------
5725 double precision function eello4(i,j,k,l,jj,kk)
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'sizesclu.dat'
5729 include 'COMMON.IOUNITS'
5730 include 'COMMON.CHAIN'
5731 include 'COMMON.DERIV'
5732 include 'COMMON.INTERACT'
5733 include 'COMMON.CONTACTS'
5734 include 'COMMON.TORSION'
5735 include 'COMMON.VAR'
5736 include 'COMMON.GEO'
5737 double precision pizda(2,2),ggg1(3),ggg2(3)
5738 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5742 cd print *,'eello4:',i,j,k,l,jj,kk
5743 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5744 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5745 cold eij=facont_hb(jj,i)
5746 cold ekl=facont_hb(kk,k)
5748 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5750 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5751 gcorr_loc(k-1)=gcorr_loc(k-1)
5752 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5754 gcorr_loc(l-1)=gcorr_loc(l-1)
5755 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5757 gcorr_loc(j-1)=gcorr_loc(j-1)
5758 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5763 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5764 & -EAEAderx(2,2,lll,kkk,iii,1)
5765 cd derx(lll,kkk,iii)=0.0d0
5769 cd gcorr_loc(l-1)=0.0d0
5770 cd gcorr_loc(j-1)=0.0d0
5771 cd gcorr_loc(k-1)=0.0d0
5773 cd write (iout,*)'Contacts have occurred for peptide groups',
5774 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5775 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5776 if (j.lt.nres-1) then
5783 if (l.lt.nres-1) then
5791 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5792 ggg1(ll)=eel4*g_contij(ll,1)
5793 ggg2(ll)=eel4*g_contij(ll,2)
5794 ghalf=0.5d0*ggg1(ll)
5796 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5797 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5798 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5799 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5800 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5801 ghalf=0.5d0*ggg2(ll)
5803 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5804 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5805 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5806 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5811 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5812 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5817 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5818 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5824 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5829 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5833 cd write (2,*) iii,gcorr_loc(iii)
5837 cd write (2,*) 'ekont',ekont
5838 cd write (iout,*) 'eello4',ekont*eel4
5841 C---------------------------------------------------------------------------
5842 double precision function eello5(i,j,k,l,jj,kk)
5843 implicit real*8 (a-h,o-z)
5844 include 'DIMENSIONS'
5845 include 'sizesclu.dat'
5846 include 'COMMON.IOUNITS'
5847 include 'COMMON.CHAIN'
5848 include 'COMMON.DERIV'
5849 include 'COMMON.INTERACT'
5850 include 'COMMON.CONTACTS'
5851 include 'COMMON.TORSION'
5852 include 'COMMON.VAR'
5853 include 'COMMON.GEO'
5854 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5855 double precision ggg1(3),ggg2(3)
5856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5861 C /l\ / \ \ / \ / \ / C
5862 C / \ / \ \ / \ / \ / C
5863 C j| o |l1 | o | o| o | | o |o C
5864 C \ |/k\| |/ \| / |/ \| |/ \| C
5865 C \i/ \ / \ / / \ / \ C
5867 C (I) (II) (III) (IV) C
5869 C eello5_1 eello5_2 eello5_3 eello5_4 C
5871 C Antiparallel chains C
5874 C /j\ / \ \ / \ / \ / C
5875 C / \ / \ \ / \ / \ / C
5876 C j1| o |l | o | o| o | | o |o C
5877 C \ |/k\| |/ \| / |/ \| |/ \| C
5878 C \i/ \ / \ / / \ / \ C
5880 C (I) (II) (III) (IV) C
5882 C eello5_1 eello5_2 eello5_3 eello5_4 C
5884 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5886 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5887 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5892 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5894 itk=itortyp(itype(k))
5895 itl=itortyp(itype(l))
5896 itj=itortyp(itype(j))
5901 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5902 cd & eel5_3_num,eel5_4_num)
5906 derx(lll,kkk,iii)=0.0d0
5910 cd eij=facont_hb(jj,i)
5911 cd ekl=facont_hb(kk,k)
5913 cd write (iout,*)'Contacts have occurred for peptide groups',
5914 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5916 C Contribution from the graph I.
5917 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5918 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5919 call transpose2(EUg(1,1,k),auxmat(1,1))
5920 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5921 vv(1)=pizda(1,1)-pizda(2,2)
5922 vv(2)=pizda(1,2)+pizda(2,1)
5923 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5926 C Explicit gradient in virtual-dihedral angles.
5927 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5928 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5929 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5930 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5931 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5932 vv(1)=pizda(1,1)-pizda(2,2)
5933 vv(2)=pizda(1,2)+pizda(2,1)
5934 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5935 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5936 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5937 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5938 vv(1)=pizda(1,1)-pizda(2,2)
5939 vv(2)=pizda(1,2)+pizda(2,1)
5941 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5942 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5945 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5946 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5947 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5949 C Cartesian gradient
5953 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5955 vv(1)=pizda(1,1)-pizda(2,2)
5956 vv(2)=pizda(1,2)+pizda(2,1)
5957 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5958 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5959 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5966 C Contribution from graph II
5967 call transpose2(EE(1,1,itk),auxmat(1,1))
5968 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5969 vv(1)=pizda(1,1)+pizda(2,2)
5970 vv(2)=pizda(2,1)-pizda(1,2)
5971 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5972 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5974 C Explicit gradient in virtual-dihedral angles.
5975 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5976 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5977 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5978 vv(1)=pizda(1,1)+pizda(2,2)
5979 vv(2)=pizda(2,1)-pizda(1,2)
5981 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5982 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5983 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5985 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5986 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5987 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5989 C Cartesian gradient
5993 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5995 vv(1)=pizda(1,1)+pizda(2,2)
5996 vv(2)=pizda(2,1)-pizda(1,2)
5997 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5998 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5999 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6008 C Parallel orientation
6009 C Contribution from graph III
6010 call transpose2(EUg(1,1,l),auxmat(1,1))
6011 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6012 vv(1)=pizda(1,1)-pizda(2,2)
6013 vv(2)=pizda(1,2)+pizda(2,1)
6014 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6015 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6017 C Explicit gradient in virtual-dihedral angles.
6018 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6019 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6020 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6021 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6022 vv(1)=pizda(1,1)-pizda(2,2)
6023 vv(2)=pizda(1,2)+pizda(2,1)
6024 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6025 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6026 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6027 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6028 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6029 vv(1)=pizda(1,1)-pizda(2,2)
6030 vv(2)=pizda(1,2)+pizda(2,1)
6031 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6032 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6033 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6034 C Cartesian gradient
6038 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6040 vv(1)=pizda(1,1)-pizda(2,2)
6041 vv(2)=pizda(1,2)+pizda(2,1)
6042 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6043 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6044 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6050 C Contribution from graph IV
6052 call transpose2(EE(1,1,itl),auxmat(1,1))
6053 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6054 vv(1)=pizda(1,1)+pizda(2,2)
6055 vv(2)=pizda(2,1)-pizda(1,2)
6056 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6057 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6059 C Explicit gradient in virtual-dihedral angles.
6060 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6061 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6062 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6063 vv(1)=pizda(1,1)+pizda(2,2)
6064 vv(2)=pizda(2,1)-pizda(1,2)
6065 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6066 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6067 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6068 C Cartesian gradient
6072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6074 vv(1)=pizda(1,1)+pizda(2,2)
6075 vv(2)=pizda(2,1)-pizda(1,2)
6076 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6077 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6078 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6084 C Antiparallel orientation
6085 C Contribution from graph III
6087 call transpose2(EUg(1,1,j),auxmat(1,1))
6088 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6089 vv(1)=pizda(1,1)-pizda(2,2)
6090 vv(2)=pizda(1,2)+pizda(2,1)
6091 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6092 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6094 C Explicit gradient in virtual-dihedral angles.
6095 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6096 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6097 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6098 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6099 vv(1)=pizda(1,1)-pizda(2,2)
6100 vv(2)=pizda(1,2)+pizda(2,1)
6101 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6102 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6103 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6104 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6105 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6106 vv(1)=pizda(1,1)-pizda(2,2)
6107 vv(2)=pizda(1,2)+pizda(2,1)
6108 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6109 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6110 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6111 C Cartesian gradient
6115 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6117 vv(1)=pizda(1,1)-pizda(2,2)
6118 vv(2)=pizda(1,2)+pizda(2,1)
6119 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6120 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6121 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6127 C Contribution from graph IV
6129 call transpose2(EE(1,1,itj),auxmat(1,1))
6130 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6131 vv(1)=pizda(1,1)+pizda(2,2)
6132 vv(2)=pizda(2,1)-pizda(1,2)
6133 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6134 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6136 C Explicit gradient in virtual-dihedral angles.
6137 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6138 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6139 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6140 vv(1)=pizda(1,1)+pizda(2,2)
6141 vv(2)=pizda(2,1)-pizda(1,2)
6142 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6143 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6144 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6145 C Cartesian gradient
6149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6151 vv(1)=pizda(1,1)+pizda(2,2)
6152 vv(2)=pizda(2,1)-pizda(1,2)
6153 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6154 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6155 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6162 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6163 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6164 cd write (2,*) 'ijkl',i,j,k,l
6165 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6166 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6168 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6169 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6170 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6171 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6173 if (j.lt.nres-1) then
6180 if (l.lt.nres-1) then
6190 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6192 ggg1(ll)=eel5*g_contij(ll,1)
6193 ggg2(ll)=eel5*g_contij(ll,2)
6194 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6195 ghalf=0.5d0*ggg1(ll)
6197 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6198 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6199 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6200 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6201 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6202 ghalf=0.5d0*ggg2(ll)
6204 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6205 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6206 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6207 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6212 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6213 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6218 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6219 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6225 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6230 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6234 cd write (2,*) iii,g_corr5_loc(iii)
6238 cd write (2,*) 'ekont',ekont
6239 cd write (iout,*) 'eello5',ekont*eel5
6242 c--------------------------------------------------------------------------
6243 double precision function eello6(i,j,k,l,jj,kk)
6244 implicit real*8 (a-h,o-z)
6245 include 'DIMENSIONS'
6246 include 'sizesclu.dat'
6247 include 'COMMON.IOUNITS'
6248 include 'COMMON.CHAIN'
6249 include 'COMMON.DERIV'
6250 include 'COMMON.INTERACT'
6251 include 'COMMON.CONTACTS'
6252 include 'COMMON.TORSION'
6253 include 'COMMON.VAR'
6254 include 'COMMON.GEO'
6255 include 'COMMON.FFIELD'
6256 double precision ggg1(3),ggg2(3)
6257 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6262 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6270 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6271 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6275 derx(lll,kkk,iii)=0.0d0
6279 cd eij=facont_hb(jj,i)
6280 cd ekl=facont_hb(kk,k)
6286 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6287 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6288 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6289 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6290 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6291 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6293 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6294 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6295 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6296 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6297 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6298 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6302 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6304 C If turn contributions are considered, they will be handled separately.
6305 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6306 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6307 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6308 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6309 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6310 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6311 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6314 if (j.lt.nres-1) then
6321 if (l.lt.nres-1) then
6329 ggg1(ll)=eel6*g_contij(ll,1)
6330 ggg2(ll)=eel6*g_contij(ll,2)
6331 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6332 ghalf=0.5d0*ggg1(ll)
6334 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6335 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6336 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6337 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6338 ghalf=0.5d0*ggg2(ll)
6339 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6341 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6342 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6343 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6344 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6349 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6350 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6355 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6356 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6362 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6367 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6371 cd write (2,*) iii,g_corr6_loc(iii)
6375 cd write (2,*) 'ekont',ekont
6376 cd write (iout,*) 'eello6',ekont*eel6
6379 c--------------------------------------------------------------------------
6380 double precision function eello6_graph1(i,j,k,l,imat,swap)
6381 implicit real*8 (a-h,o-z)
6382 include 'DIMENSIONS'
6383 include 'sizesclu.dat'
6384 include 'COMMON.IOUNITS'
6385 include 'COMMON.CHAIN'
6386 include 'COMMON.DERIV'
6387 include 'COMMON.INTERACT'
6388 include 'COMMON.CONTACTS'
6389 include 'COMMON.TORSION'
6390 include 'COMMON.VAR'
6391 include 'COMMON.GEO'
6392 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6396 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6398 C Parallel Antiparallel C
6404 C \ j|/k\| / \ |/k\|l / C
6409 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6410 itk=itortyp(itype(k))
6411 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6412 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6413 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6414 call transpose2(EUgC(1,1,k),auxmat(1,1))
6415 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6416 vv1(1)=pizda1(1,1)-pizda1(2,2)
6417 vv1(2)=pizda1(1,2)+pizda1(2,1)
6418 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6419 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6420 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6421 s5=scalar2(vv(1),Dtobr2(1,i))
6422 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6423 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6424 if (.not. calc_grad) return
6425 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6426 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6427 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6428 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6429 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6430 & +scalar2(vv(1),Dtobr2der(1,i)))
6431 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6432 vv1(1)=pizda1(1,1)-pizda1(2,2)
6433 vv1(2)=pizda1(1,2)+pizda1(2,1)
6434 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6435 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6437 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6438 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6439 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6440 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6441 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6443 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6444 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6445 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6446 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6447 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6449 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6450 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6451 vv1(1)=pizda1(1,1)-pizda1(2,2)
6452 vv1(2)=pizda1(1,2)+pizda1(2,1)
6453 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6454 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6455 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6456 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6465 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6466 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6467 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6468 call transpose2(EUgC(1,1,k),auxmat(1,1))
6469 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6471 vv1(1)=pizda1(1,1)-pizda1(2,2)
6472 vv1(2)=pizda1(1,2)+pizda1(2,1)
6473 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6474 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6475 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6476 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6477 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6478 s5=scalar2(vv(1),Dtobr2(1,i))
6479 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6485 c----------------------------------------------------------------------------
6486 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6487 implicit real*8 (a-h,o-z)
6488 include 'DIMENSIONS'
6489 include 'sizesclu.dat'
6490 include 'COMMON.IOUNITS'
6491 include 'COMMON.CHAIN'
6492 include 'COMMON.DERIV'
6493 include 'COMMON.INTERACT'
6494 include 'COMMON.CONTACTS'
6495 include 'COMMON.TORSION'
6496 include 'COMMON.VAR'
6497 include 'COMMON.GEO'
6499 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6500 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6503 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6505 C Parallel Antiparallel C
6511 C \ j|/k\| \ |/k\|l C
6516 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6517 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6518 C AL 7/4/01 s1 would occur in the sixth-order moment,
6519 C but not in a cluster cumulant
6521 s1=dip(1,jj,i)*dip(1,kk,k)
6523 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6524 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6525 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6526 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6527 call transpose2(EUg(1,1,k),auxmat(1,1))
6528 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6529 vv(1)=pizda(1,1)-pizda(2,2)
6530 vv(2)=pizda(1,2)+pizda(2,1)
6531 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6532 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6534 eello6_graph2=-(s1+s2+s3+s4)
6536 eello6_graph2=-(s2+s3+s4)
6539 if (.not. calc_grad) return
6540 C Derivatives in gamma(i-1)
6543 s1=dipderg(1,jj,i)*dip(1,kk,k)
6545 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6546 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6547 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6548 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6550 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6552 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6554 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6556 C Derivatives in gamma(k-1)
6558 s1=dip(1,jj,i)*dipderg(1,kk,k)
6560 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6561 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6562 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6563 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6564 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6565 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6566 vv(1)=pizda(1,1)-pizda(2,2)
6567 vv(2)=pizda(1,2)+pizda(2,1)
6568 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6570 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6572 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6574 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6575 C Derivatives in gamma(j-1) or gamma(l-1)
6578 s1=dipderg(3,jj,i)*dip(1,kk,k)
6580 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6581 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6582 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6583 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6584 vv(1)=pizda(1,1)-pizda(2,2)
6585 vv(2)=pizda(1,2)+pizda(2,1)
6586 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6589 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6591 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6594 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6595 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6597 C Derivatives in gamma(l-1) or gamma(j-1)
6600 s1=dip(1,jj,i)*dipderg(3,kk,k)
6602 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6603 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6604 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6605 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6606 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6607 vv(1)=pizda(1,1)-pizda(2,2)
6608 vv(2)=pizda(1,2)+pizda(2,1)
6609 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6612 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6614 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6617 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6618 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6620 C Cartesian derivatives.
6622 write (2,*) 'In eello6_graph2'
6624 write (2,*) 'iii=',iii
6626 write (2,*) 'kkk=',kkk
6628 write (2,'(3(2f10.5),5x)')
6629 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6639 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6641 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6644 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6646 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6647 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6649 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6650 call transpose2(EUg(1,1,k),auxmat(1,1))
6651 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6653 vv(1)=pizda(1,1)-pizda(2,2)
6654 vv(2)=pizda(1,2)+pizda(2,1)
6655 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6656 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6658 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6660 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6663 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6665 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6672 c----------------------------------------------------------------------------
6673 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6674 implicit real*8 (a-h,o-z)
6675 include 'DIMENSIONS'
6676 include 'sizesclu.dat'
6677 include 'COMMON.IOUNITS'
6678 include 'COMMON.CHAIN'
6679 include 'COMMON.DERIV'
6680 include 'COMMON.INTERACT'
6681 include 'COMMON.CONTACTS'
6682 include 'COMMON.TORSION'
6683 include 'COMMON.VAR'
6684 include 'COMMON.GEO'
6685 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6687 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6689 C Parallel Antiparallel C
6695 C j|/k\| / |/k\|l / C
6700 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6702 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6703 C energy moment and not to the cluster cumulant.
6704 iti=itortyp(itype(i))
6705 c if (j.lt.nres-1) then
6706 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6707 itj1=itortyp(itype(j+1))
6711 itk=itortyp(itype(k))
6712 itk1=itortyp(itype(k+1))
6713 c if (l.lt.nres-1) then
6714 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6715 itl1=itortyp(itype(l+1))
6720 s1=dip(4,jj,i)*dip(4,kk,k)
6722 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6723 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6724 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6725 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6726 call transpose2(EE(1,1,itk),auxmat(1,1))
6727 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6728 vv(1)=pizda(1,1)+pizda(2,2)
6729 vv(2)=pizda(2,1)-pizda(1,2)
6730 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6731 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6733 eello6_graph3=-(s1+s2+s3+s4)
6735 eello6_graph3=-(s2+s3+s4)
6738 if (.not. calc_grad) return
6739 C Derivatives in gamma(k-1)
6740 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6741 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6742 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6743 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6744 C Derivatives in gamma(l-1)
6745 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6746 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6747 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6748 vv(1)=pizda(1,1)+pizda(2,2)
6749 vv(2)=pizda(2,1)-pizda(1,2)
6750 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6751 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6752 C Cartesian derivatives.
6758 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6760 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6763 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6765 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6766 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6768 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6769 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6771 vv(1)=pizda(1,1)+pizda(2,2)
6772 vv(2)=pizda(2,1)-pizda(1,2)
6773 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6775 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6777 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6780 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6782 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6784 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6790 c----------------------------------------------------------------------------
6791 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6792 implicit real*8 (a-h,o-z)
6793 include 'DIMENSIONS'
6794 include 'sizesclu.dat'
6795 include 'COMMON.IOUNITS'
6796 include 'COMMON.CHAIN'
6797 include 'COMMON.DERIV'
6798 include 'COMMON.INTERACT'
6799 include 'COMMON.CONTACTS'
6800 include 'COMMON.TORSION'
6801 include 'COMMON.VAR'
6802 include 'COMMON.GEO'
6803 include 'COMMON.FFIELD'
6804 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6805 & auxvec1(2),auxmat1(2,2)
6807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6809 C Parallel Antiparallel C
6815 C \ j|/k\| \ |/k\|l C
6820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6822 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6823 C energy moment and not to the cluster cumulant.
6824 cd write (2,*) 'eello_graph4: wturn6',wturn6
6825 iti=itortyp(itype(i))
6826 itj=itortyp(itype(j))
6827 c if (j.lt.nres-1) then
6828 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6829 itj1=itortyp(itype(j+1))
6833 itk=itortyp(itype(k))
6834 c if (k.lt.nres-1) then
6835 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6836 itk1=itortyp(itype(k+1))
6840 itl=itortyp(itype(l))
6841 if (l.lt.nres-1) then
6842 itl1=itortyp(itype(l+1))
6846 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6847 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6848 cd & ' itl',itl,' itl1',itl1
6851 s1=dip(3,jj,i)*dip(3,kk,k)
6853 s1=dip(2,jj,j)*dip(2,kk,l)
6856 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6857 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6859 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6860 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6862 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6863 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6865 call transpose2(EUg(1,1,k),auxmat(1,1))
6866 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6867 vv(1)=pizda(1,1)-pizda(2,2)
6868 vv(2)=pizda(2,1)+pizda(1,2)
6869 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6870 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6872 eello6_graph4=-(s1+s2+s3+s4)
6874 eello6_graph4=-(s2+s3+s4)
6876 if (.not. calc_grad) return
6877 C Derivatives in gamma(i-1)
6881 s1=dipderg(2,jj,i)*dip(3,kk,k)
6883 s1=dipderg(4,jj,j)*dip(2,kk,l)
6886 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6888 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6889 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6891 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6892 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6894 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6895 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6896 cd write (2,*) 'turn6 derivatives'
6898 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6900 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6904 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6906 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6910 C Derivatives in gamma(k-1)
6913 s1=dip(3,jj,i)*dipderg(2,kk,k)
6915 s1=dip(2,jj,j)*dipderg(4,kk,l)
6918 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6919 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6921 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6922 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6924 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6925 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6927 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6928 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6929 vv(1)=pizda(1,1)-pizda(2,2)
6930 vv(2)=pizda(2,1)+pizda(1,2)
6931 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6932 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6934 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6936 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6940 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6942 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6945 C Derivatives in gamma(j-1) or gamma(l-1)
6946 if (l.eq.j+1 .and. l.gt.1) then
6947 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6948 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6949 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6950 vv(1)=pizda(1,1)-pizda(2,2)
6951 vv(2)=pizda(2,1)+pizda(1,2)
6952 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6953 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6954 else if (j.gt.1) then
6955 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6956 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6957 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6958 vv(1)=pizda(1,1)-pizda(2,2)
6959 vv(2)=pizda(2,1)+pizda(1,2)
6960 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6961 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6962 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6964 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6967 C Cartesian derivatives.
6974 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6976 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6980 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6982 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6986 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6988 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6990 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6991 & b1(1,itj1),auxvec(1))
6992 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6994 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6995 & b1(1,itl1),auxvec(1))
6996 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6998 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7000 vv(1)=pizda(1,1)-pizda(2,2)
7001 vv(2)=pizda(2,1)+pizda(1,2)
7002 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7004 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7006 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7009 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7012 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7015 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7017 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7019 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7023 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7025 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7028 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7030 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7038 c----------------------------------------------------------------------------
7039 double precision function eello_turn6(i,jj,kk)
7040 implicit real*8 (a-h,o-z)
7041 include 'DIMENSIONS'
7042 include 'sizesclu.dat'
7043 include 'COMMON.IOUNITS'
7044 include 'COMMON.CHAIN'
7045 include 'COMMON.DERIV'
7046 include 'COMMON.INTERACT'
7047 include 'COMMON.CONTACTS'
7048 include 'COMMON.TORSION'
7049 include 'COMMON.VAR'
7050 include 'COMMON.GEO'
7051 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7052 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7054 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7055 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7056 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7057 C the respective energy moment and not to the cluster cumulant.
7062 iti=itortyp(itype(i))
7063 itk=itortyp(itype(k))
7064 itk1=itortyp(itype(k+1))
7065 itl=itortyp(itype(l))
7066 itj=itortyp(itype(j))
7067 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7068 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7069 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7074 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7076 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7080 derx_turn(lll,kkk,iii)=0.0d0
7087 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7089 cd write (2,*) 'eello6_5',eello6_5
7091 call transpose2(AEA(1,1,1),auxmat(1,1))
7092 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7093 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7094 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7098 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7099 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7100 s2 = scalar2(b1(1,itk),vtemp1(1))
7102 call transpose2(AEA(1,1,2),atemp(1,1))
7103 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7104 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7105 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7109 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7110 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7111 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7113 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7114 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7115 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7116 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7117 ss13 = scalar2(b1(1,itk),vtemp4(1))
7118 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7122 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7128 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7130 C Derivatives in gamma(i+2)
7132 call transpose2(AEA(1,1,1),auxmatd(1,1))
7133 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7134 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7135 call transpose2(AEAderg(1,1,2),atempd(1,1))
7136 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7137 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7141 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7142 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7143 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7149 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7150 C Derivatives in gamma(i+3)
7152 call transpose2(AEA(1,1,1),auxmatd(1,1))
7153 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7154 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7155 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7159 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7160 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7161 s2d = scalar2(b1(1,itk),vtemp1d(1))
7163 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7164 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7166 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7168 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7169 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7170 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7180 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7181 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7183 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7184 & -0.5d0*ekont*(s2d+s12d)
7186 C Derivatives in gamma(i+4)
7187 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7188 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7189 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7191 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7192 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7193 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7203 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7205 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7207 C Derivatives in gamma(i+5)
7209 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7210 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7211 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7215 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7216 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7217 s2d = scalar2(b1(1,itk),vtemp1d(1))
7219 call transpose2(AEA(1,1,2),atempd(1,1))
7220 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7221 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7225 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7226 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7228 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7229 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7230 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7240 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7241 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7243 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7244 & -0.5d0*ekont*(s2d+s12d)
7246 C Cartesian derivatives
7251 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7252 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7253 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7257 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7258 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7260 s2d = scalar2(b1(1,itk),vtemp1d(1))
7262 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7263 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7264 s8d = -(atempd(1,1)+atempd(2,2))*
7265 & scalar2(cc(1,1,itl),vtemp2(1))
7269 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7271 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7272 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7279 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7282 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7286 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7287 & - 0.5d0*(s8d+s12d)
7289 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7298 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7300 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7301 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7302 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7303 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7304 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7306 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7307 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7308 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7312 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7313 cd & 16*eel_turn6_num
7315 if (j.lt.nres-1) then
7322 if (l.lt.nres-1) then
7330 ggg1(ll)=eel_turn6*g_contij(ll,1)
7331 ggg2(ll)=eel_turn6*g_contij(ll,2)
7332 ghalf=0.5d0*ggg1(ll)
7334 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7335 & +ekont*derx_turn(ll,2,1)
7336 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7337 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7338 & +ekont*derx_turn(ll,4,1)
7339 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7340 ghalf=0.5d0*ggg2(ll)
7342 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7343 & +ekont*derx_turn(ll,2,2)
7344 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7345 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7346 & +ekont*derx_turn(ll,4,2)
7347 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7352 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7357 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7363 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7368 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7372 cd write (2,*) iii,g_corr6_loc(iii)
7375 eello_turn6=ekont*eel_turn6
7376 cd write (2,*) 'ekont',ekont
7377 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7380 crc-------------------------------------------------
7381 SUBROUTINE MATVEC2(A1,V1,V2)
7382 implicit real*8 (a-h,o-z)
7383 include 'DIMENSIONS'
7384 DIMENSION A1(2,2),V1(2),V2(2)
7388 c 3 VI=VI+A1(I,K)*V1(K)
7392 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7393 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7398 C---------------------------------------
7399 SUBROUTINE MATMAT2(A1,A2,A3)
7400 implicit real*8 (a-h,o-z)
7401 include 'DIMENSIONS'
7402 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7403 c DIMENSION AI3(2,2)
7407 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7413 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7414 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7415 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7416 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7424 c-------------------------------------------------------------------------
7425 double precision function scalar2(u,v)
7427 double precision u(2),v(2)
7430 scalar2=u(1)*v(1)+u(2)*v(2)
7434 C-----------------------------------------------------------------------------
7436 subroutine transpose2(a,at)
7438 double precision a(2,2),at(2,2)
7445 c--------------------------------------------------------------------------
7446 subroutine transpose(n,a,at)
7449 double precision a(n,n),at(n,n)
7457 C---------------------------------------------------------------------------
7458 subroutine prodmat3(a1,a2,kk,transp,prod)
7461 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7463 crc double precision auxmat(2,2),prod_(2,2)
7466 crc call transpose2(kk(1,1),auxmat(1,1))
7467 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7468 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7470 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7471 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7472 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7473 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7474 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7475 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7476 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7477 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7480 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7481 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7483 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7484 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7485 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7486 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7487 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7488 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7489 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7490 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7493 c call transpose2(a2(1,1),a2t(1,1))
7496 crc print *,((prod_(i,j),i=1,2),j=1,2)
7497 crc print *,((prod(i,j),i=1,2),j=1,2)
7501 C-----------------------------------------------------------------------------
7502 double precision function scalar(u,v)
7504 double precision u(3),v(3)