1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
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 & +wsccor*fact(1)*gsccor_loc(i)
236 C------------------------------------------------------------------------
237 subroutine enerprint(energia,fact)
238 implicit real*8 (a-h,o-z)
240 include 'DIMENSIONS.ZSCOPT'
241 include 'COMMON.IOUNITS'
242 include 'COMMON.FFIELD'
243 include 'COMMON.SBRIDGE'
244 double precision energia(0:max_ene),fact(6)
246 evdw=energia(1)+fact(6)*energia(21)
248 evdw2=energia(2)+energia(17)
260 eello_turn3=energia(8)
261 eello_turn4=energia(9)
262 eello_turn6=energia(10)
269 edihcnstr=energia(20)
272 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
274 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
275 & etors_d,wtor_d*fact(2),ehpb,wstrain,
276 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
277 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
278 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
279 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
280 10 format (/'Virtual-chain energies:'//
281 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
282 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
283 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
284 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
285 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
286 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
287 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
288 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
289 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
290 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
291 & ' (SS bridges & dist. cnstr.)'/
292 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
296 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
297 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
298 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
299 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
300 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
301 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
302 & 'ETOT= ',1pE16.6,' (total)')
304 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
305 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
306 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
307 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
308 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
309 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
310 & edihcnstr,ebr*nss,etot
311 10 format (/'Virtual-chain energies:'//
312 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
313 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
314 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
315 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
316 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
317 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
318 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
319 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
320 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
321 & ' (SS bridges & dist. cnstr.)'/
322 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
326 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
327 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
328 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
329 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
330 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
331 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
332 & 'ETOT= ',1pE16.6,' (total)')
336 C-----------------------------------------------------------------------
337 subroutine elj(evdw,evdw_t)
339 C This subroutine calculates the interaction energy of nonbonded side chains
340 C assuming the LJ potential of interaction.
342 implicit real*8 (a-h,o-z)
344 include 'DIMENSIONS.ZSCOPT'
345 include "DIMENSIONS.COMPAR"
346 parameter (accur=1.0d-10)
349 include 'COMMON.LOCAL'
350 include 'COMMON.CHAIN'
351 include 'COMMON.DERIV'
352 include 'COMMON.INTERACT'
353 include 'COMMON.TORSION'
354 include 'COMMON.ENEPS'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
365 eneps_temp(j,i)=0.0d0
379 C Calculate SC interaction energy.
382 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
383 cd & 'iend=',iend(i,iint)
384 do j=istart(i,iint),iend(i,iint)
389 C Change 12/1/95 to calculate four-body interactions
390 rij=xj*xj+yj*yj+zj*zj
392 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
393 eps0ij=eps(itypi,itypj)
395 e1=fac*fac*aa(itypi,itypj)
396 e2=fac*bb(itypi,itypj)
398 ij=icant(itypi,itypj)
399 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
400 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
401 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
402 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
403 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
404 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
405 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
406 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
407 if (bb(itypi,itypj).gt.0.0d0) then
414 C Calculate the components of the gradient in DC and X
416 fac=-rrij*(e1+evdwij)
421 gvdwx(k,i)=gvdwx(k,i)-gg(k)
422 gvdwx(k,j)=gvdwx(k,j)+gg(k)
426 gvdwc(l,k)=gvdwc(l,k)+gg(l)
431 C 12/1/95, revised on 5/20/97
433 C Calculate the contact function. The ith column of the array JCONT will
434 C contain the numbers of atoms that make contacts with the atom I (of numbers
435 C greater than I). The arrays FACONT and GACONT will contain the values of
436 C the contact function and its derivative.
438 C Uncomment next line, if the correlation interactions include EVDW explicitly.
439 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
440 C Uncomment next line, if the correlation interactions are contact function only
441 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
443 sigij=sigma(itypi,itypj)
444 r0ij=rs0(itypi,itypj)
446 C Check whether the SC's are not too far to make a contact.
449 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
450 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
452 if (fcont.gt.0.0D0) then
453 C If the SC-SC distance if close to sigma, apply spline.
454 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
455 cAdam & fcont1,fprimcont1)
456 cAdam fcont1=1.0d0-fcont1
457 cAdam if (fcont1.gt.0.0d0) then
458 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
459 cAdam fcont=fcont*fcont1
461 C Uncomment following 4 lines to have the geometric average of the epsilon0's
462 cga eps0ij=1.0d0/dsqrt(eps0ij)
464 cga gg(k)=gg(k)*eps0ij
466 cga eps0ij=-evdwij*eps0ij
467 C Uncomment for AL's type of SC correlation interactions.
469 num_conti=num_conti+1
471 facont(num_conti,i)=fcont*eps0ij
472 fprimcont=eps0ij*fprimcont/rij
474 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
475 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
476 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
477 C Uncomment following 3 lines for Skolnick's type of SC correlation.
478 gacont(1,num_conti,i)=-fprimcont*xj
479 gacont(2,num_conti,i)=-fprimcont*yj
480 gacont(3,num_conti,i)=-fprimcont*zj
481 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
482 cd write (iout,'(2i3,3f10.5)')
483 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
489 num_cont(i)=num_conti
494 gvdwc(j,i)=expon*gvdwc(j,i)
495 gvdwx(j,i)=expon*gvdwx(j,i)
499 C******************************************************************************
503 C To save time, the factor of EXPON has been extracted from ALL components
504 C of GVDWC and GRADX. Remember to multiply them by this factor before further
507 C******************************************************************************
510 C-----------------------------------------------------------------------------
511 subroutine eljk(evdw,evdw_t)
513 C This subroutine calculates the interaction energy of nonbonded side chains
514 C assuming the LJK potential of interaction.
516 implicit real*8 (a-h,o-z)
518 include 'DIMENSIONS.ZSCOPT'
519 include "DIMENSIONS.COMPAR"
522 include 'COMMON.LOCAL'
523 include 'COMMON.CHAIN'
524 include 'COMMON.DERIV'
525 include 'COMMON.INTERACT'
526 include 'COMMON.ENEPS'
527 include 'COMMON.IOUNITS'
528 include 'COMMON.NAMES'
533 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
536 eneps_temp(j,i)=0.0d0
548 C Calculate SC interaction energy.
551 do j=istart(i,iint),iend(i,iint)
556 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
558 e_augm=augm(itypi,itypj)*fac_augm
561 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
562 fac=r_shift_inv**expon
563 e1=fac*fac*aa(itypi,itypj)
564 e2=fac*bb(itypi,itypj)
566 ij=icant(itypi,itypj)
567 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
568 & /dabs(eps(itypi,itypj))
569 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
570 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
571 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
572 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
573 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
574 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
575 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
576 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
577 if (bb(itypi,itypj).gt.0.0d0) then
584 C Calculate the components of the gradient in DC and X
586 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
591 gvdwx(k,i)=gvdwx(k,i)-gg(k)
592 gvdwx(k,j)=gvdwx(k,j)+gg(k)
596 gvdwc(l,k)=gvdwc(l,k)+gg(l)
606 gvdwc(j,i)=expon*gvdwc(j,i)
607 gvdwx(j,i)=expon*gvdwx(j,i)
613 C-----------------------------------------------------------------------------
614 subroutine ebp(evdw,evdw_t)
616 C This subroutine calculates the interaction energy of nonbonded side chains
617 C assuming the Berne-Pechukas potential of interaction.
619 implicit real*8 (a-h,o-z)
621 include 'DIMENSIONS.ZSCOPT'
622 include "DIMENSIONS.COMPAR"
625 include 'COMMON.LOCAL'
626 include 'COMMON.CHAIN'
627 include 'COMMON.DERIV'
628 include 'COMMON.NAMES'
629 include 'COMMON.INTERACT'
630 include 'COMMON.ENEPS'
631 include 'COMMON.IOUNITS'
632 include 'COMMON.CALC'
634 c double precision rrsave(maxdim)
640 eneps_temp(j,i)=0.0d0
645 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
646 c if (icall.eq.0) then
658 dxi=dc_norm(1,nres+i)
659 dyi=dc_norm(2,nres+i)
660 dzi=dc_norm(3,nres+i)
661 dsci_inv=vbld_inv(i+nres)
663 C Calculate SC interaction energy.
666 do j=istart(i,iint),iend(i,iint)
669 dscj_inv=vbld_inv(j+nres)
670 chi1=chi(itypi,itypj)
671 chi2=chi(itypj,itypi)
678 alf12=0.5D0*(alf1+alf2)
679 C For diagnostics only!!!
692 dxj=dc_norm(1,nres+j)
693 dyj=dc_norm(2,nres+j)
694 dzj=dc_norm(3,nres+j)
695 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
696 cd if (icall.eq.0) then
702 C Calculate the angle-dependent terms of energy & contributions to derivatives.
704 C Calculate whole angle-dependent part of epsilon and contributions
706 fac=(rrij*sigsq)**expon2
707 e1=fac*fac*aa(itypi,itypj)
708 e2=fac*bb(itypi,itypj)
709 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
710 eps2der=evdwij*eps3rt
711 eps3der=evdwij*eps2rt
712 evdwij=evdwij*eps2rt*eps3rt
713 ij=icant(itypi,itypj)
714 aux=eps1*eps2rt**2*eps3rt**2
715 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
716 & /dabs(eps(itypi,itypj))
717 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
718 if (bb(itypi,itypj).gt.0.0d0) then
725 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
726 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
727 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
728 cd & restyp(itypi),i,restyp(itypj),j,
729 cd & epsi,sigm,chi1,chi2,chip1,chip2,
730 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
731 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
734 C Calculate gradient components.
735 e1=e1*eps1*eps2rt**2*eps3rt**2
736 fac=-expon*(e1+evdwij)
739 C Calculate radial part of the gradient
743 C Calculate the angular part of the gradient and sum add the contributions
744 C to the appropriate components of the Cartesian gradient.
753 C-----------------------------------------------------------------------------
754 subroutine egb(evdw,evdw_t)
756 C This subroutine calculates the interaction energy of nonbonded side chains
757 C assuming the Gay-Berne potential of interaction.
759 implicit real*8 (a-h,o-z)
761 include 'DIMENSIONS.ZSCOPT'
762 include "DIMENSIONS.COMPAR"
765 include 'COMMON.LOCAL'
766 include 'COMMON.CHAIN'
767 include 'COMMON.DERIV'
768 include 'COMMON.NAMES'
769 include 'COMMON.INTERACT'
770 include 'COMMON.ENEPS'
771 include 'COMMON.IOUNITS'
772 include 'COMMON.CALC'
779 eneps_temp(j,i)=0.0d0
782 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
786 c if (icall.gt.0) lprn=.true.
794 dxi=dc_norm(1,nres+i)
795 dyi=dc_norm(2,nres+i)
796 dzi=dc_norm(3,nres+i)
797 dsci_inv=vbld_inv(i+nres)
799 C Calculate SC interaction energy.
802 do j=istart(i,iint),iend(i,iint)
805 dscj_inv=vbld_inv(j+nres)
806 sig0ij=sigma(itypi,itypj)
807 chi1=chi(itypi,itypj)
808 chi2=chi(itypj,itypi)
815 alf12=0.5D0*(alf1+alf2)
816 C For diagnostics only!!!
829 dxj=dc_norm(1,nres+j)
830 dyj=dc_norm(2,nres+j)
831 dzj=dc_norm(3,nres+j)
832 c write (iout,*) i,j,xj,yj,zj
833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
835 C Calculate angle-dependent terms of energy and contributions to their
839 sig=sig0ij*dsqrt(sigsq)
840 rij_shift=1.0D0/rij-sig+sig0ij
841 C I hate to put IF's in the loops, but here don't have another choice!!!!
842 if (rij_shift.le.0.0D0) then
847 c---------------------------------------------------------------
848 rij_shift=1.0D0/rij_shift
850 e1=fac*fac*aa(itypi,itypj)
851 e2=fac*bb(itypi,itypj)
852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
853 eps2der=evdwij*eps3rt
854 eps3der=evdwij*eps2rt
855 evdwij=evdwij*eps2rt*eps3rt
856 if (bb(itypi,itypj).gt.0) then
861 ij=icant(itypi,itypj)
862 aux=eps1*eps2rt**2*eps3rt**2
863 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
864 & /dabs(eps(itypi,itypj))
865 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
866 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
867 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
868 c & aux*e2/eps(itypi,itypj)
870 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
871 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
872 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
873 & restyp(itypi),i,restyp(itypj),j,
874 & epsi,sigm,chi1,chi2,chip1,chip2,
875 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
876 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
880 C Calculate gradient components.
881 e1=e1*eps1*eps2rt**2*eps3rt**2
882 fac=-expon*(e1+evdwij)*rij_shift
885 C Calculate the radial part of the gradient
889 C Calculate angular part of the gradient.
897 C-----------------------------------------------------------------------------
898 subroutine egbv(evdw,evdw_t)
900 C This subroutine calculates the interaction energy of nonbonded side chains
901 C assuming the Gay-Berne-Vorobjev potential of interaction.
903 implicit real*8 (a-h,o-z)
905 include 'DIMENSIONS.ZSCOPT'
906 include "DIMENSIONS.COMPAR"
909 include 'COMMON.LOCAL'
910 include 'COMMON.CHAIN'
911 include 'COMMON.DERIV'
912 include 'COMMON.NAMES'
913 include 'COMMON.INTERACT'
914 include 'COMMON.ENEPS'
915 include 'COMMON.IOUNITS'
916 include 'COMMON.CALC'
923 eneps_temp(j,i)=0.0d0
928 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
931 c if (icall.gt.0) lprn=.true.
939 dxi=dc_norm(1,nres+i)
940 dyi=dc_norm(2,nres+i)
941 dzi=dc_norm(3,nres+i)
942 dsci_inv=vbld_inv(i+nres)
944 C Calculate SC interaction energy.
947 do j=istart(i,iint),iend(i,iint)
950 dscj_inv=vbld_inv(j+nres)
951 sig0ij=sigma(itypi,itypj)
953 chi1=chi(itypi,itypj)
954 chi2=chi(itypj,itypi)
961 alf12=0.5D0*(alf1+alf2)
962 C For diagnostics only!!!
975 dxj=dc_norm(1,nres+j)
976 dyj=dc_norm(2,nres+j)
977 dzj=dc_norm(3,nres+j)
978 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
980 C Calculate angle-dependent terms of energy and contributions to their
984 sig=sig0ij*dsqrt(sigsq)
985 rij_shift=1.0D0/rij-sig+r0ij
986 C I hate to put IF's in the loops, but here don't have another choice!!!!
987 if (rij_shift.le.0.0D0) then
992 c---------------------------------------------------------------
993 rij_shift=1.0D0/rij_shift
995 e1=fac*fac*aa(itypi,itypj)
996 e2=fac*bb(itypi,itypj)
997 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
998 eps2der=evdwij*eps3rt
999 eps3der=evdwij*eps2rt
1000 fac_augm=rrij**expon
1001 e_augm=augm(itypi,itypj)*fac_augm
1002 evdwij=evdwij*eps2rt*eps3rt
1003 if (bb(itypi,itypj).gt.0.0d0) then
1004 evdw=evdw+evdwij+e_augm
1006 evdw_t=evdw_t+evdwij+e_augm
1008 ij=icant(itypi,itypj)
1009 aux=eps1*eps2rt**2*eps3rt**2
1010 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1011 & /dabs(eps(itypi,itypj))
1012 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1013 c eneps_temp(ij)=eneps_temp(ij)
1014 c & +(evdwij+e_augm)/eps(itypi,itypj)
1016 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1017 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1018 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1019 c & restyp(itypi),i,restyp(itypj),j,
1020 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1021 c & chi1,chi2,chip1,chip2,
1022 c & eps1,eps2rt**2,eps3rt**2,
1023 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1027 C Calculate gradient components.
1028 e1=e1*eps1*eps2rt**2*eps3rt**2
1029 fac=-expon*(e1+evdwij)*rij_shift
1031 fac=rij*fac-2*expon*rrij*e_augm
1032 C Calculate the radial part of the gradient
1036 C Calculate angular part of the gradient.
1044 C-----------------------------------------------------------------------------
1045 subroutine sc_angular
1046 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1047 C om12. Called by ebp, egb, and egbv.
1049 include 'COMMON.CALC'
1053 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1054 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1055 om12=dxi*dxj+dyi*dyj+dzi*dzj
1057 C Calculate eps1(om12) and its derivative in om12
1058 faceps1=1.0D0-om12*chiom12
1059 faceps1_inv=1.0D0/faceps1
1060 eps1=dsqrt(faceps1_inv)
1061 C Following variable is eps1*deps1/dom12
1062 eps1_om12=faceps1_inv*chiom12
1063 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1068 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1069 sigsq=1.0D0-facsig*faceps1_inv
1070 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1071 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1072 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1073 C Calculate eps2 and its derivatives in om1, om2, and om12.
1076 chipom12=chip12*om12
1077 facp=1.0D0-om12*chipom12
1079 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1080 C Following variable is the square root of eps2
1081 eps2rt=1.0D0-facp1*facp_inv
1082 C Following three variables are the derivatives of the square root of eps
1083 C in om1, om2, and om12.
1084 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1085 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1086 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1087 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1088 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1089 C Calculate whole angle-dependent part of epsilon and contributions
1090 C to its derivatives
1093 C----------------------------------------------------------------------------
1095 implicit real*8 (a-h,o-z)
1096 include 'DIMENSIONS'
1097 include 'DIMENSIONS.ZSCOPT'
1098 include 'COMMON.CHAIN'
1099 include 'COMMON.DERIV'
1100 include 'COMMON.CALC'
1101 double precision dcosom1(3),dcosom2(3)
1102 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1103 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1104 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1105 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1107 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1108 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1111 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1114 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1115 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1116 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1117 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1118 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1119 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1122 C Calculate the components of the gradient in DC and X
1126 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1131 c------------------------------------------------------------------------------
1132 subroutine vec_and_deriv
1133 implicit real*8 (a-h,o-z)
1134 include 'DIMENSIONS'
1135 include 'DIMENSIONS.ZSCOPT'
1136 include 'COMMON.IOUNITS'
1137 include 'COMMON.GEO'
1138 include 'COMMON.VAR'
1139 include 'COMMON.LOCAL'
1140 include 'COMMON.CHAIN'
1141 include 'COMMON.VECTORS'
1142 include 'COMMON.DERIV'
1143 include 'COMMON.INTERACT'
1144 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1145 C Compute the local reference systems. For reference system (i), the
1146 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1147 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1149 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1150 if (i.eq.nres-1) then
1151 C Case of the last full residue
1152 C Compute the Z-axis
1153 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1154 costh=dcos(pi-theta(nres))
1155 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1160 C Compute the derivatives of uz
1162 uzder(2,1,1)=-dc_norm(3,i-1)
1163 uzder(3,1,1)= dc_norm(2,i-1)
1164 uzder(1,2,1)= dc_norm(3,i-1)
1166 uzder(3,2,1)=-dc_norm(1,i-1)
1167 uzder(1,3,1)=-dc_norm(2,i-1)
1168 uzder(2,3,1)= dc_norm(1,i-1)
1171 uzder(2,1,2)= dc_norm(3,i)
1172 uzder(3,1,2)=-dc_norm(2,i)
1173 uzder(1,2,2)=-dc_norm(3,i)
1175 uzder(3,2,2)= dc_norm(1,i)
1176 uzder(1,3,2)= dc_norm(2,i)
1177 uzder(2,3,2)=-dc_norm(1,i)
1180 C Compute the Y-axis
1183 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1186 C Compute the derivatives of uy
1189 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1190 & -dc_norm(k,i)*dc_norm(j,i-1)
1191 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1193 uyder(j,j,1)=uyder(j,j,1)-costh
1194 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1199 uygrad(l,k,j,i)=uyder(l,k,j)
1200 uzgrad(l,k,j,i)=uzder(l,k,j)
1204 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1205 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1206 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1207 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1211 C Compute the Z-axis
1212 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1213 costh=dcos(pi-theta(i+2))
1214 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1219 C Compute the derivatives of uz
1221 uzder(2,1,1)=-dc_norm(3,i+1)
1222 uzder(3,1,1)= dc_norm(2,i+1)
1223 uzder(1,2,1)= dc_norm(3,i+1)
1225 uzder(3,2,1)=-dc_norm(1,i+1)
1226 uzder(1,3,1)=-dc_norm(2,i+1)
1227 uzder(2,3,1)= dc_norm(1,i+1)
1230 uzder(2,1,2)= dc_norm(3,i)
1231 uzder(3,1,2)=-dc_norm(2,i)
1232 uzder(1,2,2)=-dc_norm(3,i)
1234 uzder(3,2,2)= dc_norm(1,i)
1235 uzder(1,3,2)= dc_norm(2,i)
1236 uzder(2,3,2)=-dc_norm(1,i)
1239 C Compute the Y-axis
1242 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1245 C Compute the derivatives of uy
1248 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1249 & -dc_norm(k,i)*dc_norm(j,i+1)
1250 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1252 uyder(j,j,1)=uyder(j,j,1)-costh
1253 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1258 uygrad(l,k,j,i)=uyder(l,k,j)
1259 uzgrad(l,k,j,i)=uzder(l,k,j)
1263 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1264 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1265 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1266 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1272 vbld_inv_temp(1)=vbld_inv(i+1)
1273 if (i.lt.nres-1) then
1274 vbld_inv_temp(2)=vbld_inv(i+2)
1276 vbld_inv_temp(2)=vbld_inv(i)
1281 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1282 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1290 C-----------------------------------------------------------------------------
1291 subroutine vec_and_deriv_test
1292 implicit real*8 (a-h,o-z)
1293 include 'DIMENSIONS'
1294 include 'DIMENSIONS.ZSCOPT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.GEO'
1297 include 'COMMON.VAR'
1298 include 'COMMON.LOCAL'
1299 include 'COMMON.CHAIN'
1300 include 'COMMON.VECTORS'
1301 dimension uyder(3,3,2),uzder(3,3,2)
1302 C Compute the local reference systems. For reference system (i), the
1303 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1304 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1306 if (i.eq.nres-1) then
1307 C Case of the last full residue
1308 C Compute the Z-axis
1309 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1310 costh=dcos(pi-theta(nres))
1311 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1312 c write (iout,*) 'fac',fac,
1313 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1314 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1318 C Compute the derivatives of uz
1320 uzder(2,1,1)=-dc_norm(3,i-1)
1321 uzder(3,1,1)= dc_norm(2,i-1)
1322 uzder(1,2,1)= dc_norm(3,i-1)
1324 uzder(3,2,1)=-dc_norm(1,i-1)
1325 uzder(1,3,1)=-dc_norm(2,i-1)
1326 uzder(2,3,1)= dc_norm(1,i-1)
1329 uzder(2,1,2)= dc_norm(3,i)
1330 uzder(3,1,2)=-dc_norm(2,i)
1331 uzder(1,2,2)=-dc_norm(3,i)
1333 uzder(3,2,2)= dc_norm(1,i)
1334 uzder(1,3,2)= dc_norm(2,i)
1335 uzder(2,3,2)=-dc_norm(1,i)
1337 C Compute the Y-axis
1339 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1342 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1343 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1344 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1346 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1349 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1350 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1353 c write (iout,*) 'facy',facy,
1354 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1355 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1357 uy(k,i)=facy*uy(k,i)
1359 C Compute the derivatives of uy
1362 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1363 & -dc_norm(k,i)*dc_norm(j,i-1)
1364 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1366 c uyder(j,j,1)=uyder(j,j,1)-costh
1367 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1368 uyder(j,j,1)=uyder(j,j,1)
1369 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1370 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1376 uygrad(l,k,j,i)=uyder(l,k,j)
1377 uzgrad(l,k,j,i)=uzder(l,k,j)
1381 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1382 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1383 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1384 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1387 C Compute the Z-axis
1388 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1389 costh=dcos(pi-theta(i+2))
1390 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1391 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1395 C Compute the derivatives of uz
1397 uzder(2,1,1)=-dc_norm(3,i+1)
1398 uzder(3,1,1)= dc_norm(2,i+1)
1399 uzder(1,2,1)= dc_norm(3,i+1)
1401 uzder(3,2,1)=-dc_norm(1,i+1)
1402 uzder(1,3,1)=-dc_norm(2,i+1)
1403 uzder(2,3,1)= dc_norm(1,i+1)
1406 uzder(2,1,2)= dc_norm(3,i)
1407 uzder(3,1,2)=-dc_norm(2,i)
1408 uzder(1,2,2)=-dc_norm(3,i)
1410 uzder(3,2,2)= dc_norm(1,i)
1411 uzder(1,3,2)= dc_norm(2,i)
1412 uzder(2,3,2)=-dc_norm(1,i)
1414 C Compute the Y-axis
1416 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1417 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1418 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1420 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1423 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1424 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1427 c write (iout,*) 'facy',facy,
1428 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1429 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1431 uy(k,i)=facy*uy(k,i)
1433 C Compute the derivatives of uy
1436 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1437 & -dc_norm(k,i)*dc_norm(j,i+1)
1438 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1440 c uyder(j,j,1)=uyder(j,j,1)-costh
1441 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1442 uyder(j,j,1)=uyder(j,j,1)
1443 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1444 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1450 uygrad(l,k,j,i)=uyder(l,k,j)
1451 uzgrad(l,k,j,i)=uzder(l,k,j)
1455 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1456 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1457 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1458 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1465 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1466 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1473 C-----------------------------------------------------------------------------
1474 subroutine check_vecgrad
1475 implicit real*8 (a-h,o-z)
1476 include 'DIMENSIONS'
1477 include 'DIMENSIONS.ZSCOPT'
1478 include 'COMMON.IOUNITS'
1479 include 'COMMON.GEO'
1480 include 'COMMON.VAR'
1481 include 'COMMON.LOCAL'
1482 include 'COMMON.CHAIN'
1483 include 'COMMON.VECTORS'
1484 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1485 dimension uyt(3,maxres),uzt(3,maxres)
1486 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1487 double precision delta /1.0d-7/
1490 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1491 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1492 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1493 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1494 cd & (dc_norm(if90,i),if90=1,3)
1495 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1496 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1497 cd write(iout,'(a)')
1503 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1504 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1517 cd write (iout,*) 'i=',i
1519 erij(k)=dc_norm(k,i)
1523 dc_norm(k,i)=erij(k)
1525 dc_norm(j,i)=dc_norm(j,i)+delta
1526 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1528 c dc_norm(k,i)=dc_norm(k,i)/fac
1530 c write (iout,*) (dc_norm(k,i),k=1,3)
1531 c write (iout,*) (erij(k),k=1,3)
1534 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1535 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1536 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1537 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1539 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1540 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1541 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1544 dc_norm(k,i)=erij(k)
1547 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1548 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1549 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1550 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1551 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1552 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1553 cd write (iout,'(a)')
1558 C--------------------------------------------------------------------------
1559 subroutine set_matrices
1560 implicit real*8 (a-h,o-z)
1561 include 'DIMENSIONS'
1562 include 'DIMENSIONS.ZSCOPT'
1563 include 'COMMON.IOUNITS'
1564 include 'COMMON.GEO'
1565 include 'COMMON.VAR'
1566 include 'COMMON.LOCAL'
1567 include 'COMMON.CHAIN'
1568 include 'COMMON.DERIV'
1569 include 'COMMON.INTERACT'
1570 include 'COMMON.CONTACTS'
1571 include 'COMMON.TORSION'
1572 include 'COMMON.VECTORS'
1573 include 'COMMON.FFIELD'
1574 double precision auxvec(2),auxmat(2,2)
1576 C Compute the virtual-bond-torsional-angle dependent quantities needed
1577 C to calculate the el-loc multibody terms of various order.
1580 if (i .lt. nres+1) then
1617 if (i .gt. 3 .and. i .lt. nres+1) then
1618 obrot_der(1,i-2)=-sin1
1619 obrot_der(2,i-2)= cos1
1620 Ugder(1,1,i-2)= sin1
1621 Ugder(1,2,i-2)=-cos1
1622 Ugder(2,1,i-2)=-cos1
1623 Ugder(2,2,i-2)=-sin1
1626 obrot2_der(1,i-2)=-dwasin2
1627 obrot2_der(2,i-2)= dwacos2
1628 Ug2der(1,1,i-2)= dwasin2
1629 Ug2der(1,2,i-2)=-dwacos2
1630 Ug2der(2,1,i-2)=-dwacos2
1631 Ug2der(2,2,i-2)=-dwasin2
1633 obrot_der(1,i-2)=0.0d0
1634 obrot_der(2,i-2)=0.0d0
1635 Ugder(1,1,i-2)=0.0d0
1636 Ugder(1,2,i-2)=0.0d0
1637 Ugder(2,1,i-2)=0.0d0
1638 Ugder(2,2,i-2)=0.0d0
1639 obrot2_der(1,i-2)=0.0d0
1640 obrot2_der(2,i-2)=0.0d0
1641 Ug2der(1,1,i-2)=0.0d0
1642 Ug2der(1,2,i-2)=0.0d0
1643 Ug2der(2,1,i-2)=0.0d0
1644 Ug2der(2,2,i-2)=0.0d0
1646 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1647 iti = itortyp(itype(i-2))
1651 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1652 iti1 = itortyp(itype(i-1))
1656 cd write (iout,*) '*******i',i,' iti1',iti
1657 cd write (iout,*) 'b1',b1(:,iti)
1658 cd write (iout,*) 'b2',b2(:,iti)
1659 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1660 if (i .gt. iatel_s+2) then
1661 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1662 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1663 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1664 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1665 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1666 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1667 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1677 DtUg2(l,k,i-2)=0.0d0
1681 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1682 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1683 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1684 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1685 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1686 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1687 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1689 muder(k,i-2)=Ub2der(k,i-2)
1691 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1692 iti1 = itortyp(itype(i-1))
1697 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1699 C Vectors and matrices dependent on a single virtual-bond dihedral.
1700 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1701 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1702 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1703 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1704 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1705 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1706 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1707 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1708 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1709 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1710 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1712 C Matrices dependent on two consecutive virtual-bond dihedrals.
1713 C The order of matrices is from left to right.
1715 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1716 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1717 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1718 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1719 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1720 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1721 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1722 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1725 cd iti = itortyp(itype(i))
1728 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1729 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1734 C--------------------------------------------------------------------------
1735 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1737 C This subroutine calculates the average interaction energy and its gradient
1738 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1739 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1740 C The potential depends both on the distance of peptide-group centers and on
1741 C the orientation of the CA-CA virtual bonds.
1743 implicit real*8 (a-h,o-z)
1744 include 'DIMENSIONS'
1745 include 'DIMENSIONS.ZSCOPT'
1746 include 'COMMON.CONTROL'
1747 include 'COMMON.IOUNITS'
1748 include 'COMMON.GEO'
1749 include 'COMMON.VAR'
1750 include 'COMMON.LOCAL'
1751 include 'COMMON.CHAIN'
1752 include 'COMMON.DERIV'
1753 include 'COMMON.INTERACT'
1754 include 'COMMON.CONTACTS'
1755 include 'COMMON.TORSION'
1756 include 'COMMON.VECTORS'
1757 include 'COMMON.FFIELD'
1758 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1759 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1760 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1761 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1762 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1763 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1764 double precision scal_el /0.5d0/
1766 C 13-go grudnia roku pamietnego...
1767 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1768 & 0.0d0,1.0d0,0.0d0,
1769 & 0.0d0,0.0d0,1.0d0/
1770 cd write(iout,*) 'In EELEC'
1772 cd write(iout,*) 'Type',i
1773 cd write(iout,*) 'B1',B1(:,i)
1774 cd write(iout,*) 'B2',B2(:,i)
1775 cd write(iout,*) 'CC',CC(:,:,i)
1776 cd write(iout,*) 'DD',DD(:,:,i)
1777 cd write(iout,*) 'EE',EE(:,:,i)
1779 cd call check_vecgrad
1781 if (icheckgrad.eq.1) then
1783 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1785 dc_norm(k,i)=dc(k,i)*fac
1787 c write (iout,*) 'i',i,' fac',fac
1790 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1792 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1793 cd if (wel_loc.gt.0.0d0) then
1794 if (icheckgrad.eq.1) then
1795 call vec_and_deriv_test
1802 cd write (iout,*) 'i=',i
1804 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1807 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1808 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1821 cd print '(a)','Enter EELEC'
1822 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1824 gel_loc_loc(i)=0.0d0
1827 do i=iatel_s,iatel_e
1828 if (itel(i).eq.0) goto 1215
1832 dx_normi=dc_norm(1,i)
1833 dy_normi=dc_norm(2,i)
1834 dz_normi=dc_norm(3,i)
1835 xmedi=c(1,i)+0.5d0*dxi
1836 ymedi=c(2,i)+0.5d0*dyi
1837 zmedi=c(3,i)+0.5d0*dzi
1839 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1840 do j=ielstart(i),ielend(i)
1841 if (itel(j).eq.0) goto 1216
1845 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1846 aaa=app(iteli,itelj)
1847 bbb=bpp(iteli,itelj)
1848 C Diagnostics only!!!
1854 ael6i=ael6(iteli,itelj)
1855 ael3i=ael3(iteli,itelj)
1859 dx_normj=dc_norm(1,j)
1860 dy_normj=dc_norm(2,j)
1861 dz_normj=dc_norm(3,j)
1862 xj=c(1,j)+0.5D0*dxj-xmedi
1863 yj=c(2,j)+0.5D0*dyj-ymedi
1864 zj=c(3,j)+0.5D0*dzj-zmedi
1865 rij=xj*xj+yj*yj+zj*zj
1871 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1872 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1873 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1874 fac=cosa-3.0D0*cosb*cosg
1876 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1877 if (j.eq.i+2) ev1=scal_el*ev1
1882 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1885 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1886 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1887 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1890 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1891 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1892 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1893 cd & xmedi,ymedi,zmedi,xj,yj,zj
1895 C Calculate contributions to the Cartesian gradient.
1898 facvdw=-6*rrmij*(ev1+evdwij)
1899 facel=-3*rrmij*(el1+eesij)
1906 * Radial derivatives. First process both termini of the fragment (i,j)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 gelc(k,j)=gelc(k,j)+ghalf
1917 * Loop over residues i+1 thru j-1.
1921 gelc(l,k)=gelc(l,k)+ggg(l)
1929 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1930 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1933 * Loop over residues i+1 thru j-1.
1937 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1944 fac=-3*rrmij*(facvdw+facvdw+facel)
1950 * Radial derivatives. First process both termini of the fragment (i,j)
1957 gelc(k,i)=gelc(k,i)+ghalf
1958 gelc(k,j)=gelc(k,j)+ghalf
1961 * Loop over residues i+1 thru j-1.
1965 gelc(l,k)=gelc(l,k)+ggg(l)
1972 ecosa=2.0D0*fac3*fac1+fac4
1975 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1976 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1978 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1979 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1981 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1982 cd & (dcosg(k),k=1,3)
1984 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1988 gelc(k,i)=gelc(k,i)+ghalf
1989 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1990 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1991 gelc(k,j)=gelc(k,j)+ghalf
1992 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1993 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1997 gelc(l,k)=gelc(l,k)+ggg(l)
2002 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2003 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2004 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2006 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2007 C energy of a peptide unit is assumed in the form of a second-order
2008 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2009 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2010 C are computed for EVERY pair of non-contiguous peptide groups.
2012 if (j.lt.nres-1) then
2023 muij(kkk)=mu(k,i)*mu(l,j)
2026 cd write (iout,*) 'EELEC: i',i,' j',j
2027 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2028 cd write(iout,*) 'muij',muij
2029 ury=scalar(uy(1,i),erij)
2030 urz=scalar(uz(1,i),erij)
2031 vry=scalar(uy(1,j),erij)
2032 vrz=scalar(uz(1,j),erij)
2033 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2034 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2035 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2036 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2037 C For diagnostics only
2042 fac=dsqrt(-ael6i)*r3ij
2043 cd write (2,*) 'fac=',fac
2044 C For diagnostics only
2050 cd write (iout,'(4i5,4f10.5)')
2051 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2052 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2053 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2054 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2055 cd write (iout,'(4f10.5)')
2056 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2057 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2058 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2059 cd write (iout,'(2i3,9f10.5/)') i,j,
2060 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2062 C Derivatives of the elements of A in virtual-bond vectors
2063 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2070 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2071 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2072 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2073 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2074 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2075 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2076 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2077 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2078 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2079 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2080 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2081 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2091 C Compute radial contributions to the gradient
2113 C Add the contributions coming from er
2116 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2117 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2118 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2119 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2122 C Derivatives in DC(i)
2123 ghalf1=0.5d0*agg(k,1)
2124 ghalf2=0.5d0*agg(k,2)
2125 ghalf3=0.5d0*agg(k,3)
2126 ghalf4=0.5d0*agg(k,4)
2127 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2128 & -3.0d0*uryg(k,2)*vry)+ghalf1
2129 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2130 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2131 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2132 & -3.0d0*urzg(k,2)*vry)+ghalf3
2133 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2134 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2135 C Derivatives in DC(i+1)
2136 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2137 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2138 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2139 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2140 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2141 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2142 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2143 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2144 C Derivatives in DC(j)
2145 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2146 & -3.0d0*vryg(k,2)*ury)+ghalf1
2147 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2148 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2149 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2150 & -3.0d0*vryg(k,2)*urz)+ghalf3
2151 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2152 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2153 C Derivatives in DC(j+1) or DC(nres-1)
2154 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2155 & -3.0d0*vryg(k,3)*ury)
2156 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2157 & -3.0d0*vrzg(k,3)*ury)
2158 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2159 & -3.0d0*vryg(k,3)*urz)
2160 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2161 & -3.0d0*vrzg(k,3)*urz)
2166 C Derivatives in DC(i+1)
2167 cd aggi1(k,1)=agg(k,1)
2168 cd aggi1(k,2)=agg(k,2)
2169 cd aggi1(k,3)=agg(k,3)
2170 cd aggi1(k,4)=agg(k,4)
2171 C Derivatives in DC(j)
2176 C Derivatives in DC(j+1)
2181 if (j.eq.nres-1 .and. i.lt.j-2) then
2183 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2184 cd aggj1(k,l)=agg(k,l)
2190 C Check the loc-el terms by numerical integration
2200 aggi(k,l)=-aggi(k,l)
2201 aggi1(k,l)=-aggi1(k,l)
2202 aggj(k,l)=-aggj(k,l)
2203 aggj1(k,l)=-aggj1(k,l)
2206 if (j.lt.nres-1) then
2212 aggi(k,l)=-aggi(k,l)
2213 aggi1(k,l)=-aggi1(k,l)
2214 aggj(k,l)=-aggj(k,l)
2215 aggj1(k,l)=-aggj1(k,l)
2226 aggi(k,l)=-aggi(k,l)
2227 aggi1(k,l)=-aggi1(k,l)
2228 aggj(k,l)=-aggj(k,l)
2229 aggj1(k,l)=-aggj1(k,l)
2235 IF (wel_loc.gt.0.0d0) THEN
2236 C Contribution to the local-electrostatic energy coming from the i-j pair
2237 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2239 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2240 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2241 eel_loc=eel_loc+eel_loc_ij
2242 C Partial derivatives in virtual-bond dihedral angles gamma
2245 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2246 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2247 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2248 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2249 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2250 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2251 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2252 cd write(iout,*) 'agg ',agg
2253 cd write(iout,*) 'aggi ',aggi
2254 cd write(iout,*) 'aggi1',aggi1
2255 cd write(iout,*) 'aggj ',aggj
2256 cd write(iout,*) 'aggj1',aggj1
2258 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2260 ggg(l)=agg(l,1)*muij(1)+
2261 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2265 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2268 C Remaining derivatives of eello
2270 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2271 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2272 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2273 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2274 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2275 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2276 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2277 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2281 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2282 C Contributions from turns
2287 call eturn34(i,j,eello_turn3,eello_turn4)
2289 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2290 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2292 C Calculate the contact function. The ith column of the array JCONT will
2293 C contain the numbers of atoms that make contacts with the atom I (of numbers
2294 C greater than I). The arrays FACONT and GACONT will contain the values of
2295 C the contact function and its derivative.
2296 c r0ij=1.02D0*rpp(iteli,itelj)
2297 c r0ij=1.11D0*rpp(iteli,itelj)
2298 r0ij=2.20D0*rpp(iteli,itelj)
2299 c r0ij=1.55D0*rpp(iteli,itelj)
2300 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2301 if (fcont.gt.0.0D0) then
2302 num_conti=num_conti+1
2303 if (num_conti.gt.maxconts) then
2304 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2305 & ' will skip next contacts for this conf.'
2307 jcont_hb(num_conti,i)=j
2308 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2309 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2310 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2312 d_cont(num_conti,i)=rij
2313 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2314 C --- Electrostatic-interaction matrix ---
2315 a_chuj(1,1,num_conti,i)=a22
2316 a_chuj(1,2,num_conti,i)=a23
2317 a_chuj(2,1,num_conti,i)=a32
2318 a_chuj(2,2,num_conti,i)=a33
2319 C --- Gradient of rij
2321 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2324 c a_chuj(1,1,num_conti,i)=-0.61d0
2325 c a_chuj(1,2,num_conti,i)= 0.4d0
2326 c a_chuj(2,1,num_conti,i)= 0.65d0
2327 c a_chuj(2,2,num_conti,i)= 0.50d0
2328 c else if (i.eq.2) then
2329 c a_chuj(1,1,num_conti,i)= 0.0d0
2330 c a_chuj(1,2,num_conti,i)= 0.0d0
2331 c a_chuj(2,1,num_conti,i)= 0.0d0
2332 c a_chuj(2,2,num_conti,i)= 0.0d0
2334 C --- and its gradients
2335 cd write (iout,*) 'i',i,' j',j
2337 cd write (iout,*) 'iii 1 kkk',kkk
2338 cd write (iout,*) agg(kkk,:)
2341 cd write (iout,*) 'iii 2 kkk',kkk
2342 cd write (iout,*) aggi(kkk,:)
2345 cd write (iout,*) 'iii 3 kkk',kkk
2346 cd write (iout,*) aggi1(kkk,:)
2349 cd write (iout,*) 'iii 4 kkk',kkk
2350 cd write (iout,*) aggj(kkk,:)
2353 cd write (iout,*) 'iii 5 kkk',kkk
2354 cd write (iout,*) aggj1(kkk,:)
2361 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2362 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2363 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2364 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2365 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2367 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2373 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2374 C Calculate contact energies
2376 wij=cosa-3.0D0*cosb*cosg
2379 c fac3=dsqrt(-ael6i)/r0ij**3
2380 fac3=dsqrt(-ael6i)*r3ij
2381 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2382 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2384 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2385 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2386 C Diagnostics. Comment out or remove after debugging!
2387 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2388 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2389 c ees0m(num_conti,i)=0.0D0
2391 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2392 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2393 facont_hb(num_conti,i)=fcont
2395 C Angular derivatives of the contact function
2396 ees0pij1=fac3/ees0pij
2397 ees0mij1=fac3/ees0mij
2398 fac3p=-3.0D0*fac3*rrmij
2399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2408 ecosap=ecosa1+ecosa2
2409 ecosbp=ecosb1+ecosb2
2410 ecosgp=ecosg1+ecosg2
2411 ecosam=ecosa1-ecosa2
2412 ecosbm=ecosb1-ecosb2
2413 ecosgm=ecosg1-ecosg2
2422 fprimcont=fprimcont/rij
2423 cd facont_hb(num_conti,i)=1.0D0
2424 C Following line is for diagnostics.
2427 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2428 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2431 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2432 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2434 gggp(1)=gggp(1)+ees0pijp*xj
2435 gggp(2)=gggp(2)+ees0pijp*yj
2436 gggp(3)=gggp(3)+ees0pijp*zj
2437 gggm(1)=gggm(1)+ees0mijp*xj
2438 gggm(2)=gggm(2)+ees0mijp*yj
2439 gggm(3)=gggm(3)+ees0mijp*zj
2440 C Derivatives due to the contact function
2441 gacont_hbr(1,num_conti,i)=fprimcont*xj
2442 gacont_hbr(2,num_conti,i)=fprimcont*yj
2443 gacont_hbr(3,num_conti,i)=fprimcont*zj
2445 ghalfp=0.5D0*gggp(k)
2446 ghalfm=0.5D0*gggm(k)
2447 gacontp_hb1(k,num_conti,i)=ghalfp
2448 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2449 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2450 gacontp_hb2(k,num_conti,i)=ghalfp
2451 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2452 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2453 gacontp_hb3(k,num_conti,i)=gggp(k)
2454 gacontm_hb1(k,num_conti,i)=ghalfm
2455 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2456 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2457 gacontm_hb2(k,num_conti,i)=ghalfm
2458 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2459 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2460 gacontm_hb3(k,num_conti,i)=gggm(k)
2463 C Diagnostics. Comment out or remove after debugging!
2465 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2466 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2467 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2468 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2469 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2470 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2473 endif ! num_conti.le.maxconts
2478 num_cont_hb(i)=num_conti
2482 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2483 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2485 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2486 ccc eel_loc=eel_loc+eello_turn3
2489 C-----------------------------------------------------------------------------
2490 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2491 C Third- and fourth-order contributions from turns
2492 implicit real*8 (a-h,o-z)
2493 include 'DIMENSIONS'
2494 include 'DIMENSIONS.ZSCOPT'
2495 include 'COMMON.IOUNITS'
2496 include 'COMMON.GEO'
2497 include 'COMMON.VAR'
2498 include 'COMMON.LOCAL'
2499 include 'COMMON.CHAIN'
2500 include 'COMMON.DERIV'
2501 include 'COMMON.INTERACT'
2502 include 'COMMON.CONTACTS'
2503 include 'COMMON.TORSION'
2504 include 'COMMON.VECTORS'
2505 include 'COMMON.FFIELD'
2507 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2508 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2509 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2510 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2511 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2512 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2516 C Third-order contributions
2523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2524 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2525 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2526 call transpose2(auxmat(1,1),auxmat1(1,1))
2527 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2528 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2529 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2530 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2531 cd & ' eello_turn3_num',4*eello_turn3_num
2533 C Derivatives in gamma(i)
2534 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2535 call transpose2(auxmat2(1,1),pizda(1,1))
2536 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2537 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2538 C Derivatives in gamma(i+1)
2539 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2540 call transpose2(auxmat2(1,1),pizda(1,1))
2541 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2542 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2543 & +0.5d0*(pizda(1,1)+pizda(2,2))
2544 C Cartesian derivatives
2546 a_temp(1,1)=aggi(l,1)
2547 a_temp(1,2)=aggi(l,2)
2548 a_temp(2,1)=aggi(l,3)
2549 a_temp(2,2)=aggi(l,4)
2550 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2551 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2552 & +0.5d0*(pizda(1,1)+pizda(2,2))
2553 a_temp(1,1)=aggi1(l,1)
2554 a_temp(1,2)=aggi1(l,2)
2555 a_temp(2,1)=aggi1(l,3)
2556 a_temp(2,2)=aggi1(l,4)
2557 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2558 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2559 & +0.5d0*(pizda(1,1)+pizda(2,2))
2560 a_temp(1,1)=aggj(l,1)
2561 a_temp(1,2)=aggj(l,2)
2562 a_temp(2,1)=aggj(l,3)
2563 a_temp(2,2)=aggj(l,4)
2564 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2565 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2566 & +0.5d0*(pizda(1,1)+pizda(2,2))
2567 a_temp(1,1)=aggj1(l,1)
2568 a_temp(1,2)=aggj1(l,2)
2569 a_temp(2,1)=aggj1(l,3)
2570 a_temp(2,2)=aggj1(l,4)
2571 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2572 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2573 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 else if (j.eq.i+3) then
2577 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2579 C Fourth-order contributions
2587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2588 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2589 iti1=itortyp(itype(i+1))
2590 iti2=itortyp(itype(i+2))
2591 iti3=itortyp(itype(i+3))
2592 call transpose2(EUg(1,1,i+1),e1t(1,1))
2593 call transpose2(Eug(1,1,i+2),e2t(1,1))
2594 call transpose2(Eug(1,1,i+3),e3t(1,1))
2595 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2596 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2597 s1=scalar2(b1(1,iti2),auxvec(1))
2598 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2599 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2600 s2=scalar2(b1(1,iti1),auxvec(1))
2601 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2602 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2603 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2604 eello_turn4=eello_turn4-(s1+s2+s3)
2605 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2606 cd & ' eello_turn4_num',8*eello_turn4_num
2607 C Derivatives in gamma(i)
2609 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2610 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2611 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2612 s1=scalar2(b1(1,iti2),auxvec(1))
2613 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2614 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2615 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2616 C Derivatives in gamma(i+1)
2617 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2618 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2619 s2=scalar2(b1(1,iti1),auxvec(1))
2620 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2621 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2622 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2623 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2624 C Derivatives in gamma(i+2)
2625 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2626 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2627 s1=scalar2(b1(1,iti2),auxvec(1))
2628 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2629 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2630 s2=scalar2(b1(1,iti1),auxvec(1))
2631 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2632 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2635 C Cartesian derivatives
2636 C Derivatives of this turn contributions in DC(i+2)
2637 if (j.lt.nres-1) then
2639 a_temp(1,1)=agg(l,1)
2640 a_temp(1,2)=agg(l,2)
2641 a_temp(2,1)=agg(l,3)
2642 a_temp(2,2)=agg(l,4)
2643 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2644 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2645 s1=scalar2(b1(1,iti2),auxvec(1))
2646 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2647 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2648 s2=scalar2(b1(1,iti1),auxvec(1))
2649 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2650 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2653 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2656 C Remaining derivatives of this turn contribution
2658 a_temp(1,1)=aggi(l,1)
2659 a_temp(1,2)=aggi(l,2)
2660 a_temp(2,1)=aggi(l,3)
2661 a_temp(2,2)=aggi(l,4)
2662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2664 s1=scalar2(b1(1,iti2),auxvec(1))
2665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2667 s2=scalar2(b1(1,iti1),auxvec(1))
2668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2671 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2672 a_temp(1,1)=aggi1(l,1)
2673 a_temp(1,2)=aggi1(l,2)
2674 a_temp(2,1)=aggi1(l,3)
2675 a_temp(2,2)=aggi1(l,4)
2676 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2677 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2678 s1=scalar2(b1(1,iti2),auxvec(1))
2679 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2680 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2681 s2=scalar2(b1(1,iti1),auxvec(1))
2682 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2683 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2684 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2685 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2686 a_temp(1,1)=aggj(l,1)
2687 a_temp(1,2)=aggj(l,2)
2688 a_temp(2,1)=aggj(l,3)
2689 a_temp(2,2)=aggj(l,4)
2690 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2691 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2692 s1=scalar2(b1(1,iti2),auxvec(1))
2693 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2694 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2695 s2=scalar2(b1(1,iti1),auxvec(1))
2696 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2697 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2698 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2699 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2700 a_temp(1,1)=aggj1(l,1)
2701 a_temp(1,2)=aggj1(l,2)
2702 a_temp(2,1)=aggj1(l,3)
2703 a_temp(2,2)=aggj1(l,4)
2704 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2705 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2706 s1=scalar2(b1(1,iti2),auxvec(1))
2707 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2708 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2709 s2=scalar2(b1(1,iti1),auxvec(1))
2710 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2711 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2713 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2719 C-----------------------------------------------------------------------------
2720 subroutine vecpr(u,v,w)
2721 implicit real*8(a-h,o-z)
2722 dimension u(3),v(3),w(3)
2723 w(1)=u(2)*v(3)-u(3)*v(2)
2724 w(2)=-u(1)*v(3)+u(3)*v(1)
2725 w(3)=u(1)*v(2)-u(2)*v(1)
2728 C-----------------------------------------------------------------------------
2729 subroutine unormderiv(u,ugrad,unorm,ungrad)
2730 C This subroutine computes the derivatives of a normalized vector u, given
2731 C the derivatives computed without normalization conditions, ugrad. Returns
2734 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2735 double precision vec(3)
2736 double precision scalar
2738 c write (2,*) 'ugrad',ugrad
2741 vec(i)=scalar(ugrad(1,i),u(1))
2743 c write (2,*) 'vec',vec
2746 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2749 c write (2,*) 'ungrad',ungrad
2752 C-----------------------------------------------------------------------------
2753 subroutine escp(evdw2,evdw2_14)
2755 C This subroutine calculates the excluded-volume interaction energy between
2756 C peptide-group centers and side chains and its gradient in virtual-bond and
2757 C side-chain vectors.
2759 implicit real*8 (a-h,o-z)
2760 include 'DIMENSIONS'
2761 include 'DIMENSIONS.ZSCOPT'
2762 include 'COMMON.GEO'
2763 include 'COMMON.VAR'
2764 include 'COMMON.LOCAL'
2765 include 'COMMON.CHAIN'
2766 include 'COMMON.DERIV'
2767 include 'COMMON.INTERACT'
2768 include 'COMMON.FFIELD'
2769 include 'COMMON.IOUNITS'
2773 cd print '(a)','Enter ESCP'
2774 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2775 c & ' scal14',scal14
2776 do i=iatscp_s,iatscp_e
2778 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2779 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2780 if (iteli.eq.0) goto 1225
2781 xi=0.5D0*(c(1,i)+c(1,i+1))
2782 yi=0.5D0*(c(2,i)+c(2,i+1))
2783 zi=0.5D0*(c(3,i)+c(3,i+1))
2785 do iint=1,nscp_gr(i)
2787 do j=iscpstart(i,iint),iscpend(i,iint)
2789 C Uncomment following three lines for SC-p interactions
2793 C Uncomment following three lines for Ca-p interactions
2797 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2799 e1=fac*fac*aad(itypj,iteli)
2800 e2=fac*bad(itypj,iteli)
2801 if (iabs(j-i) .le. 2) then
2804 evdw2_14=evdw2_14+e1+e2
2807 c write (iout,*) i,j,evdwij
2811 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2813 fac=-(evdwij+e1)*rrij
2818 cd write (iout,*) 'j<i'
2819 C Uncomment following three lines for SC-p interactions
2821 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2824 cd write (iout,*) 'j>i'
2827 C Uncomment following line for SC-p interactions
2828 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2832 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2836 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2837 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2840 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2850 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2851 gradx_scp(j,i)=expon*gradx_scp(j,i)
2854 C******************************************************************************
2858 C To save time the factor EXPON has been extracted from ALL components
2859 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2862 C******************************************************************************
2865 C--------------------------------------------------------------------------
2866 subroutine edis(ehpb)
2868 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2870 implicit real*8 (a-h,o-z)
2871 include 'DIMENSIONS'
2872 include 'DIMENSIONS.ZSCOPT'
2873 include 'COMMON.SBRIDGE'
2874 include 'COMMON.CHAIN'
2875 include 'COMMON.DERIV'
2876 include 'COMMON.VAR'
2877 include 'COMMON.INTERACT'
2880 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2881 cd print *,'link_start=',link_start,' link_end=',link_end
2882 if (link_end.eq.0) return
2883 do i=link_start,link_end
2884 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2885 C CA-CA distance used in regularization of structure.
2888 C iii and jjj point to the residues for which the distance is assigned.
2889 if (ii.gt.nres) then
2896 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2897 C distance and angle dependent SS bond potential.
2898 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2899 call ssbond_ene(iii,jjj,eij)
2902 C Calculate the distance between the two points and its difference from the
2906 C Get the force constant corresponding to this distance.
2908 C Calculate the contribution to energy.
2909 ehpb=ehpb+waga*rdis*rdis
2911 C Evaluate gradient.
2914 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2915 cd & ' waga=',waga,' fac=',fac
2917 ggg(j)=fac*(c(j,jj)-c(j,ii))
2919 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2920 C If this is a SC-SC distance, we need to calculate the contributions to the
2921 C Cartesian gradient in the SC vectors (ghpbx).
2924 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2925 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2930 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2938 C--------------------------------------------------------------------------
2939 subroutine ssbond_ene(i,j,eij)
2941 C Calculate the distance and angle dependent SS-bond potential energy
2942 C using a free-energy function derived based on RHF/6-31G** ab initio
2943 C calculations of diethyl disulfide.
2945 C A. Liwo and U. Kozlowska, 11/24/03
2947 implicit real*8 (a-h,o-z)
2948 include 'DIMENSIONS'
2949 include 'DIMENSIONS.ZSCOPT'
2950 include 'COMMON.SBRIDGE'
2951 include 'COMMON.CHAIN'
2952 include 'COMMON.DERIV'
2953 include 'COMMON.LOCAL'
2954 include 'COMMON.INTERACT'
2955 include 'COMMON.VAR'
2956 include 'COMMON.IOUNITS'
2957 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2962 dxi=dc_norm(1,nres+i)
2963 dyi=dc_norm(2,nres+i)
2964 dzi=dc_norm(3,nres+i)
2965 dsci_inv=dsc_inv(itypi)
2967 dscj_inv=dsc_inv(itypj)
2971 dxj=dc_norm(1,nres+j)
2972 dyj=dc_norm(2,nres+j)
2973 dzj=dc_norm(3,nres+j)
2974 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2979 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2980 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2981 om12=dxi*dxj+dyi*dyj+dzi*dzj
2983 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2984 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2990 deltat12=om2-om1+2.0d0
2992 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2993 & +akct*deltad*deltat12
2994 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2995 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2996 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2997 c & " deltat12",deltat12," eij",eij
2998 ed=2*akcm*deltad+akct*deltat12
3000 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3001 eom1=-2*akth*deltat1-pom1-om2*pom2
3002 eom2= 2*akth*deltat2+pom1-om1*pom2
3005 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3008 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3009 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3010 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3011 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3014 C Calculate the components of the gradient in DC and X
3018 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3023 C--------------------------------------------------------------------------
3024 subroutine ebond(estr)
3026 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3028 implicit real*8 (a-h,o-z)
3029 include 'DIMENSIONS'
3030 include 'DIMENSIONS.ZSCOPT'
3031 include 'COMMON.LOCAL'
3032 include 'COMMON.GEO'
3033 include 'COMMON.INTERACT'
3034 include 'COMMON.DERIV'
3035 include 'COMMON.VAR'
3036 include 'COMMON.CHAIN'
3037 include 'COMMON.IOUNITS'
3038 include 'COMMON.NAMES'
3039 include 'COMMON.FFIELD'
3040 include 'COMMON.CONTROL'
3041 double precision u(3),ud(3)
3044 diff = vbld(i)-vbldp0
3045 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3048 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3053 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3060 diff=vbld(i+nres)-vbldsc0(1,iti)
3061 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3062 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3063 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3065 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3069 diff=vbld(i+nres)-vbldsc0(j,iti)
3070 ud(j)=aksc(j,iti)*diff
3071 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3085 uprod2=uprod2*u(k)*u(k)
3089 usumsqder=usumsqder+ud(j)*uprod2
3091 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3092 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3093 estr=estr+uprod/usum
3095 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3103 C--------------------------------------------------------------------------
3104 subroutine ebend(etheta)
3106 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3107 C angles gamma and its derivatives in consecutive thetas and gammas.
3109 implicit real*8 (a-h,o-z)
3110 include 'DIMENSIONS'
3111 include 'DIMENSIONS.ZSCOPT'
3112 include 'COMMON.LOCAL'
3113 include 'COMMON.GEO'
3114 include 'COMMON.INTERACT'
3115 include 'COMMON.DERIV'
3116 include 'COMMON.VAR'
3117 include 'COMMON.CHAIN'
3118 include 'COMMON.IOUNITS'
3119 include 'COMMON.NAMES'
3120 include 'COMMON.FFIELD'
3121 common /calcthet/ term1,term2,termm,diffak,ratak,
3122 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3123 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3124 double precision y(2),z(2)
3126 time11=dexp(-2*time)
3129 c write (iout,*) "nres",nres
3130 c write (*,'(a,i2)') 'EBEND ICG=',icg
3131 c write (iout,*) ithet_start,ithet_end
3132 do i=ithet_start,ithet_end
3133 C Zero the energy function and its derivative at 0 or pi.
3134 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3136 c if (i.gt.ithet_start .and.
3137 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3138 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3146 c if (i.lt.nres .and. itel(i).ne.0) then
3158 call proc_proc(phii,icrc)
3159 if (icrc.eq.1) phii=150.0
3173 call proc_proc(phii1,icrc)
3174 if (icrc.eq.1) phii1=150.0
3186 C Calculate the "mean" value of theta from the part of the distribution
3187 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3188 C In following comments this theta will be referred to as t_c.
3189 thet_pred_mean=0.0d0
3193 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3195 c write (iout,*) "thet_pred_mean",thet_pred_mean
3196 dthett=thet_pred_mean*ssd
3197 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3198 c write (iout,*) "thet_pred_mean",thet_pred_mean
3199 C Derivatives of the "mean" values in gamma1 and gamma2.
3200 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3201 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3202 if (theta(i).gt.pi-delta) then
3203 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3205 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3206 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3207 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3209 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3211 else if (theta(i).lt.delta) then
3212 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3213 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3214 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3216 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3217 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3220 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3223 etheta=etheta+ethetai
3224 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3225 c & rad2deg*phii,rad2deg*phii1,ethetai
3226 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3227 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3228 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3231 C Ufff.... We've done all this!!!
3234 C---------------------------------------------------------------------------
3235 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3237 implicit real*8 (a-h,o-z)
3238 include 'DIMENSIONS'
3239 include 'COMMON.LOCAL'
3240 include 'COMMON.IOUNITS'
3241 common /calcthet/ term1,term2,termm,diffak,ratak,
3242 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3243 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3244 C Calculate the contributions to both Gaussian lobes.
3245 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3246 C The "polynomial part" of the "standard deviation" of this part of
3250 sig=sig*thet_pred_mean+polthet(j,it)
3252 C Derivative of the "interior part" of the "standard deviation of the"
3253 C gamma-dependent Gaussian lobe in t_c.
3254 sigtc=3*polthet(3,it)
3256 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3259 C Set the parameters of both Gaussian lobes of the distribution.
3260 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3261 fac=sig*sig+sigc0(it)
3264 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3265 sigsqtc=-4.0D0*sigcsq*sigtc
3266 c print *,i,sig,sigtc,sigsqtc
3267 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3268 sigtc=-sigtc/(fac*fac)
3269 C Following variable is sigma(t_c)**(-2)
3270 sigcsq=sigcsq*sigcsq
3272 sig0inv=1.0D0/sig0i**2
3273 delthec=thetai-thet_pred_mean
3274 delthe0=thetai-theta0i
3275 term1=-0.5D0*sigcsq*delthec*delthec
3276 term2=-0.5D0*sig0inv*delthe0*delthe0
3277 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3278 C NaNs in taking the logarithm. We extract the largest exponent which is added
3279 C to the energy (this being the log of the distribution) at the end of energy
3280 C term evaluation for this virtual-bond angle.
3281 if (term1.gt.term2) then
3283 term2=dexp(term2-termm)
3287 term1=dexp(term1-termm)
3290 C The ratio between the gamma-independent and gamma-dependent lobes of
3291 C the distribution is a Gaussian function of thet_pred_mean too.
3292 diffak=gthet(2,it)-thet_pred_mean
3293 ratak=diffak/gthet(3,it)**2
3294 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3295 C Let's differentiate it in thet_pred_mean NOW.
3297 C Now put together the distribution terms to make complete distribution.
3298 termexp=term1+ak*term2
3299 termpre=sigc+ak*sig0i
3300 C Contribution of the bending energy from this theta is just the -log of
3301 C the sum of the contributions from the two lobes and the pre-exponential
3302 C factor. Simple enough, isn't it?
3303 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3304 C NOW the derivatives!!!
3305 C 6/6/97 Take into account the deformation.
3306 E_theta=(delthec*sigcsq*term1
3307 & +ak*delthe0*sig0inv*term2)/termexp
3308 E_tc=((sigtc+aktc*sig0i)/termpre
3309 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3310 & aktc*term2)/termexp)
3313 c-----------------------------------------------------------------------------
3314 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3315 implicit real*8 (a-h,o-z)
3316 include 'DIMENSIONS'
3317 include 'COMMON.LOCAL'
3318 include 'COMMON.IOUNITS'
3319 common /calcthet/ term1,term2,termm,diffak,ratak,
3320 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3321 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3322 delthec=thetai-thet_pred_mean
3323 delthe0=thetai-theta0i
3324 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3325 t3 = thetai-thet_pred_mean
3329 t14 = t12+t6*sigsqtc
3331 t21 = thetai-theta0i
3337 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3338 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3339 & *(-t12*t9-ak*sig0inv*t27)
3343 C--------------------------------------------------------------------------
3344 subroutine ebend(etheta)
3346 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3347 C angles gamma and its derivatives in consecutive thetas and gammas.
3348 C ab initio-derived potentials from
3349 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3351 implicit real*8 (a-h,o-z)
3352 include 'DIMENSIONS'
3353 include 'DIMENSIONS.ZSCOPT'
3354 include 'COMMON.LOCAL'
3355 include 'COMMON.GEO'
3356 include 'COMMON.INTERACT'
3357 include 'COMMON.DERIV'
3358 include 'COMMON.VAR'
3359 include 'COMMON.CHAIN'
3360 include 'COMMON.IOUNITS'
3361 include 'COMMON.NAMES'
3362 include 'COMMON.FFIELD'
3363 include 'COMMON.CONTROL'
3364 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3365 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3366 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3367 & sinph1ph2(maxdouble,maxdouble)
3368 logical lprn /.false./, lprn1 /.false./
3370 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3371 do i=ithet_start,ithet_end
3375 theti2=0.5d0*theta(i)
3376 ityp2=ithetyp(itype(i-1))
3378 coskt(k)=dcos(k*theti2)
3379 sinkt(k)=dsin(k*theti2)
3384 if (phii.ne.phii) phii=150.0
3388 ityp1=ithetyp(itype(i-2))
3390 cosph1(k)=dcos(k*phii)
3391 sinph1(k)=dsin(k*phii)
3404 if (phii1.ne.phii1) phii1=150.0
3409 ityp3=ithetyp(itype(i))
3411 cosph2(k)=dcos(k*phii1)
3412 sinph2(k)=dsin(k*phii1)
3422 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3423 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3425 ethetai=aa0thet(ityp1,ityp2,ityp3)
3428 ccl=cosph1(l)*cosph2(k-l)
3429 ssl=sinph1(l)*sinph2(k-l)
3430 scl=sinph1(l)*cosph2(k-l)
3431 csl=cosph1(l)*sinph2(k-l)
3432 cosph1ph2(l,k)=ccl-ssl
3433 cosph1ph2(k,l)=ccl+ssl
3434 sinph1ph2(l,k)=scl+csl
3435 sinph1ph2(k,l)=scl-csl
3439 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3440 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3441 write (iout,*) "coskt and sinkt"
3443 write (iout,*) k,coskt(k),sinkt(k)
3447 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3448 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3451 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3452 & " ethetai",ethetai
3455 write (iout,*) "cosph and sinph"
3457 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3459 write (iout,*) "cosph1ph2 and sinph2ph2"
3462 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3463 & sinph1ph2(l,k),sinph1ph2(k,l)
3466 write(iout,*) "ethetai",ethetai
3470 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3471 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3472 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3473 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3474 ethetai=ethetai+sinkt(m)*aux
3475 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3476 dephii=dephii+k*sinkt(m)*(
3477 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3478 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3479 dephii1=dephii1+k*sinkt(m)*(
3480 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3481 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3483 & write (iout,*) "m",m," k",k," bbthet",
3484 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3485 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3486 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3487 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3491 & write(iout,*) "ethetai",ethetai
3495 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3496 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3497 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3498 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3499 ethetai=ethetai+sinkt(m)*aux
3500 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3501 dephii=dephii+l*sinkt(m)*(
3502 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3503 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3504 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3505 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3506 dephii1=dephii1+(k-l)*sinkt(m)*(
3507 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3508 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3509 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3510 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3512 write (iout,*) "m",m," k",k," l",l," ffthet",
3513 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3514 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3515 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3516 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3517 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3518 & cosph1ph2(k,l)*sinkt(m),
3519 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3525 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3526 & i,theta(i)*rad2deg,phii*rad2deg,
3527 & phii1*rad2deg,ethetai
3528 etheta=etheta+ethetai
3529 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3530 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3531 gloc(nphi+i-2,icg)=wang*dethetai
3537 c-----------------------------------------------------------------------------
3538 subroutine esc(escloc)
3539 C Calculate the local energy of a side chain and its derivatives in the
3540 C corresponding virtual-bond valence angles THETA and the spherical angles
3542 implicit real*8 (a-h,o-z)
3543 include 'DIMENSIONS'
3544 include 'DIMENSIONS.ZSCOPT'
3545 include 'COMMON.GEO'
3546 include 'COMMON.LOCAL'
3547 include 'COMMON.VAR'
3548 include 'COMMON.INTERACT'
3549 include 'COMMON.DERIV'
3550 include 'COMMON.CHAIN'
3551 include 'COMMON.IOUNITS'
3552 include 'COMMON.NAMES'
3553 include 'COMMON.FFIELD'
3554 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3555 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3556 common /sccalc/ time11,time12,time112,theti,it,nlobit
3559 c write (iout,'(a)') 'ESC'
3560 do i=loc_start,loc_end
3562 if (it.eq.10) goto 1
3564 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3565 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3566 theti=theta(i+1)-pipol
3570 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3572 if (x(2).gt.pi-delta) then
3576 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3578 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3579 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3581 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3582 & ddersc0(1),dersc(1))
3583 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3584 & ddersc0(3),dersc(3))
3586 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3588 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3589 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3590 & dersc0(2),esclocbi,dersc02)
3591 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3593 call splinthet(x(2),0.5d0*delta,ss,ssd)
3598 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3600 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3601 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3603 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3605 c write (iout,*) escloci
3606 else if (x(2).lt.delta) then
3610 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3612 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3613 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3615 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3616 & ddersc0(1),dersc(1))
3617 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3618 & ddersc0(3),dersc(3))
3620 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3622 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3623 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3624 & dersc0(2),esclocbi,dersc02)
3625 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3630 call splinthet(x(2),0.5d0*delta,ss,ssd)
3632 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3634 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3635 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3637 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3638 c write (iout,*) escloci
3640 call enesc(x,escloci,dersc,ddummy,.false.)
3643 escloc=escloc+escloci
3644 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3646 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3648 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3649 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3654 C---------------------------------------------------------------------------
3655 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3656 implicit real*8 (a-h,o-z)
3657 include 'DIMENSIONS'
3658 include 'COMMON.GEO'
3659 include 'COMMON.LOCAL'
3660 include 'COMMON.IOUNITS'
3661 common /sccalc/ time11,time12,time112,theti,it,nlobit
3662 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3663 double precision contr(maxlob,-1:1)
3665 c write (iout,*) 'it=',it,' nlobit=',nlobit
3669 if (mixed) ddersc(j)=0.0d0
3673 C Because of periodicity of the dependence of the SC energy in omega we have
3674 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3675 C To avoid underflows, first compute & store the exponents.
3683 z(k)=x(k)-censc(k,j,it)
3688 Axk=Axk+gaussc(l,k,j,it)*z(l)
3694 expfac=expfac+Ax(k,j,iii)*z(k)
3702 C As in the case of ebend, we want to avoid underflows in exponentiation and
3703 C subsequent NaNs and INFs in energy calculation.
3704 C Find the largest exponent
3708 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3712 cd print *,'it=',it,' emin=',emin
3714 C Compute the contribution to SC energy and derivatives
3718 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3719 cd print *,'j=',j,' expfac=',expfac
3720 escloc_i=escloc_i+expfac
3722 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3726 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3727 & +gaussc(k,2,j,it))*expfac
3734 dersc(1)=dersc(1)/cos(theti)**2
3735 ddersc(1)=ddersc(1)/cos(theti)**2
3738 escloci=-(dlog(escloc_i)-emin)
3740 dersc(j)=dersc(j)/escloc_i
3744 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3749 C------------------------------------------------------------------------------
3750 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3751 implicit real*8 (a-h,o-z)
3752 include 'DIMENSIONS'
3753 include 'COMMON.GEO'
3754 include 'COMMON.LOCAL'
3755 include 'COMMON.IOUNITS'
3756 common /sccalc/ time11,time12,time112,theti,it,nlobit
3757 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3758 double precision contr(maxlob)
3769 z(k)=x(k)-censc(k,j,it)
3775 Axk=Axk+gaussc(l,k,j,it)*z(l)
3781 expfac=expfac+Ax(k,j)*z(k)
3786 C As in the case of ebend, we want to avoid underflows in exponentiation and
3787 C subsequent NaNs and INFs in energy calculation.
3788 C Find the largest exponent
3791 if (emin.gt.contr(j)) emin=contr(j)
3795 C Compute the contribution to SC energy and derivatives
3799 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3800 escloc_i=escloc_i+expfac
3802 dersc(k)=dersc(k)+Ax(k,j)*expfac
3804 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3805 & +gaussc(1,2,j,it))*expfac
3809 dersc(1)=dersc(1)/cos(theti)**2
3810 dersc12=dersc12/cos(theti)**2
3811 escloci=-(dlog(escloc_i)-emin)
3813 dersc(j)=dersc(j)/escloc_i
3815 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3819 c----------------------------------------------------------------------------------
3820 subroutine esc(escloc)
3821 C Calculate the local energy of a side chain and its derivatives in the
3822 C corresponding virtual-bond valence angles THETA and the spherical angles
3823 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3824 C added by Urszula Kozlowska. 07/11/2007
3826 implicit real*8 (a-h,o-z)
3827 include 'DIMENSIONS'
3828 include 'DIMENSIONS.ZSCOPT'
3829 include 'COMMON.GEO'
3830 include 'COMMON.LOCAL'
3831 include 'COMMON.VAR'
3832 include 'COMMON.SCROT'
3833 include 'COMMON.INTERACT'
3834 include 'COMMON.DERIV'
3835 include 'COMMON.CHAIN'
3836 include 'COMMON.IOUNITS'
3837 include 'COMMON.NAMES'
3838 include 'COMMON.FFIELD'
3839 include 'COMMON.CONTROL'
3840 include 'COMMON.VECTORS'
3841 double precision x_prime(3),y_prime(3),z_prime(3)
3842 & , sumene,dsc_i,dp2_i,x(65),
3843 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3844 & de_dxx,de_dyy,de_dzz,de_dt
3845 double precision s1_t,s1_6_t,s2_t,s2_6_t
3847 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3848 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3849 & dt_dCi(3),dt_dCi1(3)
3850 common /sccalc/ time11,time12,time112,theti,it,nlobit
3853 do i=loc_start,loc_end
3854 costtab(i+1) =dcos(theta(i+1))
3855 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3856 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3857 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3858 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3859 cosfac=dsqrt(cosfac2)
3860 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3861 sinfac=dsqrt(sinfac2)
3863 if (it.eq.10) goto 1
3865 C Compute the axes of tghe local cartesian coordinates system; store in
3866 c x_prime, y_prime and z_prime
3873 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3874 C & dc_norm(3,i+nres)
3876 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3877 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3880 z_prime(j) = -uz(j,i-1)
3883 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3884 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3885 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3886 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3887 c & " xy",scalar(x_prime(1),y_prime(1)),
3888 c & " xz",scalar(x_prime(1),z_prime(1)),
3889 c & " yy",scalar(y_prime(1),y_prime(1)),
3890 c & " yz",scalar(y_prime(1),z_prime(1)),
3891 c & " zz",scalar(z_prime(1),z_prime(1))
3893 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3894 C to local coordinate system. Store in xx, yy, zz.
3900 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3901 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3902 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3909 C Compute the energy of the ith side cbain
3911 c write (2,*) "xx",xx," yy",yy," zz",zz
3914 x(j) = sc_parmin(j,it)
3917 Cc diagnostics - remove later
3919 yy1 = dsin(alph(2))*dcos(omeg(2))
3920 zz1 = -dsin(alph(2))*dsin(omeg(2))
3921 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3922 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3924 C," --- ", xx_w,yy_w,zz_w
3927 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3928 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3930 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3931 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3933 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3934 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3935 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3936 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3937 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3939 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3940 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3941 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3942 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3943 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3945 dsc_i = 0.743d0+x(61)
3947 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3948 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3949 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3950 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3951 s1=(1+x(63))/(0.1d0 + dscp1)
3952 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3953 s2=(1+x(65))/(0.1d0 + dscp2)
3954 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3955 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3956 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3957 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3959 c & dscp1,dscp2,sumene
3960 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3961 escloc = escloc + sumene
3962 c write (2,*) "escloc",escloc
3963 if (.not. calc_grad) goto 1
3966 C This section to check the numerical derivatives of the energy of ith side
3967 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3968 C #define DEBUG in the code to turn it on.
3970 write (2,*) "sumene =",sumene
3974 write (2,*) xx,yy,zz
3975 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3976 de_dxx_num=(sumenep-sumene)/aincr
3978 write (2,*) "xx+ sumene from enesc=",sumenep
3981 write (2,*) xx,yy,zz
3982 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3983 de_dyy_num=(sumenep-sumene)/aincr
3985 write (2,*) "yy+ sumene from enesc=",sumenep
3988 write (2,*) xx,yy,zz
3989 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3990 de_dzz_num=(sumenep-sumene)/aincr
3992 write (2,*) "zz+ sumene from enesc=",sumenep
3993 costsave=cost2tab(i+1)
3994 sintsave=sint2tab(i+1)
3995 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3996 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3997 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3998 de_dt_num=(sumenep-sumene)/aincr
3999 write (2,*) " t+ sumene from enesc=",sumenep
4000 cost2tab(i+1)=costsave
4001 sint2tab(i+1)=sintsave
4002 C End of diagnostics section.
4005 C Compute the gradient of esc
4007 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4008 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4009 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4010 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4011 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4012 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4013 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4014 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4015 pom1=(sumene3*sint2tab(i+1)+sumene1)
4016 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4017 pom2=(sumene4*cost2tab(i+1)+sumene2)
4018 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4019 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4020 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4021 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4023 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4024 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4025 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4027 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4028 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4029 & +(pom1+pom2)*pom_dx
4031 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4034 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4035 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4036 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4038 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4039 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4040 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4041 & +x(59)*zz**2 +x(60)*xx*zz
4042 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4043 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4044 & +(pom1-pom2)*pom_dy
4046 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4049 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4050 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4051 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4052 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4053 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4054 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4055 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4056 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4058 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4061 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4062 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4063 & +pom1*pom_dt1+pom2*pom_dt2
4065 write(2,*), "de_dt = ", de_dt,de_dt_num
4069 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4070 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4071 cosfac2xx=cosfac2*xx
4072 sinfac2yy=sinfac2*yy
4074 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4076 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4078 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4079 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4080 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4081 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4082 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4083 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4084 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4085 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4086 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4087 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4091 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4092 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4095 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4096 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4097 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4099 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4100 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4104 dXX_Ctab(k,i)=dXX_Ci(k)
4105 dXX_C1tab(k,i)=dXX_Ci1(k)
4106 dYY_Ctab(k,i)=dYY_Ci(k)
4107 dYY_C1tab(k,i)=dYY_Ci1(k)
4108 dZZ_Ctab(k,i)=dZZ_Ci(k)
4109 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4110 dXX_XYZtab(k,i)=dXX_XYZ(k)
4111 dYY_XYZtab(k,i)=dYY_XYZ(k)
4112 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4116 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4117 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4118 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4119 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4120 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4122 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4123 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4124 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4125 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4126 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4127 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4128 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4129 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4131 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4132 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4134 C to check gradient call subroutine check_grad
4141 c------------------------------------------------------------------------------
4142 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4144 C This procedure calculates two-body contact function g(rij) and its derivative:
4147 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4150 C where x=(rij-r0ij)/delta
4152 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4155 double precision rij,r0ij,eps0ij,fcont,fprimcont
4156 double precision x,x2,x4,delta
4160 if (x.lt.-1.0D0) then
4163 else if (x.le.1.0D0) then
4166 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4167 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4174 c------------------------------------------------------------------------------
4175 subroutine splinthet(theti,delta,ss,ssder)
4176 implicit real*8 (a-h,o-z)
4177 include 'DIMENSIONS'
4178 include 'DIMENSIONS.ZSCOPT'
4179 include 'COMMON.VAR'
4180 include 'COMMON.GEO'
4183 if (theti.gt.pipol) then
4184 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4186 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4191 c------------------------------------------------------------------------------
4192 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4194 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4195 double precision ksi,ksi2,ksi3,a1,a2,a3
4196 a1=fprim0*delta/(f1-f0)
4202 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4203 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4206 c------------------------------------------------------------------------------
4207 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4209 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4210 double precision ksi,ksi2,ksi3,a1,a2,a3
4215 a2=3*(f1x-f0x)-2*fprim0x*delta
4216 a3=fprim0x*delta-2*(f1x-f0x)
4217 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4220 C-----------------------------------------------------------------------------
4222 C-----------------------------------------------------------------------------
4223 subroutine etor(etors,edihcnstr,fact)
4224 implicit real*8 (a-h,o-z)
4225 include 'DIMENSIONS'
4226 include 'DIMENSIONS.ZSCOPT'
4227 include 'COMMON.VAR'
4228 include 'COMMON.GEO'
4229 include 'COMMON.LOCAL'
4230 include 'COMMON.TORSION'
4231 include 'COMMON.INTERACT'
4232 include 'COMMON.DERIV'
4233 include 'COMMON.CHAIN'
4234 include 'COMMON.NAMES'
4235 include 'COMMON.IOUNITS'
4236 include 'COMMON.FFIELD'
4237 include 'COMMON.TORCNSTR'
4239 C Set lprn=.true. for debugging
4243 do i=iphi_start,iphi_end
4244 itori=itortyp(itype(i-2))
4245 itori1=itortyp(itype(i-1))
4248 C Proline-Proline pair is a special case...
4249 if (itori.eq.3 .and. itori1.eq.3) then
4250 if (phii.gt.-dwapi3) then
4252 fac=1.0D0/(1.0D0-cosphi)
4253 etorsi=v1(1,3,3)*fac
4254 etorsi=etorsi+etorsi
4255 etors=etors+etorsi-v1(1,3,3)
4256 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4259 v1ij=v1(j+1,itori,itori1)
4260 v2ij=v2(j+1,itori,itori1)
4263 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4264 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4268 v1ij=v1(j,itori,itori1)
4269 v2ij=v2(j,itori,itori1)
4272 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4273 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4277 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4278 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4279 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4280 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4281 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4283 ! 6/20/98 - dihedral angle constraints
4286 itori=idih_constr(i)
4289 if (difi.gt.drange(i)) then
4291 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4292 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4293 else if (difi.lt.-drange(i)) then
4295 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4296 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4298 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4299 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4301 ! write (iout,*) 'edihcnstr',edihcnstr
4304 c------------------------------------------------------------------------------
4306 subroutine etor(etors,edihcnstr,fact)
4307 implicit real*8 (a-h,o-z)
4308 include 'DIMENSIONS'
4309 include 'DIMENSIONS.ZSCOPT'
4310 include 'COMMON.VAR'
4311 include 'COMMON.GEO'
4312 include 'COMMON.LOCAL'
4313 include 'COMMON.TORSION'
4314 include 'COMMON.INTERACT'
4315 include 'COMMON.DERIV'
4316 include 'COMMON.CHAIN'
4317 include 'COMMON.NAMES'
4318 include 'COMMON.IOUNITS'
4319 include 'COMMON.FFIELD'
4320 include 'COMMON.TORCNSTR'
4322 C Set lprn=.true. for debugging
4326 do i=iphi_start,iphi_end
4327 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4328 itori=itortyp(itype(i-2))
4329 itori1=itortyp(itype(i-1))
4332 C Regular cosine and sine terms
4333 do j=1,nterm(itori,itori1)
4334 v1ij=v1(j,itori,itori1)
4335 v2ij=v2(j,itori,itori1)
4338 etors=etors+v1ij*cosphi+v2ij*sinphi
4339 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4343 C E = SUM ----------------------------------- - v1
4344 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4346 cosphi=dcos(0.5d0*phii)
4347 sinphi=dsin(0.5d0*phii)
4348 do j=1,nlor(itori,itori1)
4349 vl1ij=vlor1(j,itori,itori1)
4350 vl2ij=vlor2(j,itori,itori1)
4351 vl3ij=vlor3(j,itori,itori1)
4352 pom=vl2ij*cosphi+vl3ij*sinphi
4353 pom1=1.0d0/(pom*pom+1.0d0)
4354 etors=etors+vl1ij*pom1
4356 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4358 C Subtract the constant term
4359 etors=etors-v0(itori,itori1)
4361 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4362 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4363 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4364 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4365 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4368 ! 6/20/98 - dihedral angle constraints
4371 itori=idih_constr(i)
4373 difi=pinorm(phii-phi0(i))
4375 if (difi.gt.drange(i)) then
4377 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4378 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4379 edihi=0.25d0*ftors*difi**4
4380 else if (difi.lt.-drange(i)) then
4382 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4383 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4384 edihi=0.25d0*ftors*difi**4
4388 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4390 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4391 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4393 ! write (iout,*) 'edihcnstr',edihcnstr
4396 c----------------------------------------------------------------------------
4397 subroutine etor_d(etors_d,fact2)
4398 C 6/23/01 Compute double torsional energy
4399 implicit real*8 (a-h,o-z)
4400 include 'DIMENSIONS'
4401 include 'DIMENSIONS.ZSCOPT'
4402 include 'COMMON.VAR'
4403 include 'COMMON.GEO'
4404 include 'COMMON.LOCAL'
4405 include 'COMMON.TORSION'
4406 include 'COMMON.INTERACT'
4407 include 'COMMON.DERIV'
4408 include 'COMMON.CHAIN'
4409 include 'COMMON.NAMES'
4410 include 'COMMON.IOUNITS'
4411 include 'COMMON.FFIELD'
4412 include 'COMMON.TORCNSTR'
4414 C Set lprn=.true. for debugging
4418 do i=iphi_start,iphi_end-1
4419 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4421 itori=itortyp(itype(i-2))
4422 itori1=itortyp(itype(i-1))
4423 itori2=itortyp(itype(i))
4428 C Regular cosine and sine terms
4429 do j=1,ntermd_1(itori,itori1,itori2)
4430 v1cij=v1c(1,j,itori,itori1,itori2)
4431 v1sij=v1s(1,j,itori,itori1,itori2)
4432 v2cij=v1c(2,j,itori,itori1,itori2)
4433 v2sij=v1s(2,j,itori,itori1,itori2)
4434 cosphi1=dcos(j*phii)
4435 sinphi1=dsin(j*phii)
4436 cosphi2=dcos(j*phii1)
4437 sinphi2=dsin(j*phii1)
4438 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4439 & v2cij*cosphi2+v2sij*sinphi2
4440 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4441 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4443 do k=2,ntermd_2(itori,itori1,itori2)
4445 v1cdij = v2c(k,l,itori,itori1,itori2)
4446 v2cdij = v2c(l,k,itori,itori1,itori2)
4447 v1sdij = v2s(k,l,itori,itori1,itori2)
4448 v2sdij = v2s(l,k,itori,itori1,itori2)
4449 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4450 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4451 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4452 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4453 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4454 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4455 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4456 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4457 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4458 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4461 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4462 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4468 c------------------------------------------------------------------------------
4469 subroutine eback_sc_corr(esccor)
4470 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4471 c conformational states; temporarily implemented as differences
4472 c between UNRES torsional potentials (dependent on three types of
4473 c residues) and the torsional potentials dependent on all 20 types
4474 c of residues computed from AM1 energy surfaces of terminally-blocked
4475 c amino-acid residues.
4476 implicit real*8 (a-h,o-z)
4477 include 'DIMENSIONS'
4478 include 'DIMENSIONS.ZSCOPT'
4479 include 'COMMON.VAR'
4480 include 'COMMON.GEO'
4481 include 'COMMON.LOCAL'
4482 include 'COMMON.TORSION'
4483 include 'COMMON.SCCOR'
4484 include 'COMMON.INTERACT'
4485 include 'COMMON.DERIV'
4486 include 'COMMON.CHAIN'
4487 include 'COMMON.NAMES'
4488 include 'COMMON.IOUNITS'
4489 include 'COMMON.FFIELD'
4490 include 'COMMON.CONTROL'
4492 C Set lprn=.true. for debugging
4495 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4497 do i=itau_start,itau_end
4499 isccori=isccortyp(itype(i-2))
4500 isccori1=isccortyp(itype(i-1))
4502 cccc Added 9 May 2012
4503 cc Tauangle is torsional engle depending on the value of first digit
4504 c(see comment below)
4505 cc Omicron is flat angle depending on the value of first digit
4506 c(see comment below)
4509 do intertyp=1,3 !intertyp
4510 cc Added 09 May 2012 (Adasko)
4511 cc Intertyp means interaction type of backbone mainchain correlation:
4512 c 1 = SC...Ca...Ca...Ca
4513 c 2 = Ca...Ca...Ca...SC
4514 c 3 = SC...Ca...Ca...SCi
4516 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4517 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4518 & (itype(i-1).eq.21)))
4519 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4520 & .or.(itype(i-2).eq.21)))
4521 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4522 & (itype(i-1).eq.21)))) cycle
4523 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4524 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4526 do j=1,nterm_sccor(isccori,isccori1)
4527 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4528 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4529 cosphi=dcos(j*tauangle(intertyp,i))
4530 sinphi=dsin(j*tauangle(intertyp,i))
4531 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4532 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4534 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4535 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4536 c &gloc_sc(intertyp,i-3,icg)
4538 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4539 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4540 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4541 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4542 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4546 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4550 c------------------------------------------------------------------------------
4551 subroutine multibody(ecorr)
4552 C This subroutine calculates multi-body contributions to energy following
4553 C the idea of Skolnick et al. If side chains I and J make a contact and
4554 C at the same time side chains I+1 and J+1 make a contact, an extra
4555 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4556 implicit real*8 (a-h,o-z)
4557 include 'DIMENSIONS'
4558 include 'COMMON.IOUNITS'
4559 include 'COMMON.DERIV'
4560 include 'COMMON.INTERACT'
4561 include 'COMMON.CONTACTS'
4562 double precision gx(3),gx1(3)
4565 C Set lprn=.true. for debugging
4569 write (iout,'(a)') 'Contact function values:'
4571 write (iout,'(i2,20(1x,i2,f10.5))')
4572 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4587 num_conti=num_cont(i)
4588 num_conti1=num_cont(i1)
4593 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4594 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4595 cd & ' ishift=',ishift
4596 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4597 C The system gains extra energy.
4598 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4599 endif ! j1==j+-ishift
4608 c------------------------------------------------------------------------------
4609 double precision function esccorr(i,j,k,l,jj,kk)
4610 implicit real*8 (a-h,o-z)
4611 include 'DIMENSIONS'
4612 include 'COMMON.IOUNITS'
4613 include 'COMMON.DERIV'
4614 include 'COMMON.INTERACT'
4615 include 'COMMON.CONTACTS'
4616 double precision gx(3),gx1(3)
4621 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4622 C Calculate the multi-body contribution to energy.
4623 C Calculate multi-body contributions to the gradient.
4624 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4625 cd & k,l,(gacont(m,kk,k),m=1,3)
4627 gx(m) =ekl*gacont(m,jj,i)
4628 gx1(m)=eij*gacont(m,kk,k)
4629 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4630 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4631 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4632 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4636 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4641 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4647 c------------------------------------------------------------------------------
4649 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 integer dimen1,dimen2,atom,indx
4653 double precision buffer(dimen1,dimen2)
4654 double precision zapas
4655 common /contacts_hb/ zapas(3,20,maxres,7),
4656 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4657 & num_cont_hb(maxres),jcont_hb(20,maxres)
4658 num_kont=num_cont_hb(atom)
4662 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4665 buffer(i,indx+22)=facont_hb(i,atom)
4666 buffer(i,indx+23)=ees0p(i,atom)
4667 buffer(i,indx+24)=ees0m(i,atom)
4668 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4670 buffer(1,indx+26)=dfloat(num_kont)
4673 c------------------------------------------------------------------------------
4674 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4675 implicit real*8 (a-h,o-z)
4676 include 'DIMENSIONS'
4677 integer dimen1,dimen2,atom,indx
4678 double precision buffer(dimen1,dimen2)
4679 double precision zapas
4680 common /contacts_hb/ zapas(3,20,maxres,7),
4681 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4682 & num_cont_hb(maxres),jcont_hb(20,maxres)
4683 num_kont=buffer(1,indx+26)
4684 num_kont_old=num_cont_hb(atom)
4685 num_cont_hb(atom)=num_kont+num_kont_old
4690 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4693 facont_hb(ii,atom)=buffer(i,indx+22)
4694 ees0p(ii,atom)=buffer(i,indx+23)
4695 ees0m(ii,atom)=buffer(i,indx+24)
4696 jcont_hb(ii,atom)=buffer(i,indx+25)
4700 c------------------------------------------------------------------------------
4702 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4703 C This subroutine calculates multi-body contributions to hydrogen-bonding
4704 implicit real*8 (a-h,o-z)
4705 include 'DIMENSIONS'
4706 include 'DIMENSIONS.ZSCOPT'
4707 include 'COMMON.IOUNITS'
4709 include 'COMMON.INFO'
4711 include 'COMMON.FFIELD'
4712 include 'COMMON.DERIV'
4713 include 'COMMON.INTERACT'
4714 include 'COMMON.CONTACTS'
4716 parameter (max_cont=maxconts)
4717 parameter (max_dim=2*(8*3+2))
4718 parameter (msglen1=max_cont*max_dim*4)
4719 parameter (msglen2=2*msglen1)
4720 integer source,CorrelType,CorrelID,Error
4721 double precision buffer(max_cont,max_dim)
4723 double precision gx(3),gx1(3)
4726 C Set lprn=.true. for debugging
4731 if (fgProcs.le.1) goto 30
4733 write (iout,'(a)') 'Contact function values:'
4735 write (iout,'(2i3,50(1x,i2,f5.2))')
4736 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4737 & j=1,num_cont_hb(i))
4740 C Caution! Following code assumes that electrostatic interactions concerning
4741 C a given atom are split among at most two processors!
4751 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4754 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4755 if (MyRank.gt.0) then
4756 C Send correlation contributions to the preceding processor
4758 nn=num_cont_hb(iatel_s)
4759 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4760 cd write (iout,*) 'The BUFFER array:'
4762 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4764 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4766 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4767 C Clear the contacts of the atom passed to the neighboring processor
4768 nn=num_cont_hb(iatel_s+1)
4770 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4772 num_cont_hb(iatel_s)=0
4774 cd write (iout,*) 'Processor ',MyID,MyRank,
4775 cd & ' is sending correlation contribution to processor',MyID-1,
4776 cd & ' msglen=',msglen
4777 cd write (*,*) 'Processor ',MyID,MyRank,
4778 cd & ' is sending correlation contribution to processor',MyID-1,
4779 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4780 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4781 cd write (iout,*) 'Processor ',MyID,
4782 cd & ' has sent correlation contribution to processor',MyID-1,
4783 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4784 cd write (*,*) 'Processor ',MyID,
4785 cd & ' has sent correlation contribution to processor',MyID-1,
4786 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4788 endif ! (MyRank.gt.0)
4792 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4793 if (MyRank.lt.fgProcs-1) then
4794 C Receive correlation contributions from the next processor
4796 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4797 cd write (iout,*) 'Processor',MyID,
4798 cd & ' is receiving correlation contribution from processor',MyID+1,
4799 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4800 cd write (*,*) 'Processor',MyID,
4801 cd & ' is receiving correlation contribution from processor',MyID+1,
4802 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4804 do while (nbytes.le.0)
4805 call mp_probe(MyID+1,CorrelType,nbytes)
4807 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4808 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4809 cd write (iout,*) 'Processor',MyID,
4810 cd & ' has received correlation contribution from processor',MyID+1,
4811 cd & ' msglen=',msglen,' nbytes=',nbytes
4812 cd write (iout,*) 'The received BUFFER array:'
4814 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4816 if (msglen.eq.msglen1) then
4817 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4818 else if (msglen.eq.msglen2) then
4819 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4820 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4823 & 'ERROR!!!! message length changed while processing correlations.'
4825 & 'ERROR!!!! message length changed while processing correlations.'
4826 call mp_stopall(Error)
4827 endif ! msglen.eq.msglen1
4828 endif ! MyRank.lt.fgProcs-1
4835 write (iout,'(a)') 'Contact function values:'
4837 write (iout,'(2i3,50(1x,i2,f5.2))')
4838 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4839 & j=1,num_cont_hb(i))
4843 C Remove the loop below after debugging !!!
4850 C Calculate the local-electrostatic correlation terms
4851 do i=iatel_s,iatel_e+1
4853 num_conti=num_cont_hb(i)
4854 num_conti1=num_cont_hb(i+1)
4859 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4860 c & ' jj=',jj,' kk=',kk
4861 if (j1.eq.j+1 .or. j1.eq.j-1) then
4862 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4863 C The system gains extra energy.
4864 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4866 else if (j1.eq.j) then
4867 C Contacts I-J and I-(J+1) occur simultaneously.
4868 C The system loses extra energy.
4869 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4874 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4875 c & ' jj=',jj,' kk=',kk
4877 C Contacts I-J and (I+1)-J occur simultaneously.
4878 C The system loses extra energy.
4879 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4886 c------------------------------------------------------------------------------
4887 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4889 C This subroutine calculates multi-body contributions to hydrogen-bonding
4890 implicit real*8 (a-h,o-z)
4891 include 'DIMENSIONS'
4892 include 'DIMENSIONS.ZSCOPT'
4893 include 'COMMON.IOUNITS'
4895 include 'COMMON.INFO'
4897 include 'COMMON.FFIELD'
4898 include 'COMMON.DERIV'
4899 include 'COMMON.INTERACT'
4900 include 'COMMON.CONTACTS'
4902 parameter (max_cont=maxconts)
4903 parameter (max_dim=2*(8*3+2))
4904 parameter (msglen1=max_cont*max_dim*4)
4905 parameter (msglen2=2*msglen1)
4906 integer source,CorrelType,CorrelID,Error
4907 double precision buffer(max_cont,max_dim)
4909 double precision gx(3),gx1(3)
4912 C Set lprn=.true. for debugging
4918 if (fgProcs.le.1) goto 30
4920 write (iout,'(a)') 'Contact function values:'
4922 write (iout,'(2i3,50(1x,i2,f5.2))')
4923 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4924 & j=1,num_cont_hb(i))
4927 C Caution! Following code assumes that electrostatic interactions concerning
4928 C a given atom are split among at most two processors!
4938 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4941 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4942 if (MyRank.gt.0) then
4943 C Send correlation contributions to the preceding processor
4945 nn=num_cont_hb(iatel_s)
4946 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4947 cd write (iout,*) 'The BUFFER array:'
4949 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4951 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4953 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4954 C Clear the contacts of the atom passed to the neighboring processor
4955 nn=num_cont_hb(iatel_s+1)
4957 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4959 num_cont_hb(iatel_s)=0
4961 cd write (iout,*) 'Processor ',MyID,MyRank,
4962 cd & ' is sending correlation contribution to processor',MyID-1,
4963 cd & ' msglen=',msglen
4964 cd write (*,*) 'Processor ',MyID,MyRank,
4965 cd & ' is sending correlation contribution to processor',MyID-1,
4966 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4967 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4968 cd write (iout,*) 'Processor ',MyID,
4969 cd & ' has sent correlation contribution to processor',MyID-1,
4970 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4971 cd write (*,*) 'Processor ',MyID,
4972 cd & ' has sent correlation contribution to processor',MyID-1,
4973 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4975 endif ! (MyRank.gt.0)
4979 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4980 if (MyRank.lt.fgProcs-1) then
4981 C Receive correlation contributions from the next processor
4983 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4984 cd write (iout,*) 'Processor',MyID,
4985 cd & ' is receiving correlation contribution from processor',MyID+1,
4986 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4987 cd write (*,*) 'Processor',MyID,
4988 cd & ' is receiving correlation contribution from processor',MyID+1,
4989 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4991 do while (nbytes.le.0)
4992 call mp_probe(MyID+1,CorrelType,nbytes)
4994 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4995 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4996 cd write (iout,*) 'Processor',MyID,
4997 cd & ' has received correlation contribution from processor',MyID+1,
4998 cd & ' msglen=',msglen,' nbytes=',nbytes
4999 cd write (iout,*) 'The received BUFFER array:'
5001 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5003 if (msglen.eq.msglen1) then
5004 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5005 else if (msglen.eq.msglen2) then
5006 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5007 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5010 & 'ERROR!!!! message length changed while processing correlations.'
5012 & 'ERROR!!!! message length changed while processing correlations.'
5013 call mp_stopall(Error)
5014 endif ! msglen.eq.msglen1
5015 endif ! MyRank.lt.fgProcs-1
5022 write (iout,'(a)') 'Contact function values:'
5024 write (iout,'(2i3,50(1x,i2,f5.2))')
5025 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5026 & j=1,num_cont_hb(i))
5032 C Remove the loop below after debugging !!!
5039 C Calculate the dipole-dipole interaction energies
5040 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5041 do i=iatel_s,iatel_e+1
5042 num_conti=num_cont_hb(i)
5049 C Calculate the local-electrostatic correlation terms
5050 do i=iatel_s,iatel_e+1
5052 num_conti=num_cont_hb(i)
5053 num_conti1=num_cont_hb(i+1)
5058 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5059 c & ' jj=',jj,' kk=',kk
5060 if (j1.eq.j+1 .or. j1.eq.j-1) then
5061 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5062 C The system gains extra energy.
5064 sqd1=dsqrt(d_cont(jj,i))
5065 sqd2=dsqrt(d_cont(kk,i1))
5066 sred_geom = sqd1*sqd2
5067 IF (sred_geom.lt.cutoff_corr) THEN
5068 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5070 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5071 c & ' jj=',jj,' kk=',kk
5072 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5073 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5075 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5076 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5079 cd write (iout,*) 'sred_geom=',sred_geom,
5080 cd & ' ekont=',ekont,' fprim=',fprimcont
5081 call calc_eello(i,j,i+1,j1,jj,kk)
5082 if (wcorr4.gt.0.0d0)
5083 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5084 if (wcorr5.gt.0.0d0)
5085 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5086 c print *,"wcorr5",ecorr5
5087 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5088 cd write(2,*)'ijkl',i,j,i+1,j1
5089 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5090 & .or. wturn6.eq.0.0d0))then
5091 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5092 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5093 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5094 cd & 'ecorr6=',ecorr6
5095 cd write (iout,'(4e15.5)') sred_geom,
5096 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5097 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5098 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5099 else if (wturn6.gt.0.0d0
5100 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5101 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5102 eturn6=eturn6+eello_turn6(i,jj,kk)
5103 cd write (2,*) 'multibody_eello:eturn6',eturn6
5107 else if (j1.eq.j) then
5108 C Contacts I-J and I-(J+1) occur simultaneously.
5109 C The system loses extra energy.
5110 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5115 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5116 c & ' jj=',jj,' kk=',kk
5118 C Contacts I-J and (I+1)-J occur simultaneously.
5119 C The system loses extra energy.
5120 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5127 c------------------------------------------------------------------------------
5128 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5129 implicit real*8 (a-h,o-z)
5130 include 'DIMENSIONS'
5131 include 'COMMON.IOUNITS'
5132 include 'COMMON.DERIV'
5133 include 'COMMON.INTERACT'
5134 include 'COMMON.CONTACTS'
5135 double precision gx(3),gx1(3)
5145 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5146 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5147 C Following 4 lines for diagnostics.
5152 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5154 c write (iout,*)'Contacts have occurred for peptide groups',
5155 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5156 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5157 C Calculate the multi-body contribution to energy.
5158 ecorr=ecorr+ekont*ees
5160 C Calculate multi-body contributions to the gradient.
5162 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5163 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5164 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5165 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5166 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5167 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5168 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5169 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5170 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5171 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5172 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5173 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5174 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5175 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5179 gradcorr(ll,m)=gradcorr(ll,m)+
5180 & ees*ekl*gacont_hbr(ll,jj,i)-
5181 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5182 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5187 gradcorr(ll,m)=gradcorr(ll,m)+
5188 & ees*eij*gacont_hbr(ll,kk,k)-
5189 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5190 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5197 C---------------------------------------------------------------------------
5198 subroutine dipole(i,j,jj)
5199 implicit real*8 (a-h,o-z)
5200 include 'DIMENSIONS'
5201 include 'DIMENSIONS.ZSCOPT'
5202 include 'COMMON.IOUNITS'
5203 include 'COMMON.CHAIN'
5204 include 'COMMON.FFIELD'
5205 include 'COMMON.DERIV'
5206 include 'COMMON.INTERACT'
5207 include 'COMMON.CONTACTS'
5208 include 'COMMON.TORSION'
5209 include 'COMMON.VAR'
5210 include 'COMMON.GEO'
5211 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5213 iti1 = itortyp(itype(i+1))
5214 if (j.lt.nres-1) then
5215 itj1 = itortyp(itype(j+1))
5220 dipi(iii,1)=Ub2(iii,i)
5221 dipderi(iii)=Ub2der(iii,i)
5222 dipi(iii,2)=b1(iii,iti1)
5223 dipj(iii,1)=Ub2(iii,j)
5224 dipderj(iii)=Ub2der(iii,j)
5225 dipj(iii,2)=b1(iii,itj1)
5229 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5232 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5235 if (.not.calc_grad) return
5240 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5244 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5249 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5250 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5252 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5254 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5256 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5260 C---------------------------------------------------------------------------
5261 subroutine calc_eello(i,j,k,l,jj,kk)
5263 C This subroutine computes matrices and vectors needed to calculate
5264 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5266 implicit real*8 (a-h,o-z)
5267 include 'DIMENSIONS'
5268 include 'DIMENSIONS.ZSCOPT'
5269 include 'COMMON.IOUNITS'
5270 include 'COMMON.CHAIN'
5271 include 'COMMON.DERIV'
5272 include 'COMMON.INTERACT'
5273 include 'COMMON.CONTACTS'
5274 include 'COMMON.TORSION'
5275 include 'COMMON.VAR'
5276 include 'COMMON.GEO'
5277 include 'COMMON.FFIELD'
5278 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5279 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5282 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5283 cd & ' jj=',jj,' kk=',kk
5284 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5287 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5288 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5291 call transpose2(aa1(1,1),aa1t(1,1))
5292 call transpose2(aa2(1,1),aa2t(1,1))
5295 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5296 & aa1tder(1,1,lll,kkk))
5297 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5298 & aa2tder(1,1,lll,kkk))
5302 C parallel orientation of the two CA-CA-CA frames.
5304 iti=itortyp(itype(i))
5308 itk1=itortyp(itype(k+1))
5309 itj=itortyp(itype(j))
5310 if (l.lt.nres-1) then
5311 itl1=itortyp(itype(l+1))
5315 C A1 kernel(j+1) A2T
5317 cd write (iout,'(3f10.5,5x,3f10.5)')
5318 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5320 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5321 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5322 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5323 C Following matrices are needed only for 6-th order cumulants
5324 IF (wcorr6.gt.0.0d0) THEN
5325 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5326 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5327 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5328 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5329 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5330 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5331 & ADtEAderx(1,1,1,1,1,1))
5333 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5334 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5335 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5336 & ADtEA1derx(1,1,1,1,1,1))
5338 C End 6-th order cumulants
5341 cd write (2,*) 'In calc_eello6'
5343 cd write (2,*) 'iii=',iii
5345 cd write (2,*) 'kkk=',kkk
5347 cd write (2,'(3(2f10.5),5x)')
5348 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5353 call transpose2(EUgder(1,1,k),auxmat(1,1))
5354 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5355 call transpose2(EUg(1,1,k),auxmat(1,1))
5356 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5357 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5361 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5362 & EAEAderx(1,1,lll,kkk,iii,1))
5366 C A1T kernel(i+1) A2
5367 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5368 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5369 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5370 C Following matrices are needed only for 6-th order cumulants
5371 IF (wcorr6.gt.0.0d0) THEN
5372 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5373 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5374 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5375 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5376 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5377 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5378 & ADtEAderx(1,1,1,1,1,2))
5379 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5380 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5381 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5382 & ADtEA1derx(1,1,1,1,1,2))
5384 C End 6-th order cumulants
5385 call transpose2(EUgder(1,1,l),auxmat(1,1))
5386 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5387 call transpose2(EUg(1,1,l),auxmat(1,1))
5388 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5389 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5393 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5394 & EAEAderx(1,1,lll,kkk,iii,2))
5399 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5400 C They are needed only when the fifth- or the sixth-order cumulants are
5402 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5403 call transpose2(AEA(1,1,1),auxmat(1,1))
5404 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5405 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5406 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5407 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5408 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5409 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5410 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5411 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5412 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5413 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5414 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5415 call transpose2(AEA(1,1,2),auxmat(1,1))
5416 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5417 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5418 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5419 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5420 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5421 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5422 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5423 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5424 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5425 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5426 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5427 C Calculate the Cartesian derivatives of the vectors.
5431 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5432 call matvec2(auxmat(1,1),b1(1,iti),
5433 & AEAb1derx(1,lll,kkk,iii,1,1))
5434 call matvec2(auxmat(1,1),Ub2(1,i),
5435 & AEAb2derx(1,lll,kkk,iii,1,1))
5436 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5437 & AEAb1derx(1,lll,kkk,iii,2,1))
5438 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5439 & AEAb2derx(1,lll,kkk,iii,2,1))
5440 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5441 call matvec2(auxmat(1,1),b1(1,itj),
5442 & AEAb1derx(1,lll,kkk,iii,1,2))
5443 call matvec2(auxmat(1,1),Ub2(1,j),
5444 & AEAb2derx(1,lll,kkk,iii,1,2))
5445 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5446 & AEAb1derx(1,lll,kkk,iii,2,2))
5447 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5448 & AEAb2derx(1,lll,kkk,iii,2,2))
5455 C Antiparallel orientation of the two CA-CA-CA frames.
5457 iti=itortyp(itype(i))
5461 itk1=itortyp(itype(k+1))
5462 itl=itortyp(itype(l))
5463 itj=itortyp(itype(j))
5464 if (j.lt.nres-1) then
5465 itj1=itortyp(itype(j+1))
5469 C A2 kernel(j-1)T A1T
5470 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5471 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5472 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5473 C Following matrices are needed only for 6-th order cumulants
5474 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5475 & j.eq.i+4 .and. l.eq.i+3)) THEN
5476 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5477 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5478 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5479 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5480 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5481 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5482 & ADtEAderx(1,1,1,1,1,1))
5483 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5484 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5485 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5486 & ADtEA1derx(1,1,1,1,1,1))
5488 C End 6-th order cumulants
5489 call transpose2(EUgder(1,1,k),auxmat(1,1))
5490 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5491 call transpose2(EUg(1,1,k),auxmat(1,1))
5492 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5493 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5497 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5498 & EAEAderx(1,1,lll,kkk,iii,1))
5502 C A2T kernel(i+1)T A1
5503 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5504 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5505 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5506 C Following matrices are needed only for 6-th order cumulants
5507 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5508 & j.eq.i+4 .and. l.eq.i+3)) THEN
5509 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5510 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5511 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5512 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5513 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5514 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5515 & ADtEAderx(1,1,1,1,1,2))
5516 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5517 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5518 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5519 & ADtEA1derx(1,1,1,1,1,2))
5521 C End 6-th order cumulants
5522 call transpose2(EUgder(1,1,j),auxmat(1,1))
5523 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5524 call transpose2(EUg(1,1,j),auxmat(1,1))
5525 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5526 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5530 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5531 & EAEAderx(1,1,lll,kkk,iii,2))
5536 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5537 C They are needed only when the fifth- or the sixth-order cumulants are
5539 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5540 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5541 call transpose2(AEA(1,1,1),auxmat(1,1))
5542 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5543 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5544 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5545 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5546 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5547 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5548 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5549 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5550 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5551 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5552 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5553 call transpose2(AEA(1,1,2),auxmat(1,1))
5554 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5555 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5556 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5557 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5558 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5559 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5560 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5561 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5562 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5563 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5564 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5565 C Calculate the Cartesian derivatives of the vectors.
5569 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5570 call matvec2(auxmat(1,1),b1(1,iti),
5571 & AEAb1derx(1,lll,kkk,iii,1,1))
5572 call matvec2(auxmat(1,1),Ub2(1,i),
5573 & AEAb2derx(1,lll,kkk,iii,1,1))
5574 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5575 & AEAb1derx(1,lll,kkk,iii,2,1))
5576 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5577 & AEAb2derx(1,lll,kkk,iii,2,1))
5578 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5579 call matvec2(auxmat(1,1),b1(1,itl),
5580 & AEAb1derx(1,lll,kkk,iii,1,2))
5581 call matvec2(auxmat(1,1),Ub2(1,l),
5582 & AEAb2derx(1,lll,kkk,iii,1,2))
5583 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5584 & AEAb1derx(1,lll,kkk,iii,2,2))
5585 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5586 & AEAb2derx(1,lll,kkk,iii,2,2))
5595 C---------------------------------------------------------------------------
5596 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5597 & KK,KKderg,AKA,AKAderg,AKAderx)
5601 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5602 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5603 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5608 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5610 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5613 cd if (lprn) write (2,*) 'In kernel'
5615 cd if (lprn) write (2,*) 'kkk=',kkk
5617 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5618 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5620 cd write (2,*) 'lll=',lll
5621 cd write (2,*) 'iii=1'
5623 cd write (2,'(3(2f10.5),5x)')
5624 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5627 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5628 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5630 cd write (2,*) 'lll=',lll
5631 cd write (2,*) 'iii=2'
5633 cd write (2,'(3(2f10.5),5x)')
5634 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5641 C---------------------------------------------------------------------------
5642 double precision function eello4(i,j,k,l,jj,kk)
5643 implicit real*8 (a-h,o-z)
5644 include 'DIMENSIONS'
5645 include 'DIMENSIONS.ZSCOPT'
5646 include 'COMMON.IOUNITS'
5647 include 'COMMON.CHAIN'
5648 include 'COMMON.DERIV'
5649 include 'COMMON.INTERACT'
5650 include 'COMMON.CONTACTS'
5651 include 'COMMON.TORSION'
5652 include 'COMMON.VAR'
5653 include 'COMMON.GEO'
5654 double precision pizda(2,2),ggg1(3),ggg2(3)
5655 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5659 cd print *,'eello4:',i,j,k,l,jj,kk
5660 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5661 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5662 cold eij=facont_hb(jj,i)
5663 cold ekl=facont_hb(kk,k)
5665 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5667 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5668 gcorr_loc(k-1)=gcorr_loc(k-1)
5669 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5671 gcorr_loc(l-1)=gcorr_loc(l-1)
5672 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5674 gcorr_loc(j-1)=gcorr_loc(j-1)
5675 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5680 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5681 & -EAEAderx(2,2,lll,kkk,iii,1)
5682 cd derx(lll,kkk,iii)=0.0d0
5686 cd gcorr_loc(l-1)=0.0d0
5687 cd gcorr_loc(j-1)=0.0d0
5688 cd gcorr_loc(k-1)=0.0d0
5690 cd write (iout,*)'Contacts have occurred for peptide groups',
5691 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5692 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5693 if (j.lt.nres-1) then
5700 if (l.lt.nres-1) then
5708 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5709 ggg1(ll)=eel4*g_contij(ll,1)
5710 ggg2(ll)=eel4*g_contij(ll,2)
5711 ghalf=0.5d0*ggg1(ll)
5713 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5714 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5715 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5716 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5717 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5718 ghalf=0.5d0*ggg2(ll)
5720 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5721 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5722 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5723 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5728 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5729 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5734 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5735 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5741 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5746 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5750 cd write (2,*) iii,gcorr_loc(iii)
5754 cd write (2,*) 'ekont',ekont
5755 cd write (iout,*) 'eello4',ekont*eel4
5758 C---------------------------------------------------------------------------
5759 double precision function eello5(i,j,k,l,jj,kk)
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'DIMENSIONS.ZSCOPT'
5763 include 'COMMON.IOUNITS'
5764 include 'COMMON.CHAIN'
5765 include 'COMMON.DERIV'
5766 include 'COMMON.INTERACT'
5767 include 'COMMON.CONTACTS'
5768 include 'COMMON.TORSION'
5769 include 'COMMON.VAR'
5770 include 'COMMON.GEO'
5771 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5772 double precision ggg1(3),ggg2(3)
5773 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5778 C /l\ / \ \ / \ / \ / C
5779 C / \ / \ \ / \ / \ / C
5780 C j| o |l1 | o | o| o | | o |o C
5781 C \ |/k\| |/ \| / |/ \| |/ \| C
5782 C \i/ \ / \ / / \ / \ C
5784 C (I) (II) (III) (IV) C
5786 C eello5_1 eello5_2 eello5_3 eello5_4 C
5788 C Antiparallel chains C
5791 C /j\ / \ \ / \ / \ / C
5792 C / \ / \ \ / \ / \ / C
5793 C j1| o |l | o | o| o | | o |o C
5794 C \ |/k\| |/ \| / |/ \| |/ \| C
5795 C \i/ \ / \ / / \ / \ C
5797 C (I) (II) (III) (IV) C
5799 C eello5_1 eello5_2 eello5_3 eello5_4 C
5801 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5804 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5809 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5811 itk=itortyp(itype(k))
5812 itl=itortyp(itype(l))
5813 itj=itortyp(itype(j))
5818 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5819 cd & eel5_3_num,eel5_4_num)
5823 derx(lll,kkk,iii)=0.0d0
5827 cd eij=facont_hb(jj,i)
5828 cd ekl=facont_hb(kk,k)
5830 cd write (iout,*)'Contacts have occurred for peptide groups',
5831 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5833 C Contribution from the graph I.
5834 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5835 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5836 call transpose2(EUg(1,1,k),auxmat(1,1))
5837 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5838 vv(1)=pizda(1,1)-pizda(2,2)
5839 vv(2)=pizda(1,2)+pizda(2,1)
5840 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5841 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5843 C Explicit gradient in virtual-dihedral angles.
5844 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5845 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5846 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5847 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5848 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5849 vv(1)=pizda(1,1)-pizda(2,2)
5850 vv(2)=pizda(1,2)+pizda(2,1)
5851 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5852 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5853 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5854 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5855 vv(1)=pizda(1,1)-pizda(2,2)
5856 vv(2)=pizda(1,2)+pizda(2,1)
5858 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5859 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5860 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5862 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5863 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5864 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5866 C Cartesian gradient
5870 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5872 vv(1)=pizda(1,1)-pizda(2,2)
5873 vv(2)=pizda(1,2)+pizda(2,1)
5874 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5875 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5876 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5883 C Contribution from graph II
5884 call transpose2(EE(1,1,itk),auxmat(1,1))
5885 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5886 vv(1)=pizda(1,1)+pizda(2,2)
5887 vv(2)=pizda(2,1)-pizda(1,2)
5888 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5889 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5891 C Explicit gradient in virtual-dihedral angles.
5892 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5893 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5894 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5895 vv(1)=pizda(1,1)+pizda(2,2)
5896 vv(2)=pizda(2,1)-pizda(1,2)
5898 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5899 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5900 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5902 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5903 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5904 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5906 C Cartesian gradient
5910 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5912 vv(1)=pizda(1,1)+pizda(2,2)
5913 vv(2)=pizda(2,1)-pizda(1,2)
5914 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5915 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5916 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5925 C Parallel orientation
5926 C Contribution from graph III
5927 call transpose2(EUg(1,1,l),auxmat(1,1))
5928 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5929 vv(1)=pizda(1,1)-pizda(2,2)
5930 vv(2)=pizda(1,2)+pizda(2,1)
5931 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5932 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5934 C Explicit gradient in virtual-dihedral angles.
5935 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5936 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5937 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5938 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5939 vv(1)=pizda(1,1)-pizda(2,2)
5940 vv(2)=pizda(1,2)+pizda(2,1)
5941 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5942 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5944 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5945 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5946 vv(1)=pizda(1,1)-pizda(2,2)
5947 vv(2)=pizda(1,2)+pizda(2,1)
5948 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5949 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5950 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5951 C Cartesian gradient
5955 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5957 vv(1)=pizda(1,1)-pizda(2,2)
5958 vv(2)=pizda(1,2)+pizda(2,1)
5959 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5960 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5961 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5967 C Contribution from graph IV
5969 call transpose2(EE(1,1,itl),auxmat(1,1))
5970 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5971 vv(1)=pizda(1,1)+pizda(2,2)
5972 vv(2)=pizda(2,1)-pizda(1,2)
5973 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5974 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5976 C Explicit gradient in virtual-dihedral angles.
5977 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5978 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5979 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5980 vv(1)=pizda(1,1)+pizda(2,2)
5981 vv(2)=pizda(2,1)-pizda(1,2)
5982 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5983 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5984 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5985 C Cartesian gradient
5989 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5994 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5995 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6001 C Antiparallel orientation
6002 C Contribution from graph III
6004 call transpose2(EUg(1,1,j),auxmat(1,1))
6005 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6006 vv(1)=pizda(1,1)-pizda(2,2)
6007 vv(2)=pizda(1,2)+pizda(2,1)
6008 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6009 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6011 C Explicit gradient in virtual-dihedral angles.
6012 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6013 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6014 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6015 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6016 vv(1)=pizda(1,1)-pizda(2,2)
6017 vv(2)=pizda(1,2)+pizda(2,1)
6018 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6019 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6020 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6021 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6022 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6023 vv(1)=pizda(1,1)-pizda(2,2)
6024 vv(2)=pizda(1,2)+pizda(2,1)
6025 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6026 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6027 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6028 C Cartesian gradient
6032 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6034 vv(1)=pizda(1,1)-pizda(2,2)
6035 vv(2)=pizda(1,2)+pizda(2,1)
6036 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6037 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6038 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6044 C Contribution from graph IV
6046 call transpose2(EE(1,1,itj),auxmat(1,1))
6047 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6048 vv(1)=pizda(1,1)+pizda(2,2)
6049 vv(2)=pizda(2,1)-pizda(1,2)
6050 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6051 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6053 C Explicit gradient in virtual-dihedral angles.
6054 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6055 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6056 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6057 vv(1)=pizda(1,1)+pizda(2,2)
6058 vv(2)=pizda(2,1)-pizda(1,2)
6059 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6060 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6061 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6062 C Cartesian gradient
6066 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6068 vv(1)=pizda(1,1)+pizda(2,2)
6069 vv(2)=pizda(2,1)-pizda(1,2)
6070 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6071 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6072 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6079 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6080 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6081 cd write (2,*) 'ijkl',i,j,k,l
6082 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6083 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6085 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6086 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6087 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6088 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6090 if (j.lt.nres-1) then
6097 if (l.lt.nres-1) then
6107 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6109 ggg1(ll)=eel5*g_contij(ll,1)
6110 ggg2(ll)=eel5*g_contij(ll,2)
6111 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6112 ghalf=0.5d0*ggg1(ll)
6114 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6115 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6116 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6117 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6118 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6119 ghalf=0.5d0*ggg2(ll)
6121 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6122 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6123 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6124 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6129 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6130 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6135 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6136 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6142 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6147 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6151 cd write (2,*) iii,g_corr5_loc(iii)
6155 cd write (2,*) 'ekont',ekont
6156 cd write (iout,*) 'eello5',ekont*eel5
6159 c--------------------------------------------------------------------------
6160 double precision function eello6(i,j,k,l,jj,kk)
6161 implicit real*8 (a-h,o-z)
6162 include 'DIMENSIONS'
6163 include 'DIMENSIONS.ZSCOPT'
6164 include 'COMMON.IOUNITS'
6165 include 'COMMON.CHAIN'
6166 include 'COMMON.DERIV'
6167 include 'COMMON.INTERACT'
6168 include 'COMMON.CONTACTS'
6169 include 'COMMON.TORSION'
6170 include 'COMMON.VAR'
6171 include 'COMMON.GEO'
6172 include 'COMMON.FFIELD'
6173 double precision ggg1(3),ggg2(3)
6174 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6179 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6187 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6188 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6192 derx(lll,kkk,iii)=0.0d0
6196 cd eij=facont_hb(jj,i)
6197 cd ekl=facont_hb(kk,k)
6203 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6204 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6205 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6206 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6207 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6208 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6210 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6211 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6212 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6213 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6214 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6215 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6219 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6221 C If turn contributions are considered, they will be handled separately.
6222 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6223 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6224 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6225 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6226 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6227 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6228 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6231 if (j.lt.nres-1) then
6238 if (l.lt.nres-1) then
6246 ggg1(ll)=eel6*g_contij(ll,1)
6247 ggg2(ll)=eel6*g_contij(ll,2)
6248 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6249 ghalf=0.5d0*ggg1(ll)
6251 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6252 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6253 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6254 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6255 ghalf=0.5d0*ggg2(ll)
6256 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6258 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6259 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6260 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6261 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6266 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6267 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6272 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6273 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6279 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6284 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6288 cd write (2,*) iii,g_corr6_loc(iii)
6292 cd write (2,*) 'ekont',ekont
6293 cd write (iout,*) 'eello6',ekont*eel6
6296 c--------------------------------------------------------------------------
6297 double precision function eello6_graph1(i,j,k,l,imat,swap)
6298 implicit real*8 (a-h,o-z)
6299 include 'DIMENSIONS'
6300 include 'DIMENSIONS.ZSCOPT'
6301 include 'COMMON.IOUNITS'
6302 include 'COMMON.CHAIN'
6303 include 'COMMON.DERIV'
6304 include 'COMMON.INTERACT'
6305 include 'COMMON.CONTACTS'
6306 include 'COMMON.TORSION'
6307 include 'COMMON.VAR'
6308 include 'COMMON.GEO'
6309 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6313 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6315 C Parallel Antiparallel
6321 C \ j|/k\| / \ |/k\|l /
6326 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6327 itk=itortyp(itype(k))
6328 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6329 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6330 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6331 call transpose2(EUgC(1,1,k),auxmat(1,1))
6332 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6333 vv1(1)=pizda1(1,1)-pizda1(2,2)
6334 vv1(2)=pizda1(1,2)+pizda1(2,1)
6335 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6336 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6337 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6338 s5=scalar2(vv(1),Dtobr2(1,i))
6339 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6340 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6341 if (.not. calc_grad) return
6342 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6343 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6344 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6345 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6346 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6347 & +scalar2(vv(1),Dtobr2der(1,i)))
6348 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6349 vv1(1)=pizda1(1,1)-pizda1(2,2)
6350 vv1(2)=pizda1(1,2)+pizda1(2,1)
6351 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6352 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6354 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6355 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6356 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6357 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6358 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6360 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6361 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6362 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6363 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6364 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6366 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6367 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6368 vv1(1)=pizda1(1,1)-pizda1(2,2)
6369 vv1(2)=pizda1(1,2)+pizda1(2,1)
6370 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6371 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6372 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6373 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6382 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6383 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6384 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6385 call transpose2(EUgC(1,1,k),auxmat(1,1))
6386 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6388 vv1(1)=pizda1(1,1)-pizda1(2,2)
6389 vv1(2)=pizda1(1,2)+pizda1(2,1)
6390 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6391 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6392 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6393 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6394 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6395 s5=scalar2(vv(1),Dtobr2(1,i))
6396 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6402 c----------------------------------------------------------------------------
6403 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6404 implicit real*8 (a-h,o-z)
6405 include 'DIMENSIONS'
6406 include 'DIMENSIONS.ZSCOPT'
6407 include 'COMMON.IOUNITS'
6408 include 'COMMON.CHAIN'
6409 include 'COMMON.DERIV'
6410 include 'COMMON.INTERACT'
6411 include 'COMMON.CONTACTS'
6412 include 'COMMON.TORSION'
6413 include 'COMMON.VAR'
6414 include 'COMMON.GEO'
6416 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6417 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6420 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6422 C Parallel Antiparallel
6433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6434 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6435 C AL 7/4/01 s1 would occur in the sixth-order moment,
6436 C but not in a cluster cumulant
6438 s1=dip(1,jj,i)*dip(1,kk,k)
6440 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6441 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6442 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6443 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6444 call transpose2(EUg(1,1,k),auxmat(1,1))
6445 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6446 vv(1)=pizda(1,1)-pizda(2,2)
6447 vv(2)=pizda(1,2)+pizda(2,1)
6448 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6449 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6451 eello6_graph2=-(s1+s2+s3+s4)
6453 eello6_graph2=-(s2+s3+s4)
6456 if (.not. calc_grad) return
6457 C Derivatives in gamma(i-1)
6460 s1=dipderg(1,jj,i)*dip(1,kk,k)
6462 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6463 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6464 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6465 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6467 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6469 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6471 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6473 C Derivatives in gamma(k-1)
6475 s1=dip(1,jj,i)*dipderg(1,kk,k)
6477 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6478 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6479 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6480 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6481 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6482 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6483 vv(1)=pizda(1,1)-pizda(2,2)
6484 vv(2)=pizda(1,2)+pizda(2,1)
6485 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6487 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6489 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6491 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6492 C Derivatives in gamma(j-1) or gamma(l-1)
6495 s1=dipderg(3,jj,i)*dip(1,kk,k)
6497 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6498 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6499 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6500 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6501 vv(1)=pizda(1,1)-pizda(2,2)
6502 vv(2)=pizda(1,2)+pizda(2,1)
6503 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6506 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6508 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6511 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6512 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6514 C Derivatives in gamma(l-1) or gamma(j-1)
6517 s1=dip(1,jj,i)*dipderg(3,kk,k)
6519 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6521 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6522 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6523 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6524 vv(1)=pizda(1,1)-pizda(2,2)
6525 vv(2)=pizda(1,2)+pizda(2,1)
6526 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6529 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6531 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6534 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6535 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6537 C Cartesian derivatives.
6539 write (2,*) 'In eello6_graph2'
6541 write (2,*) 'iii=',iii
6543 write (2,*) 'kkk=',kkk
6545 write (2,'(3(2f10.5),5x)')
6546 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6556 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6558 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6561 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6563 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6564 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6566 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6567 call transpose2(EUg(1,1,k),auxmat(1,1))
6568 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6570 vv(1)=pizda(1,1)-pizda(2,2)
6571 vv(2)=pizda(1,2)+pizda(2,1)
6572 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6573 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6575 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6577 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6580 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6582 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6589 c----------------------------------------------------------------------------
6590 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6591 implicit real*8 (a-h,o-z)
6592 include 'DIMENSIONS'
6593 include 'DIMENSIONS.ZSCOPT'
6594 include 'COMMON.IOUNITS'
6595 include 'COMMON.CHAIN'
6596 include 'COMMON.DERIV'
6597 include 'COMMON.INTERACT'
6598 include 'COMMON.CONTACTS'
6599 include 'COMMON.TORSION'
6600 include 'COMMON.VAR'
6601 include 'COMMON.GEO'
6602 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6604 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6606 C Parallel Antiparallel
6617 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6619 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6620 C energy moment and not to the cluster cumulant.
6621 iti=itortyp(itype(i))
6622 if (j.lt.nres-1) then
6623 itj1=itortyp(itype(j+1))
6627 itk=itortyp(itype(k))
6628 itk1=itortyp(itype(k+1))
6629 if (l.lt.nres-1) then
6630 itl1=itortyp(itype(l+1))
6635 s1=dip(4,jj,i)*dip(4,kk,k)
6637 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6638 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6639 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6640 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6641 call transpose2(EE(1,1,itk),auxmat(1,1))
6642 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6643 vv(1)=pizda(1,1)+pizda(2,2)
6644 vv(2)=pizda(2,1)-pizda(1,2)
6645 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6646 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6648 eello6_graph3=-(s1+s2+s3+s4)
6650 eello6_graph3=-(s2+s3+s4)
6653 if (.not. calc_grad) return
6654 C Derivatives in gamma(k-1)
6655 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6656 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6657 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6658 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6659 C Derivatives in gamma(l-1)
6660 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6661 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6662 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6663 vv(1)=pizda(1,1)+pizda(2,2)
6664 vv(2)=pizda(2,1)-pizda(1,2)
6665 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6666 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6667 C Cartesian derivatives.
6673 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6675 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6678 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6680 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6681 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6683 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6684 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6686 vv(1)=pizda(1,1)+pizda(2,2)
6687 vv(2)=pizda(2,1)-pizda(1,2)
6688 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6695 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6697 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6699 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6705 c----------------------------------------------------------------------------
6706 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6707 implicit real*8 (a-h,o-z)
6708 include 'DIMENSIONS'
6709 include 'DIMENSIONS.ZSCOPT'
6710 include 'COMMON.IOUNITS'
6711 include 'COMMON.CHAIN'
6712 include 'COMMON.DERIV'
6713 include 'COMMON.INTERACT'
6714 include 'COMMON.CONTACTS'
6715 include 'COMMON.TORSION'
6716 include 'COMMON.VAR'
6717 include 'COMMON.GEO'
6718 include 'COMMON.FFIELD'
6719 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6720 & auxvec1(2),auxmat1(2,2)
6722 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6724 C Parallel Antiparallel
6735 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6737 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6738 C energy moment and not to the cluster cumulant.
6739 cd write (2,*) 'eello_graph4: wturn6',wturn6
6740 iti=itortyp(itype(i))
6741 itj=itortyp(itype(j))
6742 if (j.lt.nres-1) then
6743 itj1=itortyp(itype(j+1))
6747 itk=itortyp(itype(k))
6748 if (k.lt.nres-1) then
6749 itk1=itortyp(itype(k+1))
6753 itl=itortyp(itype(l))
6754 if (l.lt.nres-1) then
6755 itl1=itortyp(itype(l+1))
6759 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6760 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6761 cd & ' itl',itl,' itl1',itl1
6764 s1=dip(3,jj,i)*dip(3,kk,k)
6766 s1=dip(2,jj,j)*dip(2,kk,l)
6769 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6770 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6772 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6773 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6775 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6776 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6778 call transpose2(EUg(1,1,k),auxmat(1,1))
6779 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6780 vv(1)=pizda(1,1)-pizda(2,2)
6781 vv(2)=pizda(2,1)+pizda(1,2)
6782 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6783 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6785 eello6_graph4=-(s1+s2+s3+s4)
6787 eello6_graph4=-(s2+s3+s4)
6789 if (.not. calc_grad) return
6790 C Derivatives in gamma(i-1)
6794 s1=dipderg(2,jj,i)*dip(3,kk,k)
6796 s1=dipderg(4,jj,j)*dip(2,kk,l)
6799 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6801 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6802 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6804 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6805 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6807 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6808 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6809 cd write (2,*) 'turn6 derivatives'
6811 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6813 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6817 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6819 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6823 C Derivatives in gamma(k-1)
6826 s1=dip(3,jj,i)*dipderg(2,kk,k)
6828 s1=dip(2,jj,j)*dipderg(4,kk,l)
6831 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6832 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6834 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6835 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6837 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6838 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6840 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6841 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6842 vv(1)=pizda(1,1)-pizda(2,2)
6843 vv(2)=pizda(2,1)+pizda(1,2)
6844 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6845 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6847 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6849 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6853 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6855 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6858 C Derivatives in gamma(j-1) or gamma(l-1)
6859 if (l.eq.j+1 .and. l.gt.1) then
6860 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6861 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6862 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6863 vv(1)=pizda(1,1)-pizda(2,2)
6864 vv(2)=pizda(2,1)+pizda(1,2)
6865 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6866 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6867 else if (j.gt.1) then
6868 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6869 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6870 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6871 vv(1)=pizda(1,1)-pizda(2,2)
6872 vv(2)=pizda(2,1)+pizda(1,2)
6873 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6874 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6875 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6877 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6880 C Cartesian derivatives.
6887 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6889 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6893 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6895 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6899 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6901 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6903 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6904 & b1(1,itj1),auxvec(1))
6905 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6907 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6908 & b1(1,itl1),auxvec(1))
6909 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6911 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6913 vv(1)=pizda(1,1)-pizda(2,2)
6914 vv(2)=pizda(2,1)+pizda(1,2)
6915 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6917 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6919 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6922 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6925 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6928 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6930 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6932 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6936 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6938 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6941 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6943 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6951 c----------------------------------------------------------------------------
6952 double precision function eello_turn6(i,jj,kk)
6953 implicit real*8 (a-h,o-z)
6954 include 'DIMENSIONS'
6955 include 'DIMENSIONS.ZSCOPT'
6956 include 'COMMON.IOUNITS'
6957 include 'COMMON.CHAIN'
6958 include 'COMMON.DERIV'
6959 include 'COMMON.INTERACT'
6960 include 'COMMON.CONTACTS'
6961 include 'COMMON.TORSION'
6962 include 'COMMON.VAR'
6963 include 'COMMON.GEO'
6964 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6965 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6967 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6968 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6969 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6970 C the respective energy moment and not to the cluster cumulant.
6975 iti=itortyp(itype(i))
6976 itk=itortyp(itype(k))
6977 itk1=itortyp(itype(k+1))
6978 itl=itortyp(itype(l))
6979 itj=itortyp(itype(j))
6980 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6981 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6982 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6987 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6989 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6993 derx_turn(lll,kkk,iii)=0.0d0
7000 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7002 cd write (2,*) 'eello6_5',eello6_5
7004 call transpose2(AEA(1,1,1),auxmat(1,1))
7005 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7006 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7007 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7011 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7012 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7013 s2 = scalar2(b1(1,itk),vtemp1(1))
7015 call transpose2(AEA(1,1,2),atemp(1,1))
7016 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7017 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7018 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7022 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7023 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7024 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7026 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7027 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7028 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7029 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7030 ss13 = scalar2(b1(1,itk),vtemp4(1))
7031 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7035 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7041 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7043 C Derivatives in gamma(i+2)
7045 call transpose2(AEA(1,1,1),auxmatd(1,1))
7046 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7047 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7048 call transpose2(AEAderg(1,1,2),atempd(1,1))
7049 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7050 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7054 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7055 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7056 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7062 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7063 C Derivatives in gamma(i+3)
7065 call transpose2(AEA(1,1,1),auxmatd(1,1))
7066 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7067 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7068 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7072 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7073 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7074 s2d = scalar2(b1(1,itk),vtemp1d(1))
7076 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7077 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7079 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7081 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7082 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7083 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7093 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7094 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7096 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7097 & -0.5d0*ekont*(s2d+s12d)
7099 C Derivatives in gamma(i+4)
7100 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7101 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7102 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7104 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7105 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7106 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7116 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7118 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7120 C Derivatives in gamma(i+5)
7122 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7123 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7124 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7128 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7129 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7130 s2d = scalar2(b1(1,itk),vtemp1d(1))
7132 call transpose2(AEA(1,1,2),atempd(1,1))
7133 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7134 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7138 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7139 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7141 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7142 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7143 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7153 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7154 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7156 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7157 & -0.5d0*ekont*(s2d+s12d)
7159 C Cartesian derivatives
7164 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7165 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7166 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7170 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7171 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7173 s2d = scalar2(b1(1,itk),vtemp1d(1))
7175 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7176 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7177 s8d = -(atempd(1,1)+atempd(2,2))*
7178 & scalar2(cc(1,1,itl),vtemp2(1))
7182 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7184 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7185 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7192 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7195 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7199 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7200 & - 0.5d0*(s8d+s12d)
7202 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7211 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7213 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7214 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7215 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7216 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7217 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7219 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7220 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7221 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7225 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7226 cd & 16*eel_turn6_num
7228 if (j.lt.nres-1) then
7235 if (l.lt.nres-1) then
7243 ggg1(ll)=eel_turn6*g_contij(ll,1)
7244 ggg2(ll)=eel_turn6*g_contij(ll,2)
7245 ghalf=0.5d0*ggg1(ll)
7247 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7248 & +ekont*derx_turn(ll,2,1)
7249 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7250 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7251 & +ekont*derx_turn(ll,4,1)
7252 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7253 ghalf=0.5d0*ggg2(ll)
7255 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7256 & +ekont*derx_turn(ll,2,2)
7257 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7258 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7259 & +ekont*derx_turn(ll,4,2)
7260 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7265 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7270 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7276 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7281 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7285 cd write (2,*) iii,g_corr6_loc(iii)
7288 eello_turn6=ekont*eel_turn6
7289 cd write (2,*) 'ekont',ekont
7290 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7293 crc-------------------------------------------------
7294 SUBROUTINE MATVEC2(A1,V1,V2)
7295 implicit real*8 (a-h,o-z)
7296 include 'DIMENSIONS'
7297 DIMENSION A1(2,2),V1(2),V2(2)
7301 c 3 VI=VI+A1(I,K)*V1(K)
7305 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7306 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7311 C---------------------------------------
7312 SUBROUTINE MATMAT2(A1,A2,A3)
7313 implicit real*8 (a-h,o-z)
7314 include 'DIMENSIONS'
7315 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7316 c DIMENSION AI3(2,2)
7320 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7326 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7327 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7328 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7329 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7337 c-------------------------------------------------------------------------
7338 double precision function scalar2(u,v)
7340 double precision u(2),v(2)
7343 scalar2=u(1)*v(1)+u(2)*v(2)
7347 C-----------------------------------------------------------------------------
7349 subroutine transpose2(a,at)
7351 double precision a(2,2),at(2,2)
7358 c--------------------------------------------------------------------------
7359 subroutine transpose(n,a,at)
7362 double precision a(n,n),at(n,n)
7370 C---------------------------------------------------------------------------
7371 subroutine prodmat3(a1,a2,kk,transp,prod)
7374 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7376 crc double precision auxmat(2,2),prod_(2,2)
7379 crc call transpose2(kk(1,1),auxmat(1,1))
7380 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7381 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7383 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7384 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7385 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7386 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7387 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7388 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7389 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7390 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7393 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7394 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7396 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7397 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7398 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7399 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7400 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7401 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7402 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7403 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7406 c call transpose2(a2(1,1),a2t(1,1))
7409 crc print *,((prod_(i,j),i=1,2),j=1,2)
7410 crc print *,((prod(i,j),i=1,2),j=1,2)
7414 C-----------------------------------------------------------------------------
7415 double precision function scalar(u,v)
7417 double precision u(3),v(3)