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 'COMMON.SBRIDGE'
2873 include 'COMMON.CHAIN'
2874 include 'COMMON.DERIV'
2875 include 'COMMON.VAR'
2876 include 'COMMON.INTERACT'
2877 include 'COMMON.IOUNITS'
2880 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2881 cd write(iout,*)'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 write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2897 c & dhpb(i),dhpb1(i),forcon(i)
2898 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2899 C distance and angle dependent SS bond potential.
2900 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2901 call ssbond_ene(iii,jjj,eij)
2903 cd write (iout,*) "eij",eij
2904 else if (ii.gt.nres .and. jj.gt.nres) then
2905 c Restraints from contact prediction
2907 if (dhpb1(i).gt.0.0d0) then
2908 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2909 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2910 c write (iout,*) "beta nmr",
2911 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2915 C Get the force constant corresponding to this distance.
2917 C Calculate the contribution to energy.
2918 ehpb=ehpb+waga*rdis*rdis
2919 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2921 C Evaluate gradient.
2926 ggg(j)=fac*(c(j,jj)-c(j,ii))
2929 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2930 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2933 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2934 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2937 C Calculate the distance between the two points and its difference from the
2940 if (dhpb1(i).gt.0.0d0) then
2941 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2942 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2943 c write (iout,*) "alph nmr",
2944 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2947 C Get the force constant corresponding to this distance.
2949 C Calculate the contribution to energy.
2950 ehpb=ehpb+waga*rdis*rdis
2951 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2953 C Evaluate gradient.
2957 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2958 cd & ' waga=',waga,' fac=',fac
2960 ggg(j)=fac*(c(j,jj)-c(j,ii))
2962 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2963 C If this is a SC-SC distance, we need to calculate the contributions to the
2964 C Cartesian gradient in the SC vectors (ghpbx).
2967 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2968 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2972 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2973 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2980 C--------------------------------------------------------------------------
2981 subroutine ssbond_ene(i,j,eij)
2983 C Calculate the distance and angle dependent SS-bond potential energy
2984 C using a free-energy function derived based on RHF/6-31G** ab initio
2985 C calculations of diethyl disulfide.
2987 C A. Liwo and U. Kozlowska, 11/24/03
2989 implicit real*8 (a-h,o-z)
2990 include 'DIMENSIONS'
2991 include 'DIMENSIONS.ZSCOPT'
2992 include 'COMMON.SBRIDGE'
2993 include 'COMMON.CHAIN'
2994 include 'COMMON.DERIV'
2995 include 'COMMON.LOCAL'
2996 include 'COMMON.INTERACT'
2997 include 'COMMON.VAR'
2998 include 'COMMON.IOUNITS'
2999 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3004 dxi=dc_norm(1,nres+i)
3005 dyi=dc_norm(2,nres+i)
3006 dzi=dc_norm(3,nres+i)
3007 dsci_inv=dsc_inv(itypi)
3009 dscj_inv=dsc_inv(itypj)
3013 dxj=dc_norm(1,nres+j)
3014 dyj=dc_norm(2,nres+j)
3015 dzj=dc_norm(3,nres+j)
3016 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3021 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3022 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3023 om12=dxi*dxj+dyi*dyj+dzi*dzj
3025 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3026 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3032 deltat12=om2-om1+2.0d0
3034 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3035 & +akct*deltad*deltat12
3036 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3037 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3038 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3039 c & " deltat12",deltat12," eij",eij
3040 ed=2*akcm*deltad+akct*deltat12
3042 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3043 eom1=-2*akth*deltat1-pom1-om2*pom2
3044 eom2= 2*akth*deltat2+pom1-om1*pom2
3047 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3050 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3051 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3052 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3053 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3056 C Calculate the components of the gradient in DC and X
3060 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3065 C--------------------------------------------------------------------------
3066 subroutine ebond(estr)
3068 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3070 implicit real*8 (a-h,o-z)
3071 include 'DIMENSIONS'
3072 include 'DIMENSIONS.ZSCOPT'
3073 include 'COMMON.LOCAL'
3074 include 'COMMON.GEO'
3075 include 'COMMON.INTERACT'
3076 include 'COMMON.DERIV'
3077 include 'COMMON.VAR'
3078 include 'COMMON.CHAIN'
3079 include 'COMMON.IOUNITS'
3080 include 'COMMON.NAMES'
3081 include 'COMMON.FFIELD'
3082 include 'COMMON.CONTROL'
3083 double precision u(3),ud(3)
3086 diff = vbld(i)-vbldp0
3087 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3090 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3095 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3102 diff=vbld(i+nres)-vbldsc0(1,iti)
3103 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3104 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3105 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3107 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3111 diff=vbld(i+nres)-vbldsc0(j,iti)
3112 ud(j)=aksc(j,iti)*diff
3113 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3127 uprod2=uprod2*u(k)*u(k)
3131 usumsqder=usumsqder+ud(j)*uprod2
3133 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3134 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3135 estr=estr+uprod/usum
3137 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3145 C--------------------------------------------------------------------------
3146 subroutine ebend(etheta)
3148 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3149 C angles gamma and its derivatives in consecutive thetas and gammas.
3151 implicit real*8 (a-h,o-z)
3152 include 'DIMENSIONS'
3153 include 'DIMENSIONS.ZSCOPT'
3154 include 'COMMON.LOCAL'
3155 include 'COMMON.GEO'
3156 include 'COMMON.INTERACT'
3157 include 'COMMON.DERIV'
3158 include 'COMMON.VAR'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.IOUNITS'
3161 include 'COMMON.NAMES'
3162 include 'COMMON.FFIELD'
3163 common /calcthet/ term1,term2,termm,diffak,ratak,
3164 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3165 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3166 double precision y(2),z(2)
3168 time11=dexp(-2*time)
3171 c write (iout,*) "nres",nres
3172 c write (*,'(a,i2)') 'EBEND ICG=',icg
3173 c write (iout,*) ithet_start,ithet_end
3174 do i=ithet_start,ithet_end
3175 C Zero the energy function and its derivative at 0 or pi.
3176 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3178 c if (i.gt.ithet_start .and.
3179 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3180 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3188 c if (i.lt.nres .and. itel(i).ne.0) then
3200 call proc_proc(phii,icrc)
3201 if (icrc.eq.1) phii=150.0
3215 call proc_proc(phii1,icrc)
3216 if (icrc.eq.1) phii1=150.0
3228 C Calculate the "mean" value of theta from the part of the distribution
3229 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3230 C In following comments this theta will be referred to as t_c.
3231 thet_pred_mean=0.0d0
3235 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3237 c write (iout,*) "thet_pred_mean",thet_pred_mean
3238 dthett=thet_pred_mean*ssd
3239 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3240 c write (iout,*) "thet_pred_mean",thet_pred_mean
3241 C Derivatives of the "mean" values in gamma1 and gamma2.
3242 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3243 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3244 if (theta(i).gt.pi-delta) then
3245 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3247 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3248 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3249 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3251 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3253 else if (theta(i).lt.delta) then
3254 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3255 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3256 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3258 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3259 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3262 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3265 etheta=etheta+ethetai
3266 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3267 c & rad2deg*phii,rad2deg*phii1,ethetai
3268 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3269 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3270 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3273 C Ufff.... We've done all this!!!
3276 C---------------------------------------------------------------------------
3277 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3279 implicit real*8 (a-h,o-z)
3280 include 'DIMENSIONS'
3281 include 'COMMON.LOCAL'
3282 include 'COMMON.IOUNITS'
3283 common /calcthet/ term1,term2,termm,diffak,ratak,
3284 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3285 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3286 C Calculate the contributions to both Gaussian lobes.
3287 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3288 C The "polynomial part" of the "standard deviation" of this part of
3292 sig=sig*thet_pred_mean+polthet(j,it)
3294 C Derivative of the "interior part" of the "standard deviation of the"
3295 C gamma-dependent Gaussian lobe in t_c.
3296 sigtc=3*polthet(3,it)
3298 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3301 C Set the parameters of both Gaussian lobes of the distribution.
3302 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3303 fac=sig*sig+sigc0(it)
3306 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3307 sigsqtc=-4.0D0*sigcsq*sigtc
3308 c print *,i,sig,sigtc,sigsqtc
3309 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3310 sigtc=-sigtc/(fac*fac)
3311 C Following variable is sigma(t_c)**(-2)
3312 sigcsq=sigcsq*sigcsq
3314 sig0inv=1.0D0/sig0i**2
3315 delthec=thetai-thet_pred_mean
3316 delthe0=thetai-theta0i
3317 term1=-0.5D0*sigcsq*delthec*delthec
3318 term2=-0.5D0*sig0inv*delthe0*delthe0
3319 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3320 C NaNs in taking the logarithm. We extract the largest exponent which is added
3321 C to the energy (this being the log of the distribution) at the end of energy
3322 C term evaluation for this virtual-bond angle.
3323 if (term1.gt.term2) then
3325 term2=dexp(term2-termm)
3329 term1=dexp(term1-termm)
3332 C The ratio between the gamma-independent and gamma-dependent lobes of
3333 C the distribution is a Gaussian function of thet_pred_mean too.
3334 diffak=gthet(2,it)-thet_pred_mean
3335 ratak=diffak/gthet(3,it)**2
3336 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3337 C Let's differentiate it in thet_pred_mean NOW.
3339 C Now put together the distribution terms to make complete distribution.
3340 termexp=term1+ak*term2
3341 termpre=sigc+ak*sig0i
3342 C Contribution of the bending energy from this theta is just the -log of
3343 C the sum of the contributions from the two lobes and the pre-exponential
3344 C factor. Simple enough, isn't it?
3345 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3346 C NOW the derivatives!!!
3347 C 6/6/97 Take into account the deformation.
3348 E_theta=(delthec*sigcsq*term1
3349 & +ak*delthe0*sig0inv*term2)/termexp
3350 E_tc=((sigtc+aktc*sig0i)/termpre
3351 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3352 & aktc*term2)/termexp)
3355 c-----------------------------------------------------------------------------
3356 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3357 implicit real*8 (a-h,o-z)
3358 include 'DIMENSIONS'
3359 include 'COMMON.LOCAL'
3360 include 'COMMON.IOUNITS'
3361 common /calcthet/ term1,term2,termm,diffak,ratak,
3362 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3363 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3364 delthec=thetai-thet_pred_mean
3365 delthe0=thetai-theta0i
3366 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3367 t3 = thetai-thet_pred_mean
3371 t14 = t12+t6*sigsqtc
3373 t21 = thetai-theta0i
3379 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3380 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3381 & *(-t12*t9-ak*sig0inv*t27)
3385 C--------------------------------------------------------------------------
3386 subroutine ebend(etheta)
3388 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3389 C angles gamma and its derivatives in consecutive thetas and gammas.
3390 C ab initio-derived potentials from
3391 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3393 implicit real*8 (a-h,o-z)
3394 include 'DIMENSIONS'
3395 include 'DIMENSIONS.ZSCOPT'
3396 include 'COMMON.LOCAL'
3397 include 'COMMON.GEO'
3398 include 'COMMON.INTERACT'
3399 include 'COMMON.DERIV'
3400 include 'COMMON.VAR'
3401 include 'COMMON.CHAIN'
3402 include 'COMMON.IOUNITS'
3403 include 'COMMON.NAMES'
3404 include 'COMMON.FFIELD'
3405 include 'COMMON.CONTROL'
3406 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3407 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3408 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3409 & sinph1ph2(maxdouble,maxdouble)
3410 logical lprn /.false./, lprn1 /.false./
3412 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3413 do i=ithet_start,ithet_end
3417 theti2=0.5d0*theta(i)
3418 ityp2=ithetyp(itype(i-1))
3420 coskt(k)=dcos(k*theti2)
3421 sinkt(k)=dsin(k*theti2)
3426 if (phii.ne.phii) phii=150.0
3430 ityp1=ithetyp(itype(i-2))
3432 cosph1(k)=dcos(k*phii)
3433 sinph1(k)=dsin(k*phii)
3446 if (phii1.ne.phii1) phii1=150.0
3451 ityp3=ithetyp(itype(i))
3453 cosph2(k)=dcos(k*phii1)
3454 sinph2(k)=dsin(k*phii1)
3464 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3465 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3467 ethetai=aa0thet(ityp1,ityp2,ityp3)
3470 ccl=cosph1(l)*cosph2(k-l)
3471 ssl=sinph1(l)*sinph2(k-l)
3472 scl=sinph1(l)*cosph2(k-l)
3473 csl=cosph1(l)*sinph2(k-l)
3474 cosph1ph2(l,k)=ccl-ssl
3475 cosph1ph2(k,l)=ccl+ssl
3476 sinph1ph2(l,k)=scl+csl
3477 sinph1ph2(k,l)=scl-csl
3481 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3482 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3483 write (iout,*) "coskt and sinkt"
3485 write (iout,*) k,coskt(k),sinkt(k)
3489 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3490 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3493 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3494 & " ethetai",ethetai
3497 write (iout,*) "cosph and sinph"
3499 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3501 write (iout,*) "cosph1ph2 and sinph2ph2"
3504 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3505 & sinph1ph2(l,k),sinph1ph2(k,l)
3508 write(iout,*) "ethetai",ethetai
3512 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3513 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3514 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3515 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3516 ethetai=ethetai+sinkt(m)*aux
3517 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3518 dephii=dephii+k*sinkt(m)*(
3519 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3520 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3521 dephii1=dephii1+k*sinkt(m)*(
3522 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3523 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3525 & write (iout,*) "m",m," k",k," bbthet",
3526 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3527 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3528 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3529 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3533 & write(iout,*) "ethetai",ethetai
3537 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3538 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3539 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3540 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3541 ethetai=ethetai+sinkt(m)*aux
3542 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3543 dephii=dephii+l*sinkt(m)*(
3544 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3545 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3546 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3547 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3548 dephii1=dephii1+(k-l)*sinkt(m)*(
3549 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3550 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3551 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3552 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3554 write (iout,*) "m",m," k",k," l",l," ffthet",
3555 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3556 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3557 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3558 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3559 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3560 & cosph1ph2(k,l)*sinkt(m),
3561 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3567 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3568 & i,theta(i)*rad2deg,phii*rad2deg,
3569 & phii1*rad2deg,ethetai
3570 etheta=etheta+ethetai
3571 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3572 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3573 gloc(nphi+i-2,icg)=wang*dethetai
3579 c-----------------------------------------------------------------------------
3580 subroutine esc(escloc)
3581 C Calculate the local energy of a side chain and its derivatives in the
3582 C corresponding virtual-bond valence angles THETA and the spherical angles
3584 implicit real*8 (a-h,o-z)
3585 include 'DIMENSIONS'
3586 include 'DIMENSIONS.ZSCOPT'
3587 include 'COMMON.GEO'
3588 include 'COMMON.LOCAL'
3589 include 'COMMON.VAR'
3590 include 'COMMON.INTERACT'
3591 include 'COMMON.DERIV'
3592 include 'COMMON.CHAIN'
3593 include 'COMMON.IOUNITS'
3594 include 'COMMON.NAMES'
3595 include 'COMMON.FFIELD'
3596 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3597 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3598 common /sccalc/ time11,time12,time112,theti,it,nlobit
3601 c write (iout,'(a)') 'ESC'
3602 do i=loc_start,loc_end
3604 if (it.eq.10) goto 1
3606 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3607 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3608 theti=theta(i+1)-pipol
3612 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3614 if (x(2).gt.pi-delta) then
3618 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3620 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3621 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3623 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3624 & ddersc0(1),dersc(1))
3625 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3626 & ddersc0(3),dersc(3))
3628 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3630 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3631 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3632 & dersc0(2),esclocbi,dersc02)
3633 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3635 call splinthet(x(2),0.5d0*delta,ss,ssd)
3640 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3642 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3643 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3645 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3647 c write (iout,*) escloci
3648 else if (x(2).lt.delta) then
3652 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3654 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3655 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3657 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3658 & ddersc0(1),dersc(1))
3659 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3660 & ddersc0(3),dersc(3))
3662 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3664 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3665 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3666 & dersc0(2),esclocbi,dersc02)
3667 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3672 call splinthet(x(2),0.5d0*delta,ss,ssd)
3674 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3676 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3677 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3679 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3680 c write (iout,*) escloci
3682 call enesc(x,escloci,dersc,ddummy,.false.)
3685 escloc=escloc+escloci
3686 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3688 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3690 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3691 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3696 C---------------------------------------------------------------------------
3697 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3698 implicit real*8 (a-h,o-z)
3699 include 'DIMENSIONS'
3700 include 'COMMON.GEO'
3701 include 'COMMON.LOCAL'
3702 include 'COMMON.IOUNITS'
3703 common /sccalc/ time11,time12,time112,theti,it,nlobit
3704 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3705 double precision contr(maxlob,-1:1)
3707 c write (iout,*) 'it=',it,' nlobit=',nlobit
3711 if (mixed) ddersc(j)=0.0d0
3715 C Because of periodicity of the dependence of the SC energy in omega we have
3716 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3717 C To avoid underflows, first compute & store the exponents.
3725 z(k)=x(k)-censc(k,j,it)
3730 Axk=Axk+gaussc(l,k,j,it)*z(l)
3736 expfac=expfac+Ax(k,j,iii)*z(k)
3744 C As in the case of ebend, we want to avoid underflows in exponentiation and
3745 C subsequent NaNs and INFs in energy calculation.
3746 C Find the largest exponent
3750 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3754 cd print *,'it=',it,' emin=',emin
3756 C Compute the contribution to SC energy and derivatives
3760 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3761 cd print *,'j=',j,' expfac=',expfac
3762 escloc_i=escloc_i+expfac
3764 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3768 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3769 & +gaussc(k,2,j,it))*expfac
3776 dersc(1)=dersc(1)/cos(theti)**2
3777 ddersc(1)=ddersc(1)/cos(theti)**2
3780 escloci=-(dlog(escloc_i)-emin)
3782 dersc(j)=dersc(j)/escloc_i
3786 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3791 C------------------------------------------------------------------------------
3792 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3793 implicit real*8 (a-h,o-z)
3794 include 'DIMENSIONS'
3795 include 'COMMON.GEO'
3796 include 'COMMON.LOCAL'
3797 include 'COMMON.IOUNITS'
3798 common /sccalc/ time11,time12,time112,theti,it,nlobit
3799 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3800 double precision contr(maxlob)
3811 z(k)=x(k)-censc(k,j,it)
3817 Axk=Axk+gaussc(l,k,j,it)*z(l)
3823 expfac=expfac+Ax(k,j)*z(k)
3828 C As in the case of ebend, we want to avoid underflows in exponentiation and
3829 C subsequent NaNs and INFs in energy calculation.
3830 C Find the largest exponent
3833 if (emin.gt.contr(j)) emin=contr(j)
3837 C Compute the contribution to SC energy and derivatives
3841 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3842 escloc_i=escloc_i+expfac
3844 dersc(k)=dersc(k)+Ax(k,j)*expfac
3846 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3847 & +gaussc(1,2,j,it))*expfac
3851 dersc(1)=dersc(1)/cos(theti)**2
3852 dersc12=dersc12/cos(theti)**2
3853 escloci=-(dlog(escloc_i)-emin)
3855 dersc(j)=dersc(j)/escloc_i
3857 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3861 c----------------------------------------------------------------------------------
3862 subroutine esc(escloc)
3863 C Calculate the local energy of a side chain and its derivatives in the
3864 C corresponding virtual-bond valence angles THETA and the spherical angles
3865 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3866 C added by Urszula Kozlowska. 07/11/2007
3868 implicit real*8 (a-h,o-z)
3869 include 'DIMENSIONS'
3870 include 'DIMENSIONS.ZSCOPT'
3871 include 'COMMON.GEO'
3872 include 'COMMON.LOCAL'
3873 include 'COMMON.VAR'
3874 include 'COMMON.SCROT'
3875 include 'COMMON.INTERACT'
3876 include 'COMMON.DERIV'
3877 include 'COMMON.CHAIN'
3878 include 'COMMON.IOUNITS'
3879 include 'COMMON.NAMES'
3880 include 'COMMON.FFIELD'
3881 include 'COMMON.CONTROL'
3882 include 'COMMON.VECTORS'
3883 double precision x_prime(3),y_prime(3),z_prime(3)
3884 & , sumene,dsc_i,dp2_i,x(65),
3885 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3886 & de_dxx,de_dyy,de_dzz,de_dt
3887 double precision s1_t,s1_6_t,s2_t,s2_6_t
3889 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3890 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3891 & dt_dCi(3),dt_dCi1(3)
3892 common /sccalc/ time11,time12,time112,theti,it,nlobit
3895 do i=loc_start,loc_end
3896 costtab(i+1) =dcos(theta(i+1))
3897 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3898 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3899 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3900 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3901 cosfac=dsqrt(cosfac2)
3902 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3903 sinfac=dsqrt(sinfac2)
3905 if (it.eq.10) goto 1
3907 C Compute the axes of tghe local cartesian coordinates system; store in
3908 c x_prime, y_prime and z_prime
3915 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3916 C & dc_norm(3,i+nres)
3918 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3919 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3922 z_prime(j) = -uz(j,i-1)
3925 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3926 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3927 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3928 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3929 c & " xy",scalar(x_prime(1),y_prime(1)),
3930 c & " xz",scalar(x_prime(1),z_prime(1)),
3931 c & " yy",scalar(y_prime(1),y_prime(1)),
3932 c & " yz",scalar(y_prime(1),z_prime(1)),
3933 c & " zz",scalar(z_prime(1),z_prime(1))
3935 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3936 C to local coordinate system. Store in xx, yy, zz.
3942 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3943 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3944 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3951 C Compute the energy of the ith side cbain
3953 c write (2,*) "xx",xx," yy",yy," zz",zz
3956 x(j) = sc_parmin(j,it)
3959 Cc diagnostics - remove later
3961 yy1 = dsin(alph(2))*dcos(omeg(2))
3962 zz1 = -dsin(alph(2))*dsin(omeg(2))
3963 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3964 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3966 C," --- ", xx_w,yy_w,zz_w
3969 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3970 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3972 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3973 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3975 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3976 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3977 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3978 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3979 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3981 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3982 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3983 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3984 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3985 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3987 dsc_i = 0.743d0+x(61)
3989 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3990 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3991 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3992 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3993 s1=(1+x(63))/(0.1d0 + dscp1)
3994 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3995 s2=(1+x(65))/(0.1d0 + dscp2)
3996 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3997 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3998 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3999 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4001 c & dscp1,dscp2,sumene
4002 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4003 escloc = escloc + sumene
4004 c write (2,*) "escloc",escloc
4005 if (.not. calc_grad) goto 1
4008 C This section to check the numerical derivatives of the energy of ith side
4009 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4010 C #define DEBUG in the code to turn it on.
4012 write (2,*) "sumene =",sumene
4016 write (2,*) xx,yy,zz
4017 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4018 de_dxx_num=(sumenep-sumene)/aincr
4020 write (2,*) "xx+ sumene from enesc=",sumenep
4023 write (2,*) xx,yy,zz
4024 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4025 de_dyy_num=(sumenep-sumene)/aincr
4027 write (2,*) "yy+ sumene from enesc=",sumenep
4030 write (2,*) xx,yy,zz
4031 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4032 de_dzz_num=(sumenep-sumene)/aincr
4034 write (2,*) "zz+ sumene from enesc=",sumenep
4035 costsave=cost2tab(i+1)
4036 sintsave=sint2tab(i+1)
4037 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4038 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4039 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4040 de_dt_num=(sumenep-sumene)/aincr
4041 write (2,*) " t+ sumene from enesc=",sumenep
4042 cost2tab(i+1)=costsave
4043 sint2tab(i+1)=sintsave
4044 C End of diagnostics section.
4047 C Compute the gradient of esc
4049 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4050 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4051 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4052 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4053 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4054 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4055 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4056 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4057 pom1=(sumene3*sint2tab(i+1)+sumene1)
4058 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4059 pom2=(sumene4*cost2tab(i+1)+sumene2)
4060 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4061 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4062 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4063 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4065 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4066 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4067 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4069 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4070 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4071 & +(pom1+pom2)*pom_dx
4073 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4076 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4077 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4078 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4080 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4081 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4082 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4083 & +x(59)*zz**2 +x(60)*xx*zz
4084 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4085 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4086 & +(pom1-pom2)*pom_dy
4088 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4091 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4092 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4093 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4094 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4095 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4096 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4097 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4098 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4100 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4103 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4104 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4105 & +pom1*pom_dt1+pom2*pom_dt2
4107 write(2,*), "de_dt = ", de_dt,de_dt_num
4111 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4112 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4113 cosfac2xx=cosfac2*xx
4114 sinfac2yy=sinfac2*yy
4116 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4118 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4120 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4121 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4122 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4123 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4124 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4125 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4126 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4127 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4128 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4129 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4133 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4134 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4137 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4138 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4139 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4141 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4142 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4146 dXX_Ctab(k,i)=dXX_Ci(k)
4147 dXX_C1tab(k,i)=dXX_Ci1(k)
4148 dYY_Ctab(k,i)=dYY_Ci(k)
4149 dYY_C1tab(k,i)=dYY_Ci1(k)
4150 dZZ_Ctab(k,i)=dZZ_Ci(k)
4151 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4152 dXX_XYZtab(k,i)=dXX_XYZ(k)
4153 dYY_XYZtab(k,i)=dYY_XYZ(k)
4154 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4158 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4159 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4160 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4161 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4162 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4164 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4165 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4166 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4167 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4168 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4169 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4170 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4171 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4173 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4174 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4176 C to check gradient call subroutine check_grad
4183 c------------------------------------------------------------------------------
4184 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4186 C This procedure calculates two-body contact function g(rij) and its derivative:
4189 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4192 C where x=(rij-r0ij)/delta
4194 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4197 double precision rij,r0ij,eps0ij,fcont,fprimcont
4198 double precision x,x2,x4,delta
4202 if (x.lt.-1.0D0) then
4205 else if (x.le.1.0D0) then
4208 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4209 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4216 c------------------------------------------------------------------------------
4217 subroutine splinthet(theti,delta,ss,ssder)
4218 implicit real*8 (a-h,o-z)
4219 include 'DIMENSIONS'
4220 include 'DIMENSIONS.ZSCOPT'
4221 include 'COMMON.VAR'
4222 include 'COMMON.GEO'
4225 if (theti.gt.pipol) then
4226 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4228 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4233 c------------------------------------------------------------------------------
4234 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4236 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4237 double precision ksi,ksi2,ksi3,a1,a2,a3
4238 a1=fprim0*delta/(f1-f0)
4244 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4245 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4248 c------------------------------------------------------------------------------
4249 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4251 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4252 double precision ksi,ksi2,ksi3,a1,a2,a3
4257 a2=3*(f1x-f0x)-2*fprim0x*delta
4258 a3=fprim0x*delta-2*(f1x-f0x)
4259 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4262 C-----------------------------------------------------------------------------
4264 C-----------------------------------------------------------------------------
4265 subroutine etor(etors,edihcnstr,fact)
4266 implicit real*8 (a-h,o-z)
4267 include 'DIMENSIONS'
4268 include 'DIMENSIONS.ZSCOPT'
4269 include 'COMMON.VAR'
4270 include 'COMMON.GEO'
4271 include 'COMMON.LOCAL'
4272 include 'COMMON.TORSION'
4273 include 'COMMON.INTERACT'
4274 include 'COMMON.DERIV'
4275 include 'COMMON.CHAIN'
4276 include 'COMMON.NAMES'
4277 include 'COMMON.IOUNITS'
4278 include 'COMMON.FFIELD'
4279 include 'COMMON.TORCNSTR'
4281 C Set lprn=.true. for debugging
4285 do i=iphi_start,iphi_end
4286 itori=itortyp(itype(i-2))
4287 itori1=itortyp(itype(i-1))
4290 C Proline-Proline pair is a special case...
4291 if (itori.eq.3 .and. itori1.eq.3) then
4292 if (phii.gt.-dwapi3) then
4294 fac=1.0D0/(1.0D0-cosphi)
4295 etorsi=v1(1,3,3)*fac
4296 etorsi=etorsi+etorsi
4297 etors=etors+etorsi-v1(1,3,3)
4298 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4301 v1ij=v1(j+1,itori,itori1)
4302 v2ij=v2(j+1,itori,itori1)
4305 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4306 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4310 v1ij=v1(j,itori,itori1)
4311 v2ij=v2(j,itori,itori1)
4314 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4315 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4319 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4320 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4321 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4322 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4323 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4325 ! 6/20/98 - dihedral angle constraints
4328 itori=idih_constr(i)
4331 if (difi.gt.drange(i)) then
4333 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4334 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4335 else if (difi.lt.-drange(i)) then
4337 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4338 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4340 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4341 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4343 ! write (iout,*) 'edihcnstr',edihcnstr
4346 c------------------------------------------------------------------------------
4348 subroutine etor(etors,edihcnstr,fact)
4349 implicit real*8 (a-h,o-z)
4350 include 'DIMENSIONS'
4351 include 'DIMENSIONS.ZSCOPT'
4352 include 'COMMON.VAR'
4353 include 'COMMON.GEO'
4354 include 'COMMON.LOCAL'
4355 include 'COMMON.TORSION'
4356 include 'COMMON.INTERACT'
4357 include 'COMMON.DERIV'
4358 include 'COMMON.CHAIN'
4359 include 'COMMON.NAMES'
4360 include 'COMMON.IOUNITS'
4361 include 'COMMON.FFIELD'
4362 include 'COMMON.TORCNSTR'
4364 C Set lprn=.true. for debugging
4368 do i=iphi_start,iphi_end
4369 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4370 itori=itortyp(itype(i-2))
4371 itori1=itortyp(itype(i-1))
4374 C Regular cosine and sine terms
4375 do j=1,nterm(itori,itori1)
4376 v1ij=v1(j,itori,itori1)
4377 v2ij=v2(j,itori,itori1)
4380 etors=etors+v1ij*cosphi+v2ij*sinphi
4381 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4385 C E = SUM ----------------------------------- - v1
4386 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4388 cosphi=dcos(0.5d0*phii)
4389 sinphi=dsin(0.5d0*phii)
4390 do j=1,nlor(itori,itori1)
4391 vl1ij=vlor1(j,itori,itori1)
4392 vl2ij=vlor2(j,itori,itori1)
4393 vl3ij=vlor3(j,itori,itori1)
4394 pom=vl2ij*cosphi+vl3ij*sinphi
4395 pom1=1.0d0/(pom*pom+1.0d0)
4396 etors=etors+vl1ij*pom1
4398 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4400 C Subtract the constant term
4401 etors=etors-v0(itori,itori1)
4403 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4404 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4405 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4406 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4407 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4410 ! 6/20/98 - dihedral angle constraints
4413 itori=idih_constr(i)
4415 difi=pinorm(phii-phi0(i))
4417 if (difi.gt.drange(i)) then
4419 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4420 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4421 edihi=0.25d0*ftors*difi**4
4422 else if (difi.lt.-drange(i)) then
4424 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4425 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4426 edihi=0.25d0*ftors*difi**4
4430 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4432 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4433 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4435 ! write (iout,*) 'edihcnstr',edihcnstr
4438 c----------------------------------------------------------------------------
4439 subroutine etor_d(etors_d,fact2)
4440 C 6/23/01 Compute double torsional energy
4441 implicit real*8 (a-h,o-z)
4442 include 'DIMENSIONS'
4443 include 'DIMENSIONS.ZSCOPT'
4444 include 'COMMON.VAR'
4445 include 'COMMON.GEO'
4446 include 'COMMON.LOCAL'
4447 include 'COMMON.TORSION'
4448 include 'COMMON.INTERACT'
4449 include 'COMMON.DERIV'
4450 include 'COMMON.CHAIN'
4451 include 'COMMON.NAMES'
4452 include 'COMMON.IOUNITS'
4453 include 'COMMON.FFIELD'
4454 include 'COMMON.TORCNSTR'
4456 C Set lprn=.true. for debugging
4460 do i=iphi_start,iphi_end-1
4461 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4463 itori=itortyp(itype(i-2))
4464 itori1=itortyp(itype(i-1))
4465 itori2=itortyp(itype(i))
4470 C Regular cosine and sine terms
4471 do j=1,ntermd_1(itori,itori1,itori2)
4472 v1cij=v1c(1,j,itori,itori1,itori2)
4473 v1sij=v1s(1,j,itori,itori1,itori2)
4474 v2cij=v1c(2,j,itori,itori1,itori2)
4475 v2sij=v1s(2,j,itori,itori1,itori2)
4476 cosphi1=dcos(j*phii)
4477 sinphi1=dsin(j*phii)
4478 cosphi2=dcos(j*phii1)
4479 sinphi2=dsin(j*phii1)
4480 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4481 & v2cij*cosphi2+v2sij*sinphi2
4482 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4483 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4485 do k=2,ntermd_2(itori,itori1,itori2)
4487 v1cdij = v2c(k,l,itori,itori1,itori2)
4488 v2cdij = v2c(l,k,itori,itori1,itori2)
4489 v1sdij = v2s(k,l,itori,itori1,itori2)
4490 v2sdij = v2s(l,k,itori,itori1,itori2)
4491 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4492 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4493 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4494 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4495 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4496 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4497 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4498 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4499 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4500 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4503 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4504 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4510 c------------------------------------------------------------------------------
4511 subroutine eback_sc_corr(esccor)
4512 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4513 c conformational states; temporarily implemented as differences
4514 c between UNRES torsional potentials (dependent on three types of
4515 c residues) and the torsional potentials dependent on all 20 types
4516 c of residues computed from AM1 energy surfaces of terminally-blocked
4517 c amino-acid residues.
4518 implicit real*8 (a-h,o-z)
4519 include 'DIMENSIONS'
4520 include 'DIMENSIONS.ZSCOPT'
4521 include 'COMMON.VAR'
4522 include 'COMMON.GEO'
4523 include 'COMMON.LOCAL'
4524 include 'COMMON.TORSION'
4525 include 'COMMON.SCCOR'
4526 include 'COMMON.INTERACT'
4527 include 'COMMON.DERIV'
4528 include 'COMMON.CHAIN'
4529 include 'COMMON.NAMES'
4530 include 'COMMON.IOUNITS'
4531 include 'COMMON.FFIELD'
4532 include 'COMMON.CONTROL'
4534 C Set lprn=.true. for debugging
4537 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4539 do i=iphi_start,iphi_end
4546 v1ij=v1sccor(j,itori,itori1)
4547 v2ij=v2sccor(j,itori,itori1)
4550 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4551 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4554 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4555 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4556 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
4557 gsccor_loc(i-3)=gloci
4561 c------------------------------------------------------------------------------
4562 subroutine multibody(ecorr)
4563 C This subroutine calculates multi-body contributions to energy following
4564 C the idea of Skolnick et al. If side chains I and J make a contact and
4565 C at the same time side chains I+1 and J+1 make a contact, an extra
4566 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4567 implicit real*8 (a-h,o-z)
4568 include 'DIMENSIONS'
4569 include 'COMMON.IOUNITS'
4570 include 'COMMON.DERIV'
4571 include 'COMMON.INTERACT'
4572 include 'COMMON.CONTACTS'
4573 double precision gx(3),gx1(3)
4576 C Set lprn=.true. for debugging
4580 write (iout,'(a)') 'Contact function values:'
4582 write (iout,'(i2,20(1x,i2,f10.5))')
4583 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4598 num_conti=num_cont(i)
4599 num_conti1=num_cont(i1)
4604 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4605 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4606 cd & ' ishift=',ishift
4607 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4608 C The system gains extra energy.
4609 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4610 endif ! j1==j+-ishift
4619 c------------------------------------------------------------------------------
4620 double precision function esccorr(i,j,k,l,jj,kk)
4621 implicit real*8 (a-h,o-z)
4622 include 'DIMENSIONS'
4623 include 'COMMON.IOUNITS'
4624 include 'COMMON.DERIV'
4625 include 'COMMON.INTERACT'
4626 include 'COMMON.CONTACTS'
4627 double precision gx(3),gx1(3)
4632 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4633 C Calculate the multi-body contribution to energy.
4634 C Calculate multi-body contributions to the gradient.
4635 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4636 cd & k,l,(gacont(m,kk,k),m=1,3)
4638 gx(m) =ekl*gacont(m,jj,i)
4639 gx1(m)=eij*gacont(m,kk,k)
4640 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4641 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4642 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4643 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4647 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4652 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4658 c------------------------------------------------------------------------------
4660 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4661 implicit real*8 (a-h,o-z)
4662 include 'DIMENSIONS'
4663 integer dimen1,dimen2,atom,indx
4664 double precision buffer(dimen1,dimen2)
4665 double precision zapas
4666 common /contacts_hb/ zapas(3,20,maxres,7),
4667 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4668 & num_cont_hb(maxres),jcont_hb(20,maxres)
4669 num_kont=num_cont_hb(atom)
4673 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4676 buffer(i,indx+22)=facont_hb(i,atom)
4677 buffer(i,indx+23)=ees0p(i,atom)
4678 buffer(i,indx+24)=ees0m(i,atom)
4679 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4681 buffer(1,indx+26)=dfloat(num_kont)
4684 c------------------------------------------------------------------------------
4685 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 integer dimen1,dimen2,atom,indx
4689 double precision buffer(dimen1,dimen2)
4690 double precision zapas
4691 common /contacts_hb/ zapas(3,20,maxres,7),
4692 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4693 & num_cont_hb(maxres),jcont_hb(20,maxres)
4694 num_kont=buffer(1,indx+26)
4695 num_kont_old=num_cont_hb(atom)
4696 num_cont_hb(atom)=num_kont+num_kont_old
4701 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4704 facont_hb(ii,atom)=buffer(i,indx+22)
4705 ees0p(ii,atom)=buffer(i,indx+23)
4706 ees0m(ii,atom)=buffer(i,indx+24)
4707 jcont_hb(ii,atom)=buffer(i,indx+25)
4711 c------------------------------------------------------------------------------
4713 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4714 C This subroutine calculates multi-body contributions to hydrogen-bonding
4715 implicit real*8 (a-h,o-z)
4716 include 'DIMENSIONS'
4717 include 'DIMENSIONS.ZSCOPT'
4718 include 'COMMON.IOUNITS'
4720 include 'COMMON.INFO'
4722 include 'COMMON.FFIELD'
4723 include 'COMMON.DERIV'
4724 include 'COMMON.INTERACT'
4725 include 'COMMON.CONTACTS'
4727 parameter (max_cont=maxconts)
4728 parameter (max_dim=2*(8*3+2))
4729 parameter (msglen1=max_cont*max_dim*4)
4730 parameter (msglen2=2*msglen1)
4731 integer source,CorrelType,CorrelID,Error
4732 double precision buffer(max_cont,max_dim)
4734 double precision gx(3),gx1(3)
4737 C Set lprn=.true. for debugging
4742 if (fgProcs.le.1) goto 30
4744 write (iout,'(a)') 'Contact function values:'
4746 write (iout,'(2i3,50(1x,i2,f5.2))')
4747 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4748 & j=1,num_cont_hb(i))
4751 C Caution! Following code assumes that electrostatic interactions concerning
4752 C a given atom are split among at most two processors!
4762 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4765 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4766 if (MyRank.gt.0) then
4767 C Send correlation contributions to the preceding processor
4769 nn=num_cont_hb(iatel_s)
4770 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4771 cd write (iout,*) 'The BUFFER array:'
4773 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4775 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4777 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4778 C Clear the contacts of the atom passed to the neighboring processor
4779 nn=num_cont_hb(iatel_s+1)
4781 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4783 num_cont_hb(iatel_s)=0
4785 cd write (iout,*) 'Processor ',MyID,MyRank,
4786 cd & ' is sending correlation contribution to processor',MyID-1,
4787 cd & ' msglen=',msglen
4788 cd write (*,*) 'Processor ',MyID,MyRank,
4789 cd & ' is sending correlation contribution to processor',MyID-1,
4790 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4791 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4792 cd write (iout,*) 'Processor ',MyID,
4793 cd & ' has sent correlation contribution to processor',MyID-1,
4794 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4795 cd write (*,*) 'Processor ',MyID,
4796 cd & ' has sent correlation contribution to processor',MyID-1,
4797 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4799 endif ! (MyRank.gt.0)
4803 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4804 if (MyRank.lt.fgProcs-1) then
4805 C Receive correlation contributions from the next processor
4807 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4808 cd write (iout,*) 'Processor',MyID,
4809 cd & ' is receiving correlation contribution from processor',MyID+1,
4810 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4811 cd write (*,*) 'Processor',MyID,
4812 cd & ' is receiving correlation contribution from processor',MyID+1,
4813 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4815 do while (nbytes.le.0)
4816 call mp_probe(MyID+1,CorrelType,nbytes)
4818 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4819 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4820 cd write (iout,*) 'Processor',MyID,
4821 cd & ' has received correlation contribution from processor',MyID+1,
4822 cd & ' msglen=',msglen,' nbytes=',nbytes
4823 cd write (iout,*) 'The received BUFFER array:'
4825 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4827 if (msglen.eq.msglen1) then
4828 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4829 else if (msglen.eq.msglen2) then
4830 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4831 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4834 & 'ERROR!!!! message length changed while processing correlations.'
4836 & 'ERROR!!!! message length changed while processing correlations.'
4837 call mp_stopall(Error)
4838 endif ! msglen.eq.msglen1
4839 endif ! MyRank.lt.fgProcs-1
4846 write (iout,'(a)') 'Contact function values:'
4848 write (iout,'(2i3,50(1x,i2,f5.2))')
4849 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4850 & j=1,num_cont_hb(i))
4854 C Remove the loop below after debugging !!!
4861 C Calculate the local-electrostatic correlation terms
4862 do i=iatel_s,iatel_e+1
4864 num_conti=num_cont_hb(i)
4865 num_conti1=num_cont_hb(i+1)
4870 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4871 c & ' jj=',jj,' kk=',kk
4872 if (j1.eq.j+1 .or. j1.eq.j-1) then
4873 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4874 C The system gains extra energy.
4875 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4877 else if (j1.eq.j) then
4878 C Contacts I-J and I-(J+1) occur simultaneously.
4879 C The system loses extra energy.
4880 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4885 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4886 c & ' jj=',jj,' kk=',kk
4888 C Contacts I-J and (I+1)-J occur simultaneously.
4889 C The system loses extra energy.
4890 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4897 c------------------------------------------------------------------------------
4898 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4900 C This subroutine calculates multi-body contributions to hydrogen-bonding
4901 implicit real*8 (a-h,o-z)
4902 include 'DIMENSIONS'
4903 include 'DIMENSIONS.ZSCOPT'
4904 include 'COMMON.IOUNITS'
4906 include 'COMMON.INFO'
4908 include 'COMMON.FFIELD'
4909 include 'COMMON.DERIV'
4910 include 'COMMON.INTERACT'
4911 include 'COMMON.CONTACTS'
4913 parameter (max_cont=maxconts)
4914 parameter (max_dim=2*(8*3+2))
4915 parameter (msglen1=max_cont*max_dim*4)
4916 parameter (msglen2=2*msglen1)
4917 integer source,CorrelType,CorrelID,Error
4918 double precision buffer(max_cont,max_dim)
4920 double precision gx(3),gx1(3)
4923 C Set lprn=.true. for debugging
4929 if (fgProcs.le.1) goto 30
4931 write (iout,'(a)') 'Contact function values:'
4933 write (iout,'(2i3,50(1x,i2,f5.2))')
4934 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4935 & j=1,num_cont_hb(i))
4938 C Caution! Following code assumes that electrostatic interactions concerning
4939 C a given atom are split among at most two processors!
4949 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4952 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4953 if (MyRank.gt.0) then
4954 C Send correlation contributions to the preceding processor
4956 nn=num_cont_hb(iatel_s)
4957 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4958 cd write (iout,*) 'The BUFFER array:'
4960 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4962 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4964 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4965 C Clear the contacts of the atom passed to the neighboring processor
4966 nn=num_cont_hb(iatel_s+1)
4968 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4970 num_cont_hb(iatel_s)=0
4972 cd write (iout,*) 'Processor ',MyID,MyRank,
4973 cd & ' is sending correlation contribution to processor',MyID-1,
4974 cd & ' msglen=',msglen
4975 cd write (*,*) 'Processor ',MyID,MyRank,
4976 cd & ' is sending correlation contribution to processor',MyID-1,
4977 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4978 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4979 cd write (iout,*) 'Processor ',MyID,
4980 cd & ' has sent correlation contribution to processor',MyID-1,
4981 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4982 cd write (*,*) 'Processor ',MyID,
4983 cd & ' has sent correlation contribution to processor',MyID-1,
4984 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4986 endif ! (MyRank.gt.0)
4990 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4991 if (MyRank.lt.fgProcs-1) then
4992 C Receive correlation contributions from the next processor
4994 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4995 cd write (iout,*) 'Processor',MyID,
4996 cd & ' is receiving correlation contribution from processor',MyID+1,
4997 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4998 cd write (*,*) 'Processor',MyID,
4999 cd & ' is receiving correlation contribution from processor',MyID+1,
5000 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5002 do while (nbytes.le.0)
5003 call mp_probe(MyID+1,CorrelType,nbytes)
5005 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5006 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5007 cd write (iout,*) 'Processor',MyID,
5008 cd & ' has received correlation contribution from processor',MyID+1,
5009 cd & ' msglen=',msglen,' nbytes=',nbytes
5010 cd write (iout,*) 'The received BUFFER array:'
5012 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5014 if (msglen.eq.msglen1) then
5015 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5016 else if (msglen.eq.msglen2) then
5017 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5018 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5021 & 'ERROR!!!! message length changed while processing correlations.'
5023 & 'ERROR!!!! message length changed while processing correlations.'
5024 call mp_stopall(Error)
5025 endif ! msglen.eq.msglen1
5026 endif ! MyRank.lt.fgProcs-1
5033 write (iout,'(a)') 'Contact function values:'
5035 write (iout,'(2i3,50(1x,i2,f5.2))')
5036 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5037 & j=1,num_cont_hb(i))
5043 C Remove the loop below after debugging !!!
5050 C Calculate the dipole-dipole interaction energies
5051 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5052 do i=iatel_s,iatel_e+1
5053 num_conti=num_cont_hb(i)
5060 C Calculate the local-electrostatic correlation terms
5061 do i=iatel_s,iatel_e+1
5063 num_conti=num_cont_hb(i)
5064 num_conti1=num_cont_hb(i+1)
5069 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5070 c & ' jj=',jj,' kk=',kk
5071 if (j1.eq.j+1 .or. j1.eq.j-1) then
5072 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5073 C The system gains extra energy.
5075 sqd1=dsqrt(d_cont(jj,i))
5076 sqd2=dsqrt(d_cont(kk,i1))
5077 sred_geom = sqd1*sqd2
5078 IF (sred_geom.lt.cutoff_corr) THEN
5079 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5081 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5082 c & ' jj=',jj,' kk=',kk
5083 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5084 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5086 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5087 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5090 cd write (iout,*) 'sred_geom=',sred_geom,
5091 cd & ' ekont=',ekont,' fprim=',fprimcont
5092 call calc_eello(i,j,i+1,j1,jj,kk)
5093 if (wcorr4.gt.0.0d0)
5094 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5095 if (wcorr5.gt.0.0d0)
5096 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5097 c print *,"wcorr5",ecorr5
5098 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5099 cd write(2,*)'ijkl',i,j,i+1,j1
5100 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5101 & .or. wturn6.eq.0.0d0))then
5102 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5103 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5104 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5105 cd & 'ecorr6=',ecorr6
5106 cd write (iout,'(4e15.5)') sred_geom,
5107 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5108 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5109 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5110 else if (wturn6.gt.0.0d0
5111 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5112 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5113 eturn6=eturn6+eello_turn6(i,jj,kk)
5114 cd write (2,*) 'multibody_eello:eturn6',eturn6
5118 else if (j1.eq.j) then
5119 C Contacts I-J and I-(J+1) occur simultaneously.
5120 C The system loses extra energy.
5121 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5126 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5127 c & ' jj=',jj,' kk=',kk
5129 C Contacts I-J and (I+1)-J occur simultaneously.
5130 C The system loses extra energy.
5131 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5138 c------------------------------------------------------------------------------
5139 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5140 implicit real*8 (a-h,o-z)
5141 include 'DIMENSIONS'
5142 include 'COMMON.IOUNITS'
5143 include 'COMMON.DERIV'
5144 include 'COMMON.INTERACT'
5145 include 'COMMON.CONTACTS'
5146 double precision gx(3),gx1(3)
5156 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5157 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5158 C Following 4 lines for diagnostics.
5163 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5165 c write (iout,*)'Contacts have occurred for peptide groups',
5166 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5167 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5168 C Calculate the multi-body contribution to energy.
5169 ecorr=ecorr+ekont*ees
5171 C Calculate multi-body contributions to the gradient.
5173 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5174 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5175 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5176 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5177 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5178 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5179 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5180 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5181 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5182 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5183 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5184 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5185 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5186 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5190 gradcorr(ll,m)=gradcorr(ll,m)+
5191 & ees*ekl*gacont_hbr(ll,jj,i)-
5192 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5193 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5198 gradcorr(ll,m)=gradcorr(ll,m)+
5199 & ees*eij*gacont_hbr(ll,kk,k)-
5200 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5201 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5208 C---------------------------------------------------------------------------
5209 subroutine dipole(i,j,jj)
5210 implicit real*8 (a-h,o-z)
5211 include 'DIMENSIONS'
5212 include 'DIMENSIONS.ZSCOPT'
5213 include 'COMMON.IOUNITS'
5214 include 'COMMON.CHAIN'
5215 include 'COMMON.FFIELD'
5216 include 'COMMON.DERIV'
5217 include 'COMMON.INTERACT'
5218 include 'COMMON.CONTACTS'
5219 include 'COMMON.TORSION'
5220 include 'COMMON.VAR'
5221 include 'COMMON.GEO'
5222 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5224 iti1 = itortyp(itype(i+1))
5225 if (j.lt.nres-1) then
5226 itj1 = itortyp(itype(j+1))
5231 dipi(iii,1)=Ub2(iii,i)
5232 dipderi(iii)=Ub2der(iii,i)
5233 dipi(iii,2)=b1(iii,iti1)
5234 dipj(iii,1)=Ub2(iii,j)
5235 dipderj(iii)=Ub2der(iii,j)
5236 dipj(iii,2)=b1(iii,itj1)
5240 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5243 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5246 if (.not.calc_grad) return
5251 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5255 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5260 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5261 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5263 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5265 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5267 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5271 C---------------------------------------------------------------------------
5272 subroutine calc_eello(i,j,k,l,jj,kk)
5274 C This subroutine computes matrices and vectors needed to calculate
5275 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5277 implicit real*8 (a-h,o-z)
5278 include 'DIMENSIONS'
5279 include 'DIMENSIONS.ZSCOPT'
5280 include 'COMMON.IOUNITS'
5281 include 'COMMON.CHAIN'
5282 include 'COMMON.DERIV'
5283 include 'COMMON.INTERACT'
5284 include 'COMMON.CONTACTS'
5285 include 'COMMON.TORSION'
5286 include 'COMMON.VAR'
5287 include 'COMMON.GEO'
5288 include 'COMMON.FFIELD'
5289 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5290 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5293 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5294 cd & ' jj=',jj,' kk=',kk
5295 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5298 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5299 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5302 call transpose2(aa1(1,1),aa1t(1,1))
5303 call transpose2(aa2(1,1),aa2t(1,1))
5306 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5307 & aa1tder(1,1,lll,kkk))
5308 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5309 & aa2tder(1,1,lll,kkk))
5313 C parallel orientation of the two CA-CA-CA frames.
5315 iti=itortyp(itype(i))
5319 itk1=itortyp(itype(k+1))
5320 itj=itortyp(itype(j))
5321 if (l.lt.nres-1) then
5322 itl1=itortyp(itype(l+1))
5326 C A1 kernel(j+1) A2T
5328 cd write (iout,'(3f10.5,5x,3f10.5)')
5329 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5331 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5332 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5333 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5334 C Following matrices are needed only for 6-th order cumulants
5335 IF (wcorr6.gt.0.0d0) THEN
5336 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5337 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5338 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5339 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5340 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5341 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5342 & ADtEAderx(1,1,1,1,1,1))
5344 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5345 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5346 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5347 & ADtEA1derx(1,1,1,1,1,1))
5349 C End 6-th order cumulants
5352 cd write (2,*) 'In calc_eello6'
5354 cd write (2,*) 'iii=',iii
5356 cd write (2,*) 'kkk=',kkk
5358 cd write (2,'(3(2f10.5),5x)')
5359 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5364 call transpose2(EUgder(1,1,k),auxmat(1,1))
5365 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5366 call transpose2(EUg(1,1,k),auxmat(1,1))
5367 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5368 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5372 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5373 & EAEAderx(1,1,lll,kkk,iii,1))
5377 C A1T kernel(i+1) A2
5378 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5379 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5380 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5381 C Following matrices are needed only for 6-th order cumulants
5382 IF (wcorr6.gt.0.0d0) THEN
5383 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5384 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5385 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5386 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5387 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5388 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5389 & ADtEAderx(1,1,1,1,1,2))
5390 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5391 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5392 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5393 & ADtEA1derx(1,1,1,1,1,2))
5395 C End 6-th order cumulants
5396 call transpose2(EUgder(1,1,l),auxmat(1,1))
5397 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5398 call transpose2(EUg(1,1,l),auxmat(1,1))
5399 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5400 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5404 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5405 & EAEAderx(1,1,lll,kkk,iii,2))
5410 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5411 C They are needed only when the fifth- or the sixth-order cumulants are
5413 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5414 call transpose2(AEA(1,1,1),auxmat(1,1))
5415 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5416 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5417 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5418 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5419 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5420 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5421 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5422 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5423 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5424 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5425 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5426 call transpose2(AEA(1,1,2),auxmat(1,1))
5427 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5428 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5429 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5430 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5431 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5432 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5433 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5434 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5435 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5436 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5437 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5438 C Calculate the Cartesian derivatives of the vectors.
5442 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5443 call matvec2(auxmat(1,1),b1(1,iti),
5444 & AEAb1derx(1,lll,kkk,iii,1,1))
5445 call matvec2(auxmat(1,1),Ub2(1,i),
5446 & AEAb2derx(1,lll,kkk,iii,1,1))
5447 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5448 & AEAb1derx(1,lll,kkk,iii,2,1))
5449 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5450 & AEAb2derx(1,lll,kkk,iii,2,1))
5451 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5452 call matvec2(auxmat(1,1),b1(1,itj),
5453 & AEAb1derx(1,lll,kkk,iii,1,2))
5454 call matvec2(auxmat(1,1),Ub2(1,j),
5455 & AEAb2derx(1,lll,kkk,iii,1,2))
5456 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5457 & AEAb1derx(1,lll,kkk,iii,2,2))
5458 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5459 & AEAb2derx(1,lll,kkk,iii,2,2))
5466 C Antiparallel orientation of the two CA-CA-CA frames.
5468 iti=itortyp(itype(i))
5472 itk1=itortyp(itype(k+1))
5473 itl=itortyp(itype(l))
5474 itj=itortyp(itype(j))
5475 if (j.lt.nres-1) then
5476 itj1=itortyp(itype(j+1))
5480 C A2 kernel(j-1)T A1T
5481 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5482 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5483 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5484 C Following matrices are needed only for 6-th order cumulants
5485 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5486 & j.eq.i+4 .and. l.eq.i+3)) THEN
5487 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5488 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5489 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5490 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5491 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5492 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5493 & ADtEAderx(1,1,1,1,1,1))
5494 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5495 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5496 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5497 & ADtEA1derx(1,1,1,1,1,1))
5499 C End 6-th order cumulants
5500 call transpose2(EUgder(1,1,k),auxmat(1,1))
5501 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5502 call transpose2(EUg(1,1,k),auxmat(1,1))
5503 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5504 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5508 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5509 & EAEAderx(1,1,lll,kkk,iii,1))
5513 C A2T kernel(i+1)T A1
5514 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5515 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5516 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5517 C Following matrices are needed only for 6-th order cumulants
5518 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5519 & j.eq.i+4 .and. l.eq.i+3)) THEN
5520 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5521 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5522 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5523 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5524 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5525 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5526 & ADtEAderx(1,1,1,1,1,2))
5527 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5528 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5529 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5530 & ADtEA1derx(1,1,1,1,1,2))
5532 C End 6-th order cumulants
5533 call transpose2(EUgder(1,1,j),auxmat(1,1))
5534 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5535 call transpose2(EUg(1,1,j),auxmat(1,1))
5536 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5537 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5541 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5542 & EAEAderx(1,1,lll,kkk,iii,2))
5547 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5548 C They are needed only when the fifth- or the sixth-order cumulants are
5550 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5551 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5552 call transpose2(AEA(1,1,1),auxmat(1,1))
5553 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5554 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5555 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5556 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5557 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5558 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5559 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5560 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5561 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5562 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5563 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5564 call transpose2(AEA(1,1,2),auxmat(1,1))
5565 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5566 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5567 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5568 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5569 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5570 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5571 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5572 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5573 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5574 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5575 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5576 C Calculate the Cartesian derivatives of the vectors.
5580 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5581 call matvec2(auxmat(1,1),b1(1,iti),
5582 & AEAb1derx(1,lll,kkk,iii,1,1))
5583 call matvec2(auxmat(1,1),Ub2(1,i),
5584 & AEAb2derx(1,lll,kkk,iii,1,1))
5585 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5586 & AEAb1derx(1,lll,kkk,iii,2,1))
5587 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5588 & AEAb2derx(1,lll,kkk,iii,2,1))
5589 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5590 call matvec2(auxmat(1,1),b1(1,itl),
5591 & AEAb1derx(1,lll,kkk,iii,1,2))
5592 call matvec2(auxmat(1,1),Ub2(1,l),
5593 & AEAb2derx(1,lll,kkk,iii,1,2))
5594 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5595 & AEAb1derx(1,lll,kkk,iii,2,2))
5596 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5597 & AEAb2derx(1,lll,kkk,iii,2,2))
5606 C---------------------------------------------------------------------------
5607 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5608 & KK,KKderg,AKA,AKAderg,AKAderx)
5612 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5613 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5614 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5619 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5621 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5624 cd if (lprn) write (2,*) 'In kernel'
5626 cd if (lprn) write (2,*) 'kkk=',kkk
5628 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5629 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5631 cd write (2,*) 'lll=',lll
5632 cd write (2,*) 'iii=1'
5634 cd write (2,'(3(2f10.5),5x)')
5635 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5638 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5639 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5641 cd write (2,*) 'lll=',lll
5642 cd write (2,*) 'iii=2'
5644 cd write (2,'(3(2f10.5),5x)')
5645 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5652 C---------------------------------------------------------------------------
5653 double precision function eello4(i,j,k,l,jj,kk)
5654 implicit real*8 (a-h,o-z)
5655 include 'DIMENSIONS'
5656 include 'DIMENSIONS.ZSCOPT'
5657 include 'COMMON.IOUNITS'
5658 include 'COMMON.CHAIN'
5659 include 'COMMON.DERIV'
5660 include 'COMMON.INTERACT'
5661 include 'COMMON.CONTACTS'
5662 include 'COMMON.TORSION'
5663 include 'COMMON.VAR'
5664 include 'COMMON.GEO'
5665 double precision pizda(2,2),ggg1(3),ggg2(3)
5666 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5670 cd print *,'eello4:',i,j,k,l,jj,kk
5671 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5672 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5673 cold eij=facont_hb(jj,i)
5674 cold ekl=facont_hb(kk,k)
5676 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5678 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5679 gcorr_loc(k-1)=gcorr_loc(k-1)
5680 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5682 gcorr_loc(l-1)=gcorr_loc(l-1)
5683 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5685 gcorr_loc(j-1)=gcorr_loc(j-1)
5686 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5691 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5692 & -EAEAderx(2,2,lll,kkk,iii,1)
5693 cd derx(lll,kkk,iii)=0.0d0
5697 cd gcorr_loc(l-1)=0.0d0
5698 cd gcorr_loc(j-1)=0.0d0
5699 cd gcorr_loc(k-1)=0.0d0
5701 cd write (iout,*)'Contacts have occurred for peptide groups',
5702 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5703 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5704 if (j.lt.nres-1) then
5711 if (l.lt.nres-1) then
5719 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5720 ggg1(ll)=eel4*g_contij(ll,1)
5721 ggg2(ll)=eel4*g_contij(ll,2)
5722 ghalf=0.5d0*ggg1(ll)
5724 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5725 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5726 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5727 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5728 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5729 ghalf=0.5d0*ggg2(ll)
5731 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5732 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5733 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5734 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5739 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5740 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5745 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5746 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5752 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5757 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5761 cd write (2,*) iii,gcorr_loc(iii)
5765 cd write (2,*) 'ekont',ekont
5766 cd write (iout,*) 'eello4',ekont*eel4
5769 C---------------------------------------------------------------------------
5770 double precision function eello5(i,j,k,l,jj,kk)
5771 implicit real*8 (a-h,o-z)
5772 include 'DIMENSIONS'
5773 include 'DIMENSIONS.ZSCOPT'
5774 include 'COMMON.IOUNITS'
5775 include 'COMMON.CHAIN'
5776 include 'COMMON.DERIV'
5777 include 'COMMON.INTERACT'
5778 include 'COMMON.CONTACTS'
5779 include 'COMMON.TORSION'
5780 include 'COMMON.VAR'
5781 include 'COMMON.GEO'
5782 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5783 double precision ggg1(3),ggg2(3)
5784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5789 C /l\ / \ \ / \ / \ / C
5790 C / \ / \ \ / \ / \ / C
5791 C j| o |l1 | o | o| o | | o |o C
5792 C \ |/k\| |/ \| / |/ \| |/ \| C
5793 C \i/ \ / \ / / \ / \ C
5795 C (I) (II) (III) (IV) C
5797 C eello5_1 eello5_2 eello5_3 eello5_4 C
5799 C Antiparallel chains C
5802 C /j\ / \ \ / \ / \ / C
5803 C / \ / \ \ / \ / \ / C
5804 C j1| o |l | o | o| o | | o |o C
5805 C \ |/k\| |/ \| / |/ \| |/ \| C
5806 C \i/ \ / \ / / \ / \ C
5808 C (I) (II) (III) (IV) C
5810 C eello5_1 eello5_2 eello5_3 eello5_4 C
5812 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5814 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5815 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5820 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5822 itk=itortyp(itype(k))
5823 itl=itortyp(itype(l))
5824 itj=itortyp(itype(j))
5829 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5830 cd & eel5_3_num,eel5_4_num)
5834 derx(lll,kkk,iii)=0.0d0
5838 cd eij=facont_hb(jj,i)
5839 cd ekl=facont_hb(kk,k)
5841 cd write (iout,*)'Contacts have occurred for peptide groups',
5842 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5844 C Contribution from the graph I.
5845 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5846 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5847 call transpose2(EUg(1,1,k),auxmat(1,1))
5848 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5849 vv(1)=pizda(1,1)-pizda(2,2)
5850 vv(2)=pizda(1,2)+pizda(2,1)
5851 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5852 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5854 C Explicit gradient in virtual-dihedral angles.
5855 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5856 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5857 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5858 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5859 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5860 vv(1)=pizda(1,1)-pizda(2,2)
5861 vv(2)=pizda(1,2)+pizda(2,1)
5862 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5863 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5864 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5865 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5866 vv(1)=pizda(1,1)-pizda(2,2)
5867 vv(2)=pizda(1,2)+pizda(2,1)
5869 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5870 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5871 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5873 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5874 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5875 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5877 C Cartesian gradient
5881 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5883 vv(1)=pizda(1,1)-pizda(2,2)
5884 vv(2)=pizda(1,2)+pizda(2,1)
5885 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5886 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5887 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5894 C Contribution from graph II
5895 call transpose2(EE(1,1,itk),auxmat(1,1))
5896 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5897 vv(1)=pizda(1,1)+pizda(2,2)
5898 vv(2)=pizda(2,1)-pizda(1,2)
5899 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5900 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5902 C Explicit gradient in virtual-dihedral angles.
5903 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5904 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5905 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5906 vv(1)=pizda(1,1)+pizda(2,2)
5907 vv(2)=pizda(2,1)-pizda(1,2)
5909 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5910 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5911 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5913 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5914 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5915 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5917 C Cartesian gradient
5921 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5923 vv(1)=pizda(1,1)+pizda(2,2)
5924 vv(2)=pizda(2,1)-pizda(1,2)
5925 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5926 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5927 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5936 C Parallel orientation
5937 C Contribution from graph III
5938 call transpose2(EUg(1,1,l),auxmat(1,1))
5939 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5940 vv(1)=pizda(1,1)-pizda(2,2)
5941 vv(2)=pizda(1,2)+pizda(2,1)
5942 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5945 C Explicit gradient in virtual-dihedral angles.
5946 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5947 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5948 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5949 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5950 vv(1)=pizda(1,1)-pizda(2,2)
5951 vv(2)=pizda(1,2)+pizda(2,1)
5952 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5953 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5954 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5955 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5956 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5957 vv(1)=pizda(1,1)-pizda(2,2)
5958 vv(2)=pizda(1,2)+pizda(2,1)
5959 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5960 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5961 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5962 C Cartesian gradient
5966 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5968 vv(1)=pizda(1,1)-pizda(2,2)
5969 vv(2)=pizda(1,2)+pizda(2,1)
5970 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5971 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5972 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5978 C Contribution from graph IV
5980 call transpose2(EE(1,1,itl),auxmat(1,1))
5981 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5982 vv(1)=pizda(1,1)+pizda(2,2)
5983 vv(2)=pizda(2,1)-pizda(1,2)
5984 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5985 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5987 C Explicit gradient in virtual-dihedral angles.
5988 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5989 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5990 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5994 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5995 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5996 C Cartesian gradient
6000 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6002 vv(1)=pizda(1,1)+pizda(2,2)
6003 vv(2)=pizda(2,1)-pizda(1,2)
6004 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6005 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6006 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6012 C Antiparallel orientation
6013 C Contribution from graph III
6015 call transpose2(EUg(1,1,j),auxmat(1,1))
6016 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6017 vv(1)=pizda(1,1)-pizda(2,2)
6018 vv(2)=pizda(1,2)+pizda(2,1)
6019 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6020 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6022 C Explicit gradient in virtual-dihedral angles.
6023 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6024 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6025 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6026 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6027 vv(1)=pizda(1,1)-pizda(2,2)
6028 vv(2)=pizda(1,2)+pizda(2,1)
6029 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6030 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6031 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6032 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6033 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6034 vv(1)=pizda(1,1)-pizda(2,2)
6035 vv(2)=pizda(1,2)+pizda(2,1)
6036 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6037 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6038 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6039 C Cartesian gradient
6043 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6045 vv(1)=pizda(1,1)-pizda(2,2)
6046 vv(2)=pizda(1,2)+pizda(2,1)
6047 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6048 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6049 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6055 C Contribution from graph IV
6057 call transpose2(EE(1,1,itj),auxmat(1,1))
6058 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6059 vv(1)=pizda(1,1)+pizda(2,2)
6060 vv(2)=pizda(2,1)-pizda(1,2)
6061 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6062 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6064 C Explicit gradient in virtual-dihedral angles.
6065 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6066 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6067 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6068 vv(1)=pizda(1,1)+pizda(2,2)
6069 vv(2)=pizda(2,1)-pizda(1,2)
6070 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6071 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6072 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6073 C Cartesian gradient
6077 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6079 vv(1)=pizda(1,1)+pizda(2,2)
6080 vv(2)=pizda(2,1)-pizda(1,2)
6081 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6082 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6083 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6090 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6091 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6092 cd write (2,*) 'ijkl',i,j,k,l
6093 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6094 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6096 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6097 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6098 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6099 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6101 if (j.lt.nres-1) then
6108 if (l.lt.nres-1) then
6118 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6120 ggg1(ll)=eel5*g_contij(ll,1)
6121 ggg2(ll)=eel5*g_contij(ll,2)
6122 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6123 ghalf=0.5d0*ggg1(ll)
6125 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6126 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6127 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6128 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6129 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6130 ghalf=0.5d0*ggg2(ll)
6132 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6133 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6134 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6135 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6140 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6141 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6146 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6147 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6153 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6158 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6162 cd write (2,*) iii,g_corr5_loc(iii)
6166 cd write (2,*) 'ekont',ekont
6167 cd write (iout,*) 'eello5',ekont*eel5
6170 c--------------------------------------------------------------------------
6171 double precision function eello6(i,j,k,l,jj,kk)
6172 implicit real*8 (a-h,o-z)
6173 include 'DIMENSIONS'
6174 include 'DIMENSIONS.ZSCOPT'
6175 include 'COMMON.IOUNITS'
6176 include 'COMMON.CHAIN'
6177 include 'COMMON.DERIV'
6178 include 'COMMON.INTERACT'
6179 include 'COMMON.CONTACTS'
6180 include 'COMMON.TORSION'
6181 include 'COMMON.VAR'
6182 include 'COMMON.GEO'
6183 include 'COMMON.FFIELD'
6184 double precision ggg1(3),ggg2(3)
6185 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6190 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6198 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6199 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6203 derx(lll,kkk,iii)=0.0d0
6207 cd eij=facont_hb(jj,i)
6208 cd ekl=facont_hb(kk,k)
6214 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6215 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6216 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6217 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6218 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6219 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6221 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6222 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6223 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6224 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6225 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6226 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6230 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6232 C If turn contributions are considered, they will be handled separately.
6233 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6234 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6235 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6236 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6237 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6238 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6239 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6242 if (j.lt.nres-1) then
6249 if (l.lt.nres-1) then
6257 ggg1(ll)=eel6*g_contij(ll,1)
6258 ggg2(ll)=eel6*g_contij(ll,2)
6259 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6260 ghalf=0.5d0*ggg1(ll)
6262 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6263 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6264 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6265 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6266 ghalf=0.5d0*ggg2(ll)
6267 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6269 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6270 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6271 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6272 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6277 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6278 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6283 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6284 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6290 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6295 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6299 cd write (2,*) iii,g_corr6_loc(iii)
6303 cd write (2,*) 'ekont',ekont
6304 cd write (iout,*) 'eello6',ekont*eel6
6307 c--------------------------------------------------------------------------
6308 double precision function eello6_graph1(i,j,k,l,imat,swap)
6309 implicit real*8 (a-h,o-z)
6310 include 'DIMENSIONS'
6311 include 'DIMENSIONS.ZSCOPT'
6312 include 'COMMON.IOUNITS'
6313 include 'COMMON.CHAIN'
6314 include 'COMMON.DERIV'
6315 include 'COMMON.INTERACT'
6316 include 'COMMON.CONTACTS'
6317 include 'COMMON.TORSION'
6318 include 'COMMON.VAR'
6319 include 'COMMON.GEO'
6320 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6324 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6326 C Parallel Antiparallel
6332 C \ j|/k\| / \ |/k\|l /
6337 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6338 itk=itortyp(itype(k))
6339 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6340 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6341 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6342 call transpose2(EUgC(1,1,k),auxmat(1,1))
6343 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6344 vv1(1)=pizda1(1,1)-pizda1(2,2)
6345 vv1(2)=pizda1(1,2)+pizda1(2,1)
6346 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6347 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6348 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6349 s5=scalar2(vv(1),Dtobr2(1,i))
6350 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6351 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6352 if (.not. calc_grad) return
6353 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6354 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6355 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6356 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6357 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6358 & +scalar2(vv(1),Dtobr2der(1,i)))
6359 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6360 vv1(1)=pizda1(1,1)-pizda1(2,2)
6361 vv1(2)=pizda1(1,2)+pizda1(2,1)
6362 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6363 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6365 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6366 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6367 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6368 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6369 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6371 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6372 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6373 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6374 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6375 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6377 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6378 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6379 vv1(1)=pizda1(1,1)-pizda1(2,2)
6380 vv1(2)=pizda1(1,2)+pizda1(2,1)
6381 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6382 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6383 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6384 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6393 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6394 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6395 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6396 call transpose2(EUgC(1,1,k),auxmat(1,1))
6397 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6399 vv1(1)=pizda1(1,1)-pizda1(2,2)
6400 vv1(2)=pizda1(1,2)+pizda1(2,1)
6401 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6402 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6403 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6404 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6405 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6406 s5=scalar2(vv(1),Dtobr2(1,i))
6407 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6413 c----------------------------------------------------------------------------
6414 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6415 implicit real*8 (a-h,o-z)
6416 include 'DIMENSIONS'
6417 include 'DIMENSIONS.ZSCOPT'
6418 include 'COMMON.IOUNITS'
6419 include 'COMMON.CHAIN'
6420 include 'COMMON.DERIV'
6421 include 'COMMON.INTERACT'
6422 include 'COMMON.CONTACTS'
6423 include 'COMMON.TORSION'
6424 include 'COMMON.VAR'
6425 include 'COMMON.GEO'
6427 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6428 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6431 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6433 C Parallel Antiparallel
6444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6445 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6446 C AL 7/4/01 s1 would occur in the sixth-order moment,
6447 C but not in a cluster cumulant
6449 s1=dip(1,jj,i)*dip(1,kk,k)
6451 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6452 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6453 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6454 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6455 call transpose2(EUg(1,1,k),auxmat(1,1))
6456 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6457 vv(1)=pizda(1,1)-pizda(2,2)
6458 vv(2)=pizda(1,2)+pizda(2,1)
6459 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6460 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6462 eello6_graph2=-(s1+s2+s3+s4)
6464 eello6_graph2=-(s2+s3+s4)
6467 if (.not. calc_grad) return
6468 C Derivatives in gamma(i-1)
6471 s1=dipderg(1,jj,i)*dip(1,kk,k)
6473 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6474 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6475 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6476 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6478 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6480 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6482 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6484 C Derivatives in gamma(k-1)
6486 s1=dip(1,jj,i)*dipderg(1,kk,k)
6488 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6489 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6490 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6491 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6492 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6493 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6494 vv(1)=pizda(1,1)-pizda(2,2)
6495 vv(2)=pizda(1,2)+pizda(2,1)
6496 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6498 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6500 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6502 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6503 C Derivatives in gamma(j-1) or gamma(l-1)
6506 s1=dipderg(3,jj,i)*dip(1,kk,k)
6508 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6509 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6510 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6511 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6512 vv(1)=pizda(1,1)-pizda(2,2)
6513 vv(2)=pizda(1,2)+pizda(2,1)
6514 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6517 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6519 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6522 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6523 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6525 C Derivatives in gamma(l-1) or gamma(j-1)
6528 s1=dip(1,jj,i)*dipderg(3,kk,k)
6530 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6531 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6532 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6533 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6534 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6535 vv(1)=pizda(1,1)-pizda(2,2)
6536 vv(2)=pizda(1,2)+pizda(2,1)
6537 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6540 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6542 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6545 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6546 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6548 C Cartesian derivatives.
6550 write (2,*) 'In eello6_graph2'
6552 write (2,*) 'iii=',iii
6554 write (2,*) 'kkk=',kkk
6556 write (2,'(3(2f10.5),5x)')
6557 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6567 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6569 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6572 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6574 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6575 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6577 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6578 call transpose2(EUg(1,1,k),auxmat(1,1))
6579 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6581 vv(1)=pizda(1,1)-pizda(2,2)
6582 vv(2)=pizda(1,2)+pizda(2,1)
6583 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6584 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6586 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6588 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6591 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6593 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6600 c----------------------------------------------------------------------------
6601 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6602 implicit real*8 (a-h,o-z)
6603 include 'DIMENSIONS'
6604 include 'DIMENSIONS.ZSCOPT'
6605 include 'COMMON.IOUNITS'
6606 include 'COMMON.CHAIN'
6607 include 'COMMON.DERIV'
6608 include 'COMMON.INTERACT'
6609 include 'COMMON.CONTACTS'
6610 include 'COMMON.TORSION'
6611 include 'COMMON.VAR'
6612 include 'COMMON.GEO'
6613 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6615 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6617 C Parallel Antiparallel
6628 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6630 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6631 C energy moment and not to the cluster cumulant.
6632 iti=itortyp(itype(i))
6633 if (j.lt.nres-1) then
6634 itj1=itortyp(itype(j+1))
6638 itk=itortyp(itype(k))
6639 itk1=itortyp(itype(k+1))
6640 if (l.lt.nres-1) then
6641 itl1=itortyp(itype(l+1))
6646 s1=dip(4,jj,i)*dip(4,kk,k)
6648 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6649 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6650 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6651 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6652 call transpose2(EE(1,1,itk),auxmat(1,1))
6653 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6654 vv(1)=pizda(1,1)+pizda(2,2)
6655 vv(2)=pizda(2,1)-pizda(1,2)
6656 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6657 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6659 eello6_graph3=-(s1+s2+s3+s4)
6661 eello6_graph3=-(s2+s3+s4)
6664 if (.not. calc_grad) return
6665 C Derivatives in gamma(k-1)
6666 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6667 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6668 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6669 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6670 C Derivatives in gamma(l-1)
6671 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6672 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6673 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6674 vv(1)=pizda(1,1)+pizda(2,2)
6675 vv(2)=pizda(2,1)-pizda(1,2)
6676 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6677 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6678 C Cartesian derivatives.
6684 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6686 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6689 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6691 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6692 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6694 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6695 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6697 vv(1)=pizda(1,1)+pizda(2,2)
6698 vv(2)=pizda(2,1)-pizda(1,2)
6699 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6701 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6703 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6706 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6708 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6710 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6716 c----------------------------------------------------------------------------
6717 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6718 implicit real*8 (a-h,o-z)
6719 include 'DIMENSIONS'
6720 include 'DIMENSIONS.ZSCOPT'
6721 include 'COMMON.IOUNITS'
6722 include 'COMMON.CHAIN'
6723 include 'COMMON.DERIV'
6724 include 'COMMON.INTERACT'
6725 include 'COMMON.CONTACTS'
6726 include 'COMMON.TORSION'
6727 include 'COMMON.VAR'
6728 include 'COMMON.GEO'
6729 include 'COMMON.FFIELD'
6730 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6731 & auxvec1(2),auxmat1(2,2)
6733 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6735 C Parallel Antiparallel
6746 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6748 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6749 C energy moment and not to the cluster cumulant.
6750 cd write (2,*) 'eello_graph4: wturn6',wturn6
6751 iti=itortyp(itype(i))
6752 itj=itortyp(itype(j))
6753 if (j.lt.nres-1) then
6754 itj1=itortyp(itype(j+1))
6758 itk=itortyp(itype(k))
6759 if (k.lt.nres-1) then
6760 itk1=itortyp(itype(k+1))
6764 itl=itortyp(itype(l))
6765 if (l.lt.nres-1) then
6766 itl1=itortyp(itype(l+1))
6770 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6771 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6772 cd & ' itl',itl,' itl1',itl1
6775 s1=dip(3,jj,i)*dip(3,kk,k)
6777 s1=dip(2,jj,j)*dip(2,kk,l)
6780 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6781 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6783 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6784 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6786 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6787 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6789 call transpose2(EUg(1,1,k),auxmat(1,1))
6790 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6791 vv(1)=pizda(1,1)-pizda(2,2)
6792 vv(2)=pizda(2,1)+pizda(1,2)
6793 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6794 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6796 eello6_graph4=-(s1+s2+s3+s4)
6798 eello6_graph4=-(s2+s3+s4)
6800 if (.not. calc_grad) return
6801 C Derivatives in gamma(i-1)
6805 s1=dipderg(2,jj,i)*dip(3,kk,k)
6807 s1=dipderg(4,jj,j)*dip(2,kk,l)
6810 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6812 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6813 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6815 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6816 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6818 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6819 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6820 cd write (2,*) 'turn6 derivatives'
6822 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6824 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6828 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6830 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6834 C Derivatives in gamma(k-1)
6837 s1=dip(3,jj,i)*dipderg(2,kk,k)
6839 s1=dip(2,jj,j)*dipderg(4,kk,l)
6842 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6843 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6845 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6846 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6848 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6849 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6851 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6852 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6853 vv(1)=pizda(1,1)-pizda(2,2)
6854 vv(2)=pizda(2,1)+pizda(1,2)
6855 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6858 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6860 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6864 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6866 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6869 C Derivatives in gamma(j-1) or gamma(l-1)
6870 if (l.eq.j+1 .and. l.gt.1) then
6871 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6872 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6873 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6874 vv(1)=pizda(1,1)-pizda(2,2)
6875 vv(2)=pizda(2,1)+pizda(1,2)
6876 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6877 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6878 else if (j.gt.1) then
6879 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6880 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6881 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6882 vv(1)=pizda(1,1)-pizda(2,2)
6883 vv(2)=pizda(2,1)+pizda(1,2)
6884 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6885 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6886 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6888 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6891 C Cartesian derivatives.
6898 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6900 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6904 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6906 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6910 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6912 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6914 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6915 & b1(1,itj1),auxvec(1))
6916 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6918 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6919 & b1(1,itl1),auxvec(1))
6920 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6922 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6924 vv(1)=pizda(1,1)-pizda(2,2)
6925 vv(2)=pizda(2,1)+pizda(1,2)
6926 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6928 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6930 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6933 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6936 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6939 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6941 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6943 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6947 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6949 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6952 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6954 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6962 c----------------------------------------------------------------------------
6963 double precision function eello_turn6(i,jj,kk)
6964 implicit real*8 (a-h,o-z)
6965 include 'DIMENSIONS'
6966 include 'DIMENSIONS.ZSCOPT'
6967 include 'COMMON.IOUNITS'
6968 include 'COMMON.CHAIN'
6969 include 'COMMON.DERIV'
6970 include 'COMMON.INTERACT'
6971 include 'COMMON.CONTACTS'
6972 include 'COMMON.TORSION'
6973 include 'COMMON.VAR'
6974 include 'COMMON.GEO'
6975 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6976 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6978 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6979 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6980 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6981 C the respective energy moment and not to the cluster cumulant.
6986 iti=itortyp(itype(i))
6987 itk=itortyp(itype(k))
6988 itk1=itortyp(itype(k+1))
6989 itl=itortyp(itype(l))
6990 itj=itortyp(itype(j))
6991 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6992 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6993 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6998 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7000 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7004 derx_turn(lll,kkk,iii)=0.0d0
7011 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7013 cd write (2,*) 'eello6_5',eello6_5
7015 call transpose2(AEA(1,1,1),auxmat(1,1))
7016 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7017 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7018 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7022 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7023 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7024 s2 = scalar2(b1(1,itk),vtemp1(1))
7026 call transpose2(AEA(1,1,2),atemp(1,1))
7027 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7028 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7029 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7033 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7034 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7035 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7037 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7038 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7039 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7040 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7041 ss13 = scalar2(b1(1,itk),vtemp4(1))
7042 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7046 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7052 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7054 C Derivatives in gamma(i+2)
7056 call transpose2(AEA(1,1,1),auxmatd(1,1))
7057 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7058 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7059 call transpose2(AEAderg(1,1,2),atempd(1,1))
7060 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7061 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7065 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7066 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7067 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7073 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7074 C Derivatives in gamma(i+3)
7076 call transpose2(AEA(1,1,1),auxmatd(1,1))
7077 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7078 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7079 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7083 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7084 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7085 s2d = scalar2(b1(1,itk),vtemp1d(1))
7087 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7088 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7090 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7092 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7093 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7094 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7104 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7105 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7107 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7108 & -0.5d0*ekont*(s2d+s12d)
7110 C Derivatives in gamma(i+4)
7111 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7112 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7113 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7115 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7116 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7117 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7127 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7129 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7131 C Derivatives in gamma(i+5)
7133 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7134 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7135 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7139 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7140 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7141 s2d = scalar2(b1(1,itk),vtemp1d(1))
7143 call transpose2(AEA(1,1,2),atempd(1,1))
7144 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7145 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7149 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7150 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7152 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7153 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7154 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7164 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7165 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7167 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7168 & -0.5d0*ekont*(s2d+s12d)
7170 C Cartesian derivatives
7175 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7176 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7177 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7181 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7182 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7184 s2d = scalar2(b1(1,itk),vtemp1d(1))
7186 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7187 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7188 s8d = -(atempd(1,1)+atempd(2,2))*
7189 & scalar2(cc(1,1,itl),vtemp2(1))
7193 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7195 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7196 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7203 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7206 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7210 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7211 & - 0.5d0*(s8d+s12d)
7213 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7222 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7224 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7225 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7226 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7227 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7228 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7230 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7231 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7232 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7236 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7237 cd & 16*eel_turn6_num
7239 if (j.lt.nres-1) then
7246 if (l.lt.nres-1) then
7254 ggg1(ll)=eel_turn6*g_contij(ll,1)
7255 ggg2(ll)=eel_turn6*g_contij(ll,2)
7256 ghalf=0.5d0*ggg1(ll)
7258 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7259 & +ekont*derx_turn(ll,2,1)
7260 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7261 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7262 & +ekont*derx_turn(ll,4,1)
7263 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7264 ghalf=0.5d0*ggg2(ll)
7266 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7267 & +ekont*derx_turn(ll,2,2)
7268 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7269 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7270 & +ekont*derx_turn(ll,4,2)
7271 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7276 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7281 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7287 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7292 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7296 cd write (2,*) iii,g_corr6_loc(iii)
7299 eello_turn6=ekont*eel_turn6
7300 cd write (2,*) 'ekont',ekont
7301 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7304 crc-------------------------------------------------
7305 SUBROUTINE MATVEC2(A1,V1,V2)
7306 implicit real*8 (a-h,o-z)
7307 include 'DIMENSIONS'
7308 DIMENSION A1(2,2),V1(2),V2(2)
7312 c 3 VI=VI+A1(I,K)*V1(K)
7316 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7317 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7322 C---------------------------------------
7323 SUBROUTINE MATMAT2(A1,A2,A3)
7324 implicit real*8 (a-h,o-z)
7325 include 'DIMENSIONS'
7326 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7327 c DIMENSION AI3(2,2)
7331 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7337 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7338 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7339 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7340 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7348 c-------------------------------------------------------------------------
7349 double precision function scalar2(u,v)
7351 double precision u(2),v(2)
7354 scalar2=u(1)*v(1)+u(2)*v(2)
7358 C-----------------------------------------------------------------------------
7360 subroutine transpose2(a,at)
7362 double precision a(2,2),at(2,2)
7369 c--------------------------------------------------------------------------
7370 subroutine transpose(n,a,at)
7373 double precision a(n,n),at(n,n)
7381 C---------------------------------------------------------------------------
7382 subroutine prodmat3(a1,a2,kk,transp,prod)
7385 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7387 crc double precision auxmat(2,2),prod_(2,2)
7390 crc call transpose2(kk(1,1),auxmat(1,1))
7391 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7392 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7394 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7395 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7396 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7397 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7398 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7399 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7400 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7401 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7404 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7405 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7407 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7408 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7409 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7410 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7411 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7412 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7413 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7414 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7417 c call transpose2(a2(1,1),a2t(1,1))
7420 crc print *,((prod_(i,j),i=1,2),j=1,2)
7421 crc print *,((prod(i,j),i=1,2),j=1,2)
7425 C-----------------------------------------------------------------------------
7426 double precision function scalar(u,v)
7428 double precision u(3),v(3)