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
372 itypi1=iabs(itype(i+1))
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
543 itypi1=iabs(itype(i+1))
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
654 itypi1=iabs(itype(i+1))
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.
790 itypi1=iabs(itype(i+1))
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.
935 itypi1=iabs(itype(i+1))
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)
2788 itypj=iabs(itype(j))
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. iabs(itype(iii)).eq.1 .and.
2901 & iabs(itype(jjj)).eq.1) then
2902 call ssbond_ene(iii,jjj,eij)
2904 cd write (iout,*) "eij",eij
2905 else if (ii.gt.nres .and. jj.gt.nres) then
2906 c Restraints from contact prediction
2908 if (dhpb1(i).gt.0.0d0) then
2909 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2910 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2911 c write (iout,*) "beta nmr",
2912 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2916 C Get the force constant corresponding to this distance.
2918 C Calculate the contribution to energy.
2919 ehpb=ehpb+waga*rdis*rdis
2920 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2922 C Evaluate gradient.
2927 ggg(j)=fac*(c(j,jj)-c(j,ii))
2930 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2931 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2934 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2935 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2938 C Calculate the distance between the two points and its difference from the
2941 if (dhpb1(i).gt.0.0d0) then
2942 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2943 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2944 c write (iout,*) "alph nmr",
2945 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2948 C Get the force constant corresponding to this distance.
2950 C Calculate the contribution to energy.
2951 ehpb=ehpb+waga*rdis*rdis
2952 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2954 C Evaluate gradient.
2958 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2959 cd & ' waga=',waga,' fac=',fac
2961 ggg(j)=fac*(c(j,jj)-c(j,ii))
2963 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2964 C If this is a SC-SC distance, we need to calculate the contributions to the
2965 C Cartesian gradient in the SC vectors (ghpbx).
2968 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2969 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2973 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2974 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2981 C--------------------------------------------------------------------------
2982 subroutine ssbond_ene(i,j,eij)
2984 C Calculate the distance and angle dependent SS-bond potential energy
2985 C using a free-energy function derived based on RHF/6-31G** ab initio
2986 C calculations of diethyl disulfide.
2988 C A. Liwo and U. Kozlowska, 11/24/03
2990 implicit real*8 (a-h,o-z)
2991 include 'DIMENSIONS'
2992 include 'DIMENSIONS.ZSCOPT'
2993 include 'COMMON.SBRIDGE'
2994 include 'COMMON.CHAIN'
2995 include 'COMMON.DERIV'
2996 include 'COMMON.LOCAL'
2997 include 'COMMON.INTERACT'
2998 include 'COMMON.VAR'
2999 include 'COMMON.IOUNITS'
3000 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3001 itypi=iabs(itype(i))
3005 dxi=dc_norm(1,nres+i)
3006 dyi=dc_norm(2,nres+i)
3007 dzi=dc_norm(3,nres+i)
3008 dsci_inv=dsc_inv(itypi)
3009 itypj=iabs(itype(j))
3010 dscj_inv=dsc_inv(itypj)
3014 dxj=dc_norm(1,nres+j)
3015 dyj=dc_norm(2,nres+j)
3016 dzj=dc_norm(3,nres+j)
3017 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3022 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3023 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3024 om12=dxi*dxj+dyi*dyj+dzi*dzj
3026 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3027 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3033 deltat12=om2-om1+2.0d0
3035 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3036 & +akct*deltad*deltat12
3037 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3038 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3039 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3040 c & " deltat12",deltat12," eij",eij
3041 ed=2*akcm*deltad+akct*deltat12
3043 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3044 eom1=-2*akth*deltat1-pom1-om2*pom2
3045 eom2= 2*akth*deltat2+pom1-om1*pom2
3048 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3051 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3052 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3053 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3054 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3057 C Calculate the components of the gradient in DC and X
3061 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3066 C--------------------------------------------------------------------------
3067 subroutine ebond(estr)
3069 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3071 implicit real*8 (a-h,o-z)
3072 include 'DIMENSIONS'
3073 include 'DIMENSIONS.ZSCOPT'
3074 include 'COMMON.LOCAL'
3075 include 'COMMON.GEO'
3076 include 'COMMON.INTERACT'
3077 include 'COMMON.DERIV'
3078 include 'COMMON.VAR'
3079 include 'COMMON.CHAIN'
3080 include 'COMMON.IOUNITS'
3081 include 'COMMON.NAMES'
3082 include 'COMMON.FFIELD'
3083 include 'COMMON.CONTROL'
3084 double precision u(3),ud(3)
3087 diff = vbld(i)-vbldp0
3088 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3091 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3096 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3103 diff=vbld(i+nres)-vbldsc0(1,iti)
3104 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3105 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3106 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3108 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3112 diff=vbld(i+nres)-vbldsc0(j,iti)
3113 ud(j)=aksc(j,iti)*diff
3114 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3128 uprod2=uprod2*u(k)*u(k)
3132 usumsqder=usumsqder+ud(j)*uprod2
3134 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3135 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3136 estr=estr+uprod/usum
3138 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3146 C--------------------------------------------------------------------------
3147 subroutine ebend(etheta)
3149 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3150 C angles gamma and its derivatives in consecutive thetas and gammas.
3152 implicit real*8 (a-h,o-z)
3153 include 'DIMENSIONS'
3154 include 'DIMENSIONS.ZSCOPT'
3155 include 'COMMON.LOCAL'
3156 include 'COMMON.GEO'
3157 include 'COMMON.INTERACT'
3158 include 'COMMON.DERIV'
3159 include 'COMMON.VAR'
3160 include 'COMMON.CHAIN'
3161 include 'COMMON.IOUNITS'
3162 include 'COMMON.NAMES'
3163 include 'COMMON.FFIELD'
3164 common /calcthet/ term1,term2,termm,diffak,ratak,
3165 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3166 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3167 double precision y(2),z(2)
3169 time11=dexp(-2*time)
3172 c write (iout,*) "nres",nres
3173 c write (*,'(a,i2)') 'EBEND ICG=',icg
3174 c write (iout,*) ithet_start,ithet_end
3175 do i=ithet_start,ithet_end
3176 C Zero the energy function and its derivative at 0 or pi.
3177 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3179 ichir1=isign(1,itype(i-2))
3180 ichir2=isign(1,itype(i))
3181 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3182 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3183 if (itype(i-1).eq.10) then
3184 itype1=isign(10,itype(i-2))
3185 ichir11=isign(1,itype(i-2))
3186 ichir12=isign(1,itype(i-2))
3187 itype2=isign(10,itype(i))
3188 ichir21=isign(1,itype(i))
3189 ichir22=isign(1,itype(i))
3191 c if (i.gt.ithet_start .and.
3192 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3193 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3201 c if (i.lt.nres .and. itel(i).ne.0) then
3213 call proc_proc(phii,icrc)
3214 if (icrc.eq.1) phii=150.0
3228 call proc_proc(phii1,icrc)
3229 if (icrc.eq.1) phii1=150.0
3241 C Calculate the "mean" value of theta from the part of the distribution
3242 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3243 C In following comments this theta will be referred to as t_c.
3244 thet_pred_mean=0.0d0
3246 athetk=athet(k,it,ichir1,ichir2)
3247 bthetk=bthet(k,it,ichir1,ichir2)
3249 athetk=athet(k,itype1,ichir11,ichir12)
3250 bthetk=bthet(k,itype2,ichir21,ichir22)
3252 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3254 c write (iout,*) "thet_pred_mean",thet_pred_mean
3255 dthett=thet_pred_mean*ssd
3256 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3257 c write (iout,*) "thet_pred_mean",thet_pred_mean
3258 C Derivatives of the "mean" values in gamma1 and gamma2.
3259 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3260 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3261 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3262 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3264 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3265 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3266 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3267 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3269 if (theta(i).gt.pi-delta) then
3270 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3272 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3273 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3274 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3276 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3278 else if (theta(i).lt.delta) then
3279 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3280 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3281 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3283 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3284 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3287 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3290 etheta=etheta+ethetai
3291 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3292 c & rad2deg*phii,rad2deg*phii1,ethetai
3293 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3294 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3295 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3298 C Ufff.... We've done all this!!!
3301 C---------------------------------------------------------------------------
3302 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3304 implicit real*8 (a-h,o-z)
3305 include 'DIMENSIONS'
3306 include 'COMMON.LOCAL'
3307 include 'COMMON.IOUNITS'
3308 common /calcthet/ term1,term2,termm,diffak,ratak,
3309 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3310 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3311 C Calculate the contributions to both Gaussian lobes.
3312 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3313 C The "polynomial part" of the "standard deviation" of this part of
3317 sig=sig*thet_pred_mean+polthet(j,it)
3319 C Derivative of the "interior part" of the "standard deviation of the"
3320 C gamma-dependent Gaussian lobe in t_c.
3321 sigtc=3*polthet(3,it)
3323 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3326 C Set the parameters of both Gaussian lobes of the distribution.
3327 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3328 fac=sig*sig+sigc0(it)
3331 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3332 sigsqtc=-4.0D0*sigcsq*sigtc
3333 c print *,i,sig,sigtc,sigsqtc
3334 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3335 sigtc=-sigtc/(fac*fac)
3336 C Following variable is sigma(t_c)**(-2)
3337 sigcsq=sigcsq*sigcsq
3339 sig0inv=1.0D0/sig0i**2
3340 delthec=thetai-thet_pred_mean
3341 delthe0=thetai-theta0i
3342 term1=-0.5D0*sigcsq*delthec*delthec
3343 term2=-0.5D0*sig0inv*delthe0*delthe0
3344 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3345 C NaNs in taking the logarithm. We extract the largest exponent which is added
3346 C to the energy (this being the log of the distribution) at the end of energy
3347 C term evaluation for this virtual-bond angle.
3348 if (term1.gt.term2) then
3350 term2=dexp(term2-termm)
3354 term1=dexp(term1-termm)
3357 C The ratio between the gamma-independent and gamma-dependent lobes of
3358 C the distribution is a Gaussian function of thet_pred_mean too.
3359 diffak=gthet(2,it)-thet_pred_mean
3360 ratak=diffak/gthet(3,it)**2
3361 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3362 C Let's differentiate it in thet_pred_mean NOW.
3364 C Now put together the distribution terms to make complete distribution.
3365 termexp=term1+ak*term2
3366 termpre=sigc+ak*sig0i
3367 C Contribution of the bending energy from this theta is just the -log of
3368 C the sum of the contributions from the two lobes and the pre-exponential
3369 C factor. Simple enough, isn't it?
3370 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3371 C NOW the derivatives!!!
3372 C 6/6/97 Take into account the deformation.
3373 E_theta=(delthec*sigcsq*term1
3374 & +ak*delthe0*sig0inv*term2)/termexp
3375 E_tc=((sigtc+aktc*sig0i)/termpre
3376 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3377 & aktc*term2)/termexp)
3380 c-----------------------------------------------------------------------------
3381 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3382 implicit real*8 (a-h,o-z)
3383 include 'DIMENSIONS'
3384 include 'COMMON.LOCAL'
3385 include 'COMMON.IOUNITS'
3386 common /calcthet/ term1,term2,termm,diffak,ratak,
3387 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3388 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3389 delthec=thetai-thet_pred_mean
3390 delthe0=thetai-theta0i
3391 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3392 t3 = thetai-thet_pred_mean
3396 t14 = t12+t6*sigsqtc
3398 t21 = thetai-theta0i
3404 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3405 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3406 & *(-t12*t9-ak*sig0inv*t27)
3410 C--------------------------------------------------------------------------
3411 subroutine ebend(etheta)
3413 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3414 C angles gamma and its derivatives in consecutive thetas and gammas.
3415 C ab initio-derived potentials from
3416 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3418 implicit real*8 (a-h,o-z)
3419 include 'DIMENSIONS'
3420 include 'DIMENSIONS.ZSCOPT'
3421 include 'COMMON.LOCAL'
3422 include 'COMMON.GEO'
3423 include 'COMMON.INTERACT'
3424 include 'COMMON.DERIV'
3425 include 'COMMON.VAR'
3426 include 'COMMON.CHAIN'
3427 include 'COMMON.IOUNITS'
3428 include 'COMMON.NAMES'
3429 include 'COMMON.FFIELD'
3430 include 'COMMON.CONTROL'
3431 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3432 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3433 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3434 & sinph1ph2(maxdouble,maxdouble)
3435 logical lprn /.false./, lprn1 /.false./
3437 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3438 do i=ithet_start,ithet_end
3442 theti2=0.5d0*theta(i)
3443 ityp2=ithetyp(iabs(itype(i-1)))
3445 coskt(k)=dcos(k*theti2)
3446 sinkt(k)=dsin(k*theti2)
3451 if (phii.ne.phii) phii=150.0
3455 ityp1=ithetyp(iabs(itype(i-2)))
3457 cosph1(k)=dcos(k*phii)
3458 sinph1(k)=dsin(k*phii)
3471 if (phii1.ne.phii1) phii1=150.0
3476 ityp3=ithetyp(iabs(itype(i)))
3478 cosph2(k)=dcos(k*phii1)
3479 sinph2(k)=dsin(k*phii1)
3489 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3490 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3492 ethetai=aa0thet(ityp1,ityp2,ityp3)
3495 ccl=cosph1(l)*cosph2(k-l)
3496 ssl=sinph1(l)*sinph2(k-l)
3497 scl=sinph1(l)*cosph2(k-l)
3498 csl=cosph1(l)*sinph2(k-l)
3499 cosph1ph2(l,k)=ccl-ssl
3500 cosph1ph2(k,l)=ccl+ssl
3501 sinph1ph2(l,k)=scl+csl
3502 sinph1ph2(k,l)=scl-csl
3506 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3507 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3508 write (iout,*) "coskt and sinkt"
3510 write (iout,*) k,coskt(k),sinkt(k)
3514 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3515 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3518 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3519 & " ethetai",ethetai
3522 write (iout,*) "cosph and sinph"
3524 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3526 write (iout,*) "cosph1ph2 and sinph2ph2"
3529 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3530 & sinph1ph2(l,k),sinph1ph2(k,l)
3533 write(iout,*) "ethetai",ethetai
3537 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3538 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3539 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3540 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3541 ethetai=ethetai+sinkt(m)*aux
3542 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3543 dephii=dephii+k*sinkt(m)*(
3544 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3545 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3546 dephii1=dephii1+k*sinkt(m)*(
3547 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3548 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3550 & write (iout,*) "m",m," k",k," bbthet",
3551 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3552 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3553 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3554 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3558 & write(iout,*) "ethetai",ethetai
3562 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3563 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3564 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3565 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3566 ethetai=ethetai+sinkt(m)*aux
3567 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3568 dephii=dephii+l*sinkt(m)*(
3569 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3570 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3571 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3572 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3573 dephii1=dephii1+(k-l)*sinkt(m)*(
3574 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3575 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3576 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3577 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3579 write (iout,*) "m",m," k",k," l",l," ffthet",
3580 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3581 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3582 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3583 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3584 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3585 & cosph1ph2(k,l)*sinkt(m),
3586 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3592 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3593 & i,theta(i)*rad2deg,phii*rad2deg,
3594 & phii1*rad2deg,ethetai
3595 etheta=etheta+ethetai
3596 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3597 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3598 gloc(nphi+i-2,icg)=wang*dethetai
3604 c-----------------------------------------------------------------------------
3605 subroutine esc(escloc)
3606 C Calculate the local energy of a side chain and its derivatives in the
3607 C corresponding virtual-bond valence angles THETA and the spherical angles
3609 implicit real*8 (a-h,o-z)
3610 include 'DIMENSIONS'
3611 include 'DIMENSIONS.ZSCOPT'
3612 include 'COMMON.GEO'
3613 include 'COMMON.LOCAL'
3614 include 'COMMON.VAR'
3615 include 'COMMON.INTERACT'
3616 include 'COMMON.DERIV'
3617 include 'COMMON.CHAIN'
3618 include 'COMMON.IOUNITS'
3619 include 'COMMON.NAMES'
3620 include 'COMMON.FFIELD'
3621 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3622 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3623 common /sccalc/ time11,time12,time112,theti,it,nlobit
3626 c write (iout,'(a)') 'ESC'
3627 do i=loc_start,loc_end
3629 if (it.eq.10) goto 1
3630 nlobit=nlob(iabs(it))
3631 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3632 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3633 theti=theta(i+1)-pipol
3637 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3639 if (x(2).gt.pi-delta) then
3643 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3645 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3646 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3648 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3649 & ddersc0(1),dersc(1))
3650 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3651 & ddersc0(3),dersc(3))
3653 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3655 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3656 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3657 & dersc0(2),esclocbi,dersc02)
3658 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3660 call splinthet(x(2),0.5d0*delta,ss,ssd)
3665 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3667 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3668 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3670 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3672 c write (iout,*) escloci
3673 else if (x(2).lt.delta) then
3677 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3679 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3680 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3682 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3683 & ddersc0(1),dersc(1))
3684 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3685 & ddersc0(3),dersc(3))
3687 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3689 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3690 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3691 & dersc0(2),esclocbi,dersc02)
3692 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3697 call splinthet(x(2),0.5d0*delta,ss,ssd)
3699 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3701 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3702 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3704 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3705 c write (iout,*) escloci
3707 call enesc(x,escloci,dersc,ddummy,.false.)
3710 escloc=escloc+escloci
3711 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3713 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3715 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3716 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3721 C---------------------------------------------------------------------------
3722 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3723 implicit real*8 (a-h,o-z)
3724 include 'DIMENSIONS'
3725 include 'COMMON.GEO'
3726 include 'COMMON.LOCAL'
3727 include 'COMMON.IOUNITS'
3728 common /sccalc/ time11,time12,time112,theti,it,nlobit
3729 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3730 double precision contr(maxlob,-1:1)
3732 c write (iout,*) 'it=',it,' nlobit=',nlobit
3736 if (mixed) ddersc(j)=0.0d0
3740 C Because of periodicity of the dependence of the SC energy in omega we have
3741 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3742 C To avoid underflows, first compute & store the exponents.
3750 z(k)=x(k)-censc(k,j,it)
3755 Axk=Axk+gaussc(l,k,j,it)*z(l)
3761 expfac=expfac+Ax(k,j,iii)*z(k)
3769 C As in the case of ebend, we want to avoid underflows in exponentiation and
3770 C subsequent NaNs and INFs in energy calculation.
3771 C Find the largest exponent
3775 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3779 cd print *,'it=',it,' emin=',emin
3781 C Compute the contribution to SC energy and derivatives
3785 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3786 cd print *,'j=',j,' expfac=',expfac
3787 escloc_i=escloc_i+expfac
3789 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3793 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3794 & +gaussc(k,2,j,it))*expfac
3801 dersc(1)=dersc(1)/cos(theti)**2
3802 ddersc(1)=ddersc(1)/cos(theti)**2
3805 escloci=-(dlog(escloc_i)-emin)
3807 dersc(j)=dersc(j)/escloc_i
3811 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3816 C------------------------------------------------------------------------------
3817 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3818 implicit real*8 (a-h,o-z)
3819 include 'DIMENSIONS'
3820 include 'COMMON.GEO'
3821 include 'COMMON.LOCAL'
3822 include 'COMMON.IOUNITS'
3823 common /sccalc/ time11,time12,time112,theti,it,nlobit
3824 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3825 double precision contr(maxlob)
3836 z(k)=x(k)-censc(k,j,it)
3842 Axk=Axk+gaussc(l,k,j,it)*z(l)
3848 expfac=expfac+Ax(k,j)*z(k)
3853 C As in the case of ebend, we want to avoid underflows in exponentiation and
3854 C subsequent NaNs and INFs in energy calculation.
3855 C Find the largest exponent
3858 if (emin.gt.contr(j)) emin=contr(j)
3862 C Compute the contribution to SC energy and derivatives
3866 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3867 escloc_i=escloc_i+expfac
3869 dersc(k)=dersc(k)+Ax(k,j)*expfac
3871 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3872 & +gaussc(1,2,j,it))*expfac
3876 dersc(1)=dersc(1)/cos(theti)**2
3877 dersc12=dersc12/cos(theti)**2
3878 escloci=-(dlog(escloc_i)-emin)
3880 dersc(j)=dersc(j)/escloc_i
3882 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3886 c----------------------------------------------------------------------------------
3887 subroutine esc(escloc)
3888 C Calculate the local energy of a side chain and its derivatives in the
3889 C corresponding virtual-bond valence angles THETA and the spherical angles
3890 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3891 C added by Urszula Kozlowska. 07/11/2007
3893 implicit real*8 (a-h,o-z)
3894 include 'DIMENSIONS'
3895 include 'DIMENSIONS.ZSCOPT'
3896 include 'COMMON.GEO'
3897 include 'COMMON.LOCAL'
3898 include 'COMMON.VAR'
3899 include 'COMMON.SCROT'
3900 include 'COMMON.INTERACT'
3901 include 'COMMON.DERIV'
3902 include 'COMMON.CHAIN'
3903 include 'COMMON.IOUNITS'
3904 include 'COMMON.NAMES'
3905 include 'COMMON.FFIELD'
3906 include 'COMMON.CONTROL'
3907 include 'COMMON.VECTORS'
3908 double precision x_prime(3),y_prime(3),z_prime(3)
3909 & , sumene,dsc_i,dp2_i,x(65),
3910 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3911 & de_dxx,de_dyy,de_dzz,de_dt
3912 double precision s1_t,s1_6_t,s2_t,s2_6_t
3914 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3915 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3916 & dt_dCi(3),dt_dCi1(3)
3917 common /sccalc/ time11,time12,time112,theti,it,nlobit
3920 do i=loc_start,loc_end
3921 costtab(i+1) =dcos(theta(i+1))
3922 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3923 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3924 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3925 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3926 cosfac=dsqrt(cosfac2)
3927 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3928 sinfac=dsqrt(sinfac2)
3930 if (it.eq.10) goto 1
3932 C Compute the axes of tghe local cartesian coordinates system; store in
3933 c x_prime, y_prime and z_prime
3940 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3941 C & dc_norm(3,i+nres)
3943 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3944 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3947 z_prime(j) = -uz(j,i-1)
3950 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3951 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3952 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3953 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3954 c & " xy",scalar(x_prime(1),y_prime(1)),
3955 c & " xz",scalar(x_prime(1),z_prime(1)),
3956 c & " yy",scalar(y_prime(1),y_prime(1)),
3957 c & " yz",scalar(y_prime(1),z_prime(1)),
3958 c & " zz",scalar(z_prime(1),z_prime(1))
3960 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3961 C to local coordinate system. Store in xx, yy, zz.
3967 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3968 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3969 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
3976 C Compute the energy of the ith side cbain
3978 c write (2,*) "xx",xx," yy",yy," zz",zz
3981 x(j) = sc_parmin(j,it)
3984 Cc diagnostics - remove later
3986 yy1 = dsin(alph(2))*dcos(omeg(2))
3987 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3988 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3989 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3991 C," --- ", xx_w,yy_w,zz_w
3994 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3995 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3997 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3998 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4000 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4001 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4002 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4003 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4004 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4006 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4007 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4008 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4009 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4010 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4012 dsc_i = 0.743d0+x(61)
4014 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4015 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4016 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4017 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4018 s1=(1+x(63))/(0.1d0 + dscp1)
4019 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4020 s2=(1+x(65))/(0.1d0 + dscp2)
4021 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4022 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4023 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4024 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4026 c & dscp1,dscp2,sumene
4027 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4028 escloc = escloc + sumene
4029 c write (2,*) "escloc",escloc
4030 if (.not. calc_grad) goto 1
4033 C This section to check the numerical derivatives of the energy of ith side
4034 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4035 C #define DEBUG in the code to turn it on.
4037 write (2,*) "sumene =",sumene
4041 write (2,*) xx,yy,zz
4042 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4043 de_dxx_num=(sumenep-sumene)/aincr
4045 write (2,*) "xx+ sumene from enesc=",sumenep
4048 write (2,*) xx,yy,zz
4049 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4050 de_dyy_num=(sumenep-sumene)/aincr
4052 write (2,*) "yy+ sumene from enesc=",sumenep
4055 write (2,*) xx,yy,zz
4056 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4057 de_dzz_num=(sumenep-sumene)/aincr
4059 write (2,*) "zz+ sumene from enesc=",sumenep
4060 costsave=cost2tab(i+1)
4061 sintsave=sint2tab(i+1)
4062 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4063 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4064 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4065 de_dt_num=(sumenep-sumene)/aincr
4066 write (2,*) " t+ sumene from enesc=",sumenep
4067 cost2tab(i+1)=costsave
4068 sint2tab(i+1)=sintsave
4069 C End of diagnostics section.
4072 C Compute the gradient of esc
4074 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4075 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4076 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4077 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4078 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4079 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4080 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4081 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4082 pom1=(sumene3*sint2tab(i+1)+sumene1)
4083 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4084 pom2=(sumene4*cost2tab(i+1)+sumene2)
4085 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4086 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4087 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4088 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4090 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4091 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4092 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4094 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4095 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4096 & +(pom1+pom2)*pom_dx
4098 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4101 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4102 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4103 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4105 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4106 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4107 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4108 & +x(59)*zz**2 +x(60)*xx*zz
4109 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4110 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4111 & +(pom1-pom2)*pom_dy
4113 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4116 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4117 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4118 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4119 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4120 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4121 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4122 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4123 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4125 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4128 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4129 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4130 & +pom1*pom_dt1+pom2*pom_dt2
4132 write(2,*), "de_dt = ", de_dt,de_dt_num
4136 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4137 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4138 cosfac2xx=cosfac2*xx
4139 sinfac2yy=sinfac2*yy
4141 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4143 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4145 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4146 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4147 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4148 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4149 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4150 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4151 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4152 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4153 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4154 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4158 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4159 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4162 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4163 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4164 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4166 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4167 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4171 dXX_Ctab(k,i)=dXX_Ci(k)
4172 dXX_C1tab(k,i)=dXX_Ci1(k)
4173 dYY_Ctab(k,i)=dYY_Ci(k)
4174 dYY_C1tab(k,i)=dYY_Ci1(k)
4175 dZZ_Ctab(k,i)=dZZ_Ci(k)
4176 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4177 dXX_XYZtab(k,i)=dXX_XYZ(k)
4178 dYY_XYZtab(k,i)=dYY_XYZ(k)
4179 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4183 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4184 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4185 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4186 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4187 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4189 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4190 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4191 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4192 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4193 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4194 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4195 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4196 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4198 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4199 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4201 C to check gradient call subroutine check_grad
4208 c------------------------------------------------------------------------------
4209 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4211 C This procedure calculates two-body contact function g(rij) and its derivative:
4214 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4217 C where x=(rij-r0ij)/delta
4219 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4222 double precision rij,r0ij,eps0ij,fcont,fprimcont
4223 double precision x,x2,x4,delta
4227 if (x.lt.-1.0D0) then
4230 else if (x.le.1.0D0) then
4233 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4234 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4241 c------------------------------------------------------------------------------
4242 subroutine splinthet(theti,delta,ss,ssder)
4243 implicit real*8 (a-h,o-z)
4244 include 'DIMENSIONS'
4245 include 'DIMENSIONS.ZSCOPT'
4246 include 'COMMON.VAR'
4247 include 'COMMON.GEO'
4250 if (theti.gt.pipol) then
4251 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4253 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4258 c------------------------------------------------------------------------------
4259 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4261 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4262 double precision ksi,ksi2,ksi3,a1,a2,a3
4263 a1=fprim0*delta/(f1-f0)
4269 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4270 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4273 c------------------------------------------------------------------------------
4274 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4276 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4277 double precision ksi,ksi2,ksi3,a1,a2,a3
4282 a2=3*(f1x-f0x)-2*fprim0x*delta
4283 a3=fprim0x*delta-2*(f1x-f0x)
4284 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4287 C-----------------------------------------------------------------------------
4289 C-----------------------------------------------------------------------------
4290 subroutine etor(etors,edihcnstr,fact)
4291 implicit real*8 (a-h,o-z)
4292 include 'DIMENSIONS'
4293 include 'DIMENSIONS.ZSCOPT'
4294 include 'COMMON.VAR'
4295 include 'COMMON.GEO'
4296 include 'COMMON.LOCAL'
4297 include 'COMMON.TORSION'
4298 include 'COMMON.INTERACT'
4299 include 'COMMON.DERIV'
4300 include 'COMMON.CHAIN'
4301 include 'COMMON.NAMES'
4302 include 'COMMON.IOUNITS'
4303 include 'COMMON.FFIELD'
4304 include 'COMMON.TORCNSTR'
4306 C Set lprn=.true. for debugging
4310 do i=iphi_start,iphi_end
4311 itori=itortyp(itype(i-2))
4312 itori1=itortyp(itype(i-1))
4315 C Proline-Proline pair is a special case...
4316 if (itori.eq.3 .and. itori1.eq.3) then
4317 if (phii.gt.-dwapi3) then
4319 fac=1.0D0/(1.0D0-cosphi)
4320 etorsi=v1(1,3,3)*fac
4321 etorsi=etorsi+etorsi
4322 etors=etors+etorsi-v1(1,3,3)
4323 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4326 v1ij=v1(j+1,itori,itori1)
4327 v2ij=v2(j+1,itori,itori1)
4330 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4331 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4335 v1ij=v1(j,itori,itori1)
4336 v2ij=v2(j,itori,itori1)
4339 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4340 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4344 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4345 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4346 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4347 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4348 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4350 ! 6/20/98 - dihedral angle constraints
4353 itori=idih_constr(i)
4356 if (difi.gt.drange(i)) then
4358 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4359 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4360 else if (difi.lt.-drange(i)) then
4362 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4363 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4365 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4366 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4368 ! write (iout,*) 'edihcnstr',edihcnstr
4371 c------------------------------------------------------------------------------
4373 subroutine etor(etors,edihcnstr,fact)
4374 implicit real*8 (a-h,o-z)
4375 include 'DIMENSIONS'
4376 include 'DIMENSIONS.ZSCOPT'
4377 include 'COMMON.VAR'
4378 include 'COMMON.GEO'
4379 include 'COMMON.LOCAL'
4380 include 'COMMON.TORSION'
4381 include 'COMMON.INTERACT'
4382 include 'COMMON.DERIV'
4383 include 'COMMON.CHAIN'
4384 include 'COMMON.NAMES'
4385 include 'COMMON.IOUNITS'
4386 include 'COMMON.FFIELD'
4387 include 'COMMON.TORCNSTR'
4389 C Set lprn=.true. for debugging
4393 do i=iphi_start,iphi_end
4394 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4395 if (iabs(itype(i)).eq.20) then
4400 itori=itortyp(itype(i-2))
4401 itori1=itortyp(itype(i-1))
4404 C Regular cosine and sine terms
4405 do j=1,nterm(itori,itori1,iblock)
4406 v1ij=v1(j,itori,itori1,iblock)
4407 v2ij=v2(j,itori,itori1,iblock)
4410 etors=etors+v1ij*cosphi+v2ij*sinphi
4411 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4415 C E = SUM ----------------------------------- - v1
4416 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4418 cosphi=dcos(0.5d0*phii)
4419 sinphi=dsin(0.5d0*phii)
4420 do j=1,nlor(itori,itori1,iblock)
4421 vl1ij=vlor1(j,itori,itori1)
4422 vl2ij=vlor2(j,itori,itori1)
4423 vl3ij=vlor3(j,itori,itori1)
4424 pom=vl2ij*cosphi+vl3ij*sinphi
4425 pom1=1.0d0/(pom*pom+1.0d0)
4426 etors=etors+vl1ij*pom1
4428 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4430 C Subtract the constant term
4431 etors=etors-v0(itori,itori1,iblock)
4433 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4434 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4435 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4436 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4437 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4440 ! 6/20/98 - dihedral angle constraints
4443 itori=idih_constr(i)
4445 difi=pinorm(phii-phi0(i))
4447 if (difi.gt.drange(i)) then
4449 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4450 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4451 edihi=0.25d0*ftors*difi**4
4452 else if (difi.lt.-drange(i)) then
4454 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4455 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4456 edihi=0.25d0*ftors*difi**4
4460 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4462 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4463 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4465 ! write (iout,*) 'edihcnstr',edihcnstr
4468 c----------------------------------------------------------------------------
4469 subroutine etor_d(etors_d,fact2)
4470 C 6/23/01 Compute double torsional energy
4471 implicit real*8 (a-h,o-z)
4472 include 'DIMENSIONS'
4473 include 'DIMENSIONS.ZSCOPT'
4474 include 'COMMON.VAR'
4475 include 'COMMON.GEO'
4476 include 'COMMON.LOCAL'
4477 include 'COMMON.TORSION'
4478 include 'COMMON.INTERACT'
4479 include 'COMMON.DERIV'
4480 include 'COMMON.CHAIN'
4481 include 'COMMON.NAMES'
4482 include 'COMMON.IOUNITS'
4483 include 'COMMON.FFIELD'
4484 include 'COMMON.TORCNSTR'
4486 C Set lprn=.true. for debugging
4490 do i=iphi_start,iphi_end-1
4491 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4493 itori=itortyp(itype(i-2))
4494 itori1=itortyp(itype(i-1))
4495 itori2=itortyp(itype(i))
4497 c if (iabs(itype(i+1)).eq.20) iblock=2
4503 if (iabs(itype(i+1)).eq.20) iblock=2
4504 C Regular cosine and sine terms
4505 c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
4506 c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4507 c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4508 c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4509 c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4510 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4511 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4512 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4513 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4514 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4516 cosphi1=dcos(j*phii)
4517 sinphi1=dsin(j*phii)
4518 cosphi2=dcos(j*phii1)
4519 sinphi2=dsin(j*phii1)
4520 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4521 & v2cij*cosphi2+v2sij*sinphi2
4522 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4523 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4525 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4527 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4528 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4529 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4530 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4531 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4532 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4533 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4534 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4535 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4536 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4537 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4538 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4539 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4540 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4543 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4544 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4550 c------------------------------------------------------------------------------
4551 subroutine eback_sc_corr(esccor)
4552 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4553 c conformational states; temporarily implemented as differences
4554 c between UNRES torsional potentials (dependent on three types of
4555 c residues) and the torsional potentials dependent on all 20 types
4556 c of residues computed from AM1 energy surfaces of terminally-blocked
4557 c amino-acid residues.
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'DIMENSIONS.ZSCOPT'
4561 include 'COMMON.VAR'
4562 include 'COMMON.GEO'
4563 include 'COMMON.LOCAL'
4564 include 'COMMON.TORSION'
4565 include 'COMMON.SCCOR'
4566 include 'COMMON.INTERACT'
4567 include 'COMMON.DERIV'
4568 include 'COMMON.CHAIN'
4569 include 'COMMON.NAMES'
4570 include 'COMMON.IOUNITS'
4571 include 'COMMON.FFIELD'
4572 include 'COMMON.CONTROL'
4574 C Set lprn=.true. for debugging
4577 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4579 do i=itau_start,itau_end
4581 isccori=isccortyp((itype(i-2)))
4582 isccori1=isccortyp((itype(i-1)))
4584 cccc Added 9 May 2012
4585 cc Tauangle is torsional engle depending on the value of first digit
4586 c(see comment below)
4587 cc Omicron is flat angle depending on the value of first digit
4588 c(see comment below)
4591 do intertyp=1,3 !intertyp
4592 cc Added 09 May 2012 (Adasko)
4593 cc Intertyp means interaction type of backbone mainchain correlation:
4594 c 1 = SC...Ca...Ca...Ca
4595 c 2 = Ca...Ca...Ca...SC
4596 c 3 = SC...Ca...Ca...SCi
4598 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4599 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4600 & (itype(i-1).eq.ntyp1)))
4601 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4602 & .or.(itype(i-2).eq.ntyp1)))
4603 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4604 & (itype(i-1).eq.ntyp1)))) cycle
4605 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4606 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4608 do j=1,nterm_sccor(isccori,isccori1)
4609 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4610 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4611 cosphi=dcos(j*tauangle(intertyp,i))
4612 sinphi=dsin(j*tauangle(intertyp,i))
4613 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4614 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4616 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4617 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4618 c &gloc_sc(intertyp,i-3,icg)
4620 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4621 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4622 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4623 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4624 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4628 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4632 c------------------------------------------------------------------------------
4633 subroutine multibody(ecorr)
4634 C This subroutine calculates multi-body contributions to energy following
4635 C the idea of Skolnick et al. If side chains I and J make a contact and
4636 C at the same time side chains I+1 and J+1 make a contact, an extra
4637 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4638 implicit real*8 (a-h,o-z)
4639 include 'DIMENSIONS'
4640 include 'COMMON.IOUNITS'
4641 include 'COMMON.DERIV'
4642 include 'COMMON.INTERACT'
4643 include 'COMMON.CONTACTS'
4644 double precision gx(3),gx1(3)
4647 C Set lprn=.true. for debugging
4651 write (iout,'(a)') 'Contact function values:'
4653 write (iout,'(i2,20(1x,i2,f10.5))')
4654 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4669 num_conti=num_cont(i)
4670 num_conti1=num_cont(i1)
4675 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4676 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4677 cd & ' ishift=',ishift
4678 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4679 C The system gains extra energy.
4680 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4681 endif ! j1==j+-ishift
4690 c------------------------------------------------------------------------------
4691 double precision function esccorr(i,j,k,l,jj,kk)
4692 implicit real*8 (a-h,o-z)
4693 include 'DIMENSIONS'
4694 include 'COMMON.IOUNITS'
4695 include 'COMMON.DERIV'
4696 include 'COMMON.INTERACT'
4697 include 'COMMON.CONTACTS'
4698 double precision gx(3),gx1(3)
4703 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4704 C Calculate the multi-body contribution to energy.
4705 C Calculate multi-body contributions to the gradient.
4706 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4707 cd & k,l,(gacont(m,kk,k),m=1,3)
4709 gx(m) =ekl*gacont(m,jj,i)
4710 gx1(m)=eij*gacont(m,kk,k)
4711 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4712 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4713 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4714 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4718 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4723 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4729 c------------------------------------------------------------------------------
4731 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4732 implicit real*8 (a-h,o-z)
4733 include 'DIMENSIONS'
4734 integer dimen1,dimen2,atom,indx
4735 double precision buffer(dimen1,dimen2)
4736 double precision zapas
4737 common /contacts_hb/ zapas(3,20,maxres,7),
4738 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4739 & num_cont_hb(maxres),jcont_hb(20,maxres)
4740 num_kont=num_cont_hb(atom)
4744 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4747 buffer(i,indx+22)=facont_hb(i,atom)
4748 buffer(i,indx+23)=ees0p(i,atom)
4749 buffer(i,indx+24)=ees0m(i,atom)
4750 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4752 buffer(1,indx+26)=dfloat(num_kont)
4755 c------------------------------------------------------------------------------
4756 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4757 implicit real*8 (a-h,o-z)
4758 include 'DIMENSIONS'
4759 integer dimen1,dimen2,atom,indx
4760 double precision buffer(dimen1,dimen2)
4761 double precision zapas
4762 common /contacts_hb/ zapas(3,20,maxres,7),
4763 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4764 & num_cont_hb(maxres),jcont_hb(20,maxres)
4765 num_kont=buffer(1,indx+26)
4766 num_kont_old=num_cont_hb(atom)
4767 num_cont_hb(atom)=num_kont+num_kont_old
4772 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4775 facont_hb(ii,atom)=buffer(i,indx+22)
4776 ees0p(ii,atom)=buffer(i,indx+23)
4777 ees0m(ii,atom)=buffer(i,indx+24)
4778 jcont_hb(ii,atom)=buffer(i,indx+25)
4782 c------------------------------------------------------------------------------
4784 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4785 C This subroutine calculates multi-body contributions to hydrogen-bonding
4786 implicit real*8 (a-h,o-z)
4787 include 'DIMENSIONS'
4788 include 'DIMENSIONS.ZSCOPT'
4789 include 'COMMON.IOUNITS'
4791 include 'COMMON.INFO'
4793 include 'COMMON.FFIELD'
4794 include 'COMMON.DERIV'
4795 include 'COMMON.INTERACT'
4796 include 'COMMON.CONTACTS'
4798 parameter (max_cont=maxconts)
4799 parameter (max_dim=2*(8*3+2))
4800 parameter (msglen1=max_cont*max_dim*4)
4801 parameter (msglen2=2*msglen1)
4802 integer source,CorrelType,CorrelID,Error
4803 double precision buffer(max_cont,max_dim)
4805 double precision gx(3),gx1(3)
4808 C Set lprn=.true. for debugging
4813 if (fgProcs.le.1) goto 30
4815 write (iout,'(a)') 'Contact function values:'
4817 write (iout,'(2i3,50(1x,i2,f5.2))')
4818 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4819 & j=1,num_cont_hb(i))
4822 C Caution! Following code assumes that electrostatic interactions concerning
4823 C a given atom are split among at most two processors!
4833 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4836 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4837 if (MyRank.gt.0) then
4838 C Send correlation contributions to the preceding processor
4840 nn=num_cont_hb(iatel_s)
4841 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4842 cd write (iout,*) 'The BUFFER array:'
4844 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4846 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4848 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4849 C Clear the contacts of the atom passed to the neighboring processor
4850 nn=num_cont_hb(iatel_s+1)
4852 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4854 num_cont_hb(iatel_s)=0
4856 cd write (iout,*) 'Processor ',MyID,MyRank,
4857 cd & ' is sending correlation contribution to processor',MyID-1,
4858 cd & ' msglen=',msglen
4859 cd write (*,*) 'Processor ',MyID,MyRank,
4860 cd & ' is sending correlation contribution to processor',MyID-1,
4861 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4862 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4863 cd write (iout,*) 'Processor ',MyID,
4864 cd & ' has sent correlation contribution to processor',MyID-1,
4865 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4866 cd write (*,*) 'Processor ',MyID,
4867 cd & ' has sent correlation contribution to processor',MyID-1,
4868 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4870 endif ! (MyRank.gt.0)
4874 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4875 if (MyRank.lt.fgProcs-1) then
4876 C Receive correlation contributions from the next processor
4878 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4879 cd write (iout,*) 'Processor',MyID,
4880 cd & ' is receiving correlation contribution from processor',MyID+1,
4881 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4882 cd write (*,*) 'Processor',MyID,
4883 cd & ' is receiving correlation contribution from processor',MyID+1,
4884 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4886 do while (nbytes.le.0)
4887 call mp_probe(MyID+1,CorrelType,nbytes)
4889 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4890 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4891 cd write (iout,*) 'Processor',MyID,
4892 cd & ' has received correlation contribution from processor',MyID+1,
4893 cd & ' msglen=',msglen,' nbytes=',nbytes
4894 cd write (iout,*) 'The received BUFFER array:'
4896 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4898 if (msglen.eq.msglen1) then
4899 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4900 else if (msglen.eq.msglen2) then
4901 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4902 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4905 & 'ERROR!!!! message length changed while processing correlations.'
4907 & 'ERROR!!!! message length changed while processing correlations.'
4908 call mp_stopall(Error)
4909 endif ! msglen.eq.msglen1
4910 endif ! MyRank.lt.fgProcs-1
4917 write (iout,'(a)') 'Contact function values:'
4919 write (iout,'(2i3,50(1x,i2,f5.2))')
4920 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4921 & j=1,num_cont_hb(i))
4925 C Remove the loop below after debugging !!!
4932 C Calculate the local-electrostatic correlation terms
4933 do i=iatel_s,iatel_e+1
4935 num_conti=num_cont_hb(i)
4936 num_conti1=num_cont_hb(i+1)
4941 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4942 c & ' jj=',jj,' kk=',kk
4943 if (j1.eq.j+1 .or. j1.eq.j-1) then
4944 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4945 C The system gains extra energy.
4946 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4948 else if (j1.eq.j) then
4949 C Contacts I-J and I-(J+1) occur simultaneously.
4950 C The system loses extra energy.
4951 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4956 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4957 c & ' jj=',jj,' kk=',kk
4959 C Contacts I-J and (I+1)-J occur simultaneously.
4960 C The system loses extra energy.
4961 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4968 c------------------------------------------------------------------------------
4969 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4971 C This subroutine calculates multi-body contributions to hydrogen-bonding
4972 implicit real*8 (a-h,o-z)
4973 include 'DIMENSIONS'
4974 include 'DIMENSIONS.ZSCOPT'
4975 include 'COMMON.IOUNITS'
4977 include 'COMMON.INFO'
4979 include 'COMMON.FFIELD'
4980 include 'COMMON.DERIV'
4981 include 'COMMON.INTERACT'
4982 include 'COMMON.CONTACTS'
4984 parameter (max_cont=maxconts)
4985 parameter (max_dim=2*(8*3+2))
4986 parameter (msglen1=max_cont*max_dim*4)
4987 parameter (msglen2=2*msglen1)
4988 integer source,CorrelType,CorrelID,Error
4989 double precision buffer(max_cont,max_dim)
4991 double precision gx(3),gx1(3)
4994 C Set lprn=.true. for debugging
5000 if (fgProcs.le.1) goto 30
5002 write (iout,'(a)') 'Contact function values:'
5004 write (iout,'(2i3,50(1x,i2,f5.2))')
5005 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5006 & j=1,num_cont_hb(i))
5009 C Caution! Following code assumes that electrostatic interactions concerning
5010 C a given atom are split among at most two processors!
5020 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5023 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5024 if (MyRank.gt.0) then
5025 C Send correlation contributions to the preceding processor
5027 nn=num_cont_hb(iatel_s)
5028 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5029 cd write (iout,*) 'The BUFFER array:'
5031 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5033 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5035 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5036 C Clear the contacts of the atom passed to the neighboring processor
5037 nn=num_cont_hb(iatel_s+1)
5039 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5041 num_cont_hb(iatel_s)=0
5043 cd write (iout,*) 'Processor ',MyID,MyRank,
5044 cd & ' is sending correlation contribution to processor',MyID-1,
5045 cd & ' msglen=',msglen
5046 cd write (*,*) 'Processor ',MyID,MyRank,
5047 cd & ' is sending correlation contribution to processor',MyID-1,
5048 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5049 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5050 cd write (iout,*) 'Processor ',MyID,
5051 cd & ' has sent correlation contribution to processor',MyID-1,
5052 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5053 cd write (*,*) 'Processor ',MyID,
5054 cd & ' has sent correlation contribution to processor',MyID-1,
5055 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5057 endif ! (MyRank.gt.0)
5061 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5062 if (MyRank.lt.fgProcs-1) then
5063 C Receive correlation contributions from the next processor
5065 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5066 cd write (iout,*) 'Processor',MyID,
5067 cd & ' is receiving correlation contribution from processor',MyID+1,
5068 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5069 cd write (*,*) 'Processor',MyID,
5070 cd & ' is receiving correlation contribution from processor',MyID+1,
5071 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5073 do while (nbytes.le.0)
5074 call mp_probe(MyID+1,CorrelType,nbytes)
5076 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5077 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5078 cd write (iout,*) 'Processor',MyID,
5079 cd & ' has received correlation contribution from processor',MyID+1,
5080 cd & ' msglen=',msglen,' nbytes=',nbytes
5081 cd write (iout,*) 'The received BUFFER array:'
5083 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5085 if (msglen.eq.msglen1) then
5086 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5087 else if (msglen.eq.msglen2) then
5088 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5089 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5092 & 'ERROR!!!! message length changed while processing correlations.'
5094 & 'ERROR!!!! message length changed while processing correlations.'
5095 call mp_stopall(Error)
5096 endif ! msglen.eq.msglen1
5097 endif ! MyRank.lt.fgProcs-1
5104 write (iout,'(a)') 'Contact function values:'
5106 write (iout,'(2i3,50(1x,i2,f5.2))')
5107 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5108 & j=1,num_cont_hb(i))
5114 C Remove the loop below after debugging !!!
5121 C Calculate the dipole-dipole interaction energies
5122 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5123 do i=iatel_s,iatel_e+1
5124 num_conti=num_cont_hb(i)
5131 C Calculate the local-electrostatic correlation terms
5132 do i=iatel_s,iatel_e+1
5134 num_conti=num_cont_hb(i)
5135 num_conti1=num_cont_hb(i+1)
5140 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5141 c & ' jj=',jj,' kk=',kk
5142 if (j1.eq.j+1 .or. j1.eq.j-1) then
5143 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5144 C The system gains extra energy.
5146 sqd1=dsqrt(d_cont(jj,i))
5147 sqd2=dsqrt(d_cont(kk,i1))
5148 sred_geom = sqd1*sqd2
5149 IF (sred_geom.lt.cutoff_corr) THEN
5150 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5152 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5153 c & ' jj=',jj,' kk=',kk
5154 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5155 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5157 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5158 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5161 cd write (iout,*) 'sred_geom=',sred_geom,
5162 cd & ' ekont=',ekont,' fprim=',fprimcont
5163 call calc_eello(i,j,i+1,j1,jj,kk)
5164 if (wcorr4.gt.0.0d0)
5165 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5166 if (wcorr5.gt.0.0d0)
5167 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5168 c print *,"wcorr5",ecorr5
5169 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5170 cd write(2,*)'ijkl',i,j,i+1,j1
5171 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5172 & .or. wturn6.eq.0.0d0))then
5173 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5174 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5175 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5176 cd & 'ecorr6=',ecorr6
5177 cd write (iout,'(4e15.5)') sred_geom,
5178 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5179 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5180 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5181 else if (wturn6.gt.0.0d0
5182 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5183 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5184 eturn6=eturn6+eello_turn6(i,jj,kk)
5185 cd write (2,*) 'multibody_eello:eturn6',eturn6
5189 else if (j1.eq.j) then
5190 C Contacts I-J and I-(J+1) occur simultaneously.
5191 C The system loses extra energy.
5192 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5197 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5198 c & ' jj=',jj,' kk=',kk
5200 C Contacts I-J and (I+1)-J occur simultaneously.
5201 C The system loses extra energy.
5202 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5209 c------------------------------------------------------------------------------
5210 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5211 implicit real*8 (a-h,o-z)
5212 include 'DIMENSIONS'
5213 include 'COMMON.IOUNITS'
5214 include 'COMMON.DERIV'
5215 include 'COMMON.INTERACT'
5216 include 'COMMON.CONTACTS'
5217 double precision gx(3),gx1(3)
5227 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5228 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5229 C Following 4 lines for diagnostics.
5234 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5236 c write (iout,*)'Contacts have occurred for peptide groups',
5237 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5238 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5239 C Calculate the multi-body contribution to energy.
5240 ecorr=ecorr+ekont*ees
5242 C Calculate multi-body contributions to the gradient.
5244 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5245 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5246 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5247 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5248 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5249 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5250 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5251 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5252 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5253 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5254 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5255 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5256 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5257 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5261 gradcorr(ll,m)=gradcorr(ll,m)+
5262 & ees*ekl*gacont_hbr(ll,jj,i)-
5263 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5264 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5269 gradcorr(ll,m)=gradcorr(ll,m)+
5270 & ees*eij*gacont_hbr(ll,kk,k)-
5271 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5272 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5279 C---------------------------------------------------------------------------
5280 subroutine dipole(i,j,jj)
5281 implicit real*8 (a-h,o-z)
5282 include 'DIMENSIONS'
5283 include 'DIMENSIONS.ZSCOPT'
5284 include 'COMMON.IOUNITS'
5285 include 'COMMON.CHAIN'
5286 include 'COMMON.FFIELD'
5287 include 'COMMON.DERIV'
5288 include 'COMMON.INTERACT'
5289 include 'COMMON.CONTACTS'
5290 include 'COMMON.TORSION'
5291 include 'COMMON.VAR'
5292 include 'COMMON.GEO'
5293 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5295 iti1 = itortyp(itype(i+1))
5296 if (j.lt.nres-1) then
5297 itj1 = itortyp(itype(j+1))
5302 dipi(iii,1)=Ub2(iii,i)
5303 dipderi(iii)=Ub2der(iii,i)
5304 dipi(iii,2)=b1(iii,iti1)
5305 dipj(iii,1)=Ub2(iii,j)
5306 dipderj(iii)=Ub2der(iii,j)
5307 dipj(iii,2)=b1(iii,itj1)
5311 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5314 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5317 if (.not.calc_grad) return
5322 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5326 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5331 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5332 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5334 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5336 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5338 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5342 C---------------------------------------------------------------------------
5343 subroutine calc_eello(i,j,k,l,jj,kk)
5345 C This subroutine computes matrices and vectors needed to calculate
5346 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5348 implicit real*8 (a-h,o-z)
5349 include 'DIMENSIONS'
5350 include 'DIMENSIONS.ZSCOPT'
5351 include 'COMMON.IOUNITS'
5352 include 'COMMON.CHAIN'
5353 include 'COMMON.DERIV'
5354 include 'COMMON.INTERACT'
5355 include 'COMMON.CONTACTS'
5356 include 'COMMON.TORSION'
5357 include 'COMMON.VAR'
5358 include 'COMMON.GEO'
5359 include 'COMMON.FFIELD'
5360 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5361 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5364 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5365 cd & ' jj=',jj,' kk=',kk
5366 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5369 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5370 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5373 call transpose2(aa1(1,1),aa1t(1,1))
5374 call transpose2(aa2(1,1),aa2t(1,1))
5377 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5378 & aa1tder(1,1,lll,kkk))
5379 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5380 & aa2tder(1,1,lll,kkk))
5384 C parallel orientation of the two CA-CA-CA frames.
5386 iti=itortyp(itype(i))
5390 itk1=itortyp(itype(k+1))
5391 itj=itortyp(itype(j))
5392 if (l.lt.nres-1) then
5393 itl1=itortyp(itype(l+1))
5397 C A1 kernel(j+1) A2T
5399 cd write (iout,'(3f10.5,5x,3f10.5)')
5400 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5402 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5403 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5404 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5405 C Following matrices are needed only for 6-th order cumulants
5406 IF (wcorr6.gt.0.0d0) THEN
5407 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5408 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5409 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5410 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5411 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5412 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5413 & ADtEAderx(1,1,1,1,1,1))
5415 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5416 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5417 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5418 & ADtEA1derx(1,1,1,1,1,1))
5420 C End 6-th order cumulants
5423 cd write (2,*) 'In calc_eello6'
5425 cd write (2,*) 'iii=',iii
5427 cd write (2,*) 'kkk=',kkk
5429 cd write (2,'(3(2f10.5),5x)')
5430 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5435 call transpose2(EUgder(1,1,k),auxmat(1,1))
5436 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5437 call transpose2(EUg(1,1,k),auxmat(1,1))
5438 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5439 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5443 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5444 & EAEAderx(1,1,lll,kkk,iii,1))
5448 C A1T kernel(i+1) A2
5449 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5450 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5451 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5452 C Following matrices are needed only for 6-th order cumulants
5453 IF (wcorr6.gt.0.0d0) THEN
5454 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5455 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5456 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5457 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5458 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5459 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5460 & ADtEAderx(1,1,1,1,1,2))
5461 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5462 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5463 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5464 & ADtEA1derx(1,1,1,1,1,2))
5466 C End 6-th order cumulants
5467 call transpose2(EUgder(1,1,l),auxmat(1,1))
5468 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5469 call transpose2(EUg(1,1,l),auxmat(1,1))
5470 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5471 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5475 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5476 & EAEAderx(1,1,lll,kkk,iii,2))
5481 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5482 C They are needed only when the fifth- or the sixth-order cumulants are
5484 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5485 call transpose2(AEA(1,1,1),auxmat(1,1))
5486 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5487 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5488 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5489 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5490 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5491 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5492 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5493 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5494 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5495 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5496 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5497 call transpose2(AEA(1,1,2),auxmat(1,1))
5498 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5499 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5500 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5501 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5502 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5503 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5504 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5505 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5506 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5507 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5508 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5509 C Calculate the Cartesian derivatives of the vectors.
5513 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5514 call matvec2(auxmat(1,1),b1(1,iti),
5515 & AEAb1derx(1,lll,kkk,iii,1,1))
5516 call matvec2(auxmat(1,1),Ub2(1,i),
5517 & AEAb2derx(1,lll,kkk,iii,1,1))
5518 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5519 & AEAb1derx(1,lll,kkk,iii,2,1))
5520 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5521 & AEAb2derx(1,lll,kkk,iii,2,1))
5522 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5523 call matvec2(auxmat(1,1),b1(1,itj),
5524 & AEAb1derx(1,lll,kkk,iii,1,2))
5525 call matvec2(auxmat(1,1),Ub2(1,j),
5526 & AEAb2derx(1,lll,kkk,iii,1,2))
5527 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5528 & AEAb1derx(1,lll,kkk,iii,2,2))
5529 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5530 & AEAb2derx(1,lll,kkk,iii,2,2))
5537 C Antiparallel orientation of the two CA-CA-CA frames.
5539 iti=itortyp(itype(i))
5543 itk1=itortyp(itype(k+1))
5544 itl=itortyp(itype(l))
5545 itj=itortyp(itype(j))
5546 if (j.lt.nres-1) then
5547 itj1=itortyp(itype(j+1))
5551 C A2 kernel(j-1)T A1T
5552 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5553 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5554 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5555 C Following matrices are needed only for 6-th order cumulants
5556 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5557 & j.eq.i+4 .and. l.eq.i+3)) THEN
5558 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5559 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5560 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5561 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5562 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5563 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5564 & ADtEAderx(1,1,1,1,1,1))
5565 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5566 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5567 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5568 & ADtEA1derx(1,1,1,1,1,1))
5570 C End 6-th order cumulants
5571 call transpose2(EUgder(1,1,k),auxmat(1,1))
5572 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5573 call transpose2(EUg(1,1,k),auxmat(1,1))
5574 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5575 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5579 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5580 & EAEAderx(1,1,lll,kkk,iii,1))
5584 C A2T kernel(i+1)T A1
5585 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5586 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5587 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5588 C Following matrices are needed only for 6-th order cumulants
5589 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5590 & j.eq.i+4 .and. l.eq.i+3)) THEN
5591 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5592 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5593 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5594 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5595 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5596 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5597 & ADtEAderx(1,1,1,1,1,2))
5598 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5599 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5600 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5601 & ADtEA1derx(1,1,1,1,1,2))
5603 C End 6-th order cumulants
5604 call transpose2(EUgder(1,1,j),auxmat(1,1))
5605 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5606 call transpose2(EUg(1,1,j),auxmat(1,1))
5607 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5608 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5612 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5613 & EAEAderx(1,1,lll,kkk,iii,2))
5618 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5619 C They are needed only when the fifth- or the sixth-order cumulants are
5621 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5622 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5623 call transpose2(AEA(1,1,1),auxmat(1,1))
5624 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5625 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5627 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5628 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5629 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5630 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5631 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5632 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5633 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5634 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5635 call transpose2(AEA(1,1,2),auxmat(1,1))
5636 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5637 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5639 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5640 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5641 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5642 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5643 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5644 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5645 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5646 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5647 C Calculate the Cartesian derivatives of the vectors.
5651 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5652 call matvec2(auxmat(1,1),b1(1,iti),
5653 & AEAb1derx(1,lll,kkk,iii,1,1))
5654 call matvec2(auxmat(1,1),Ub2(1,i),
5655 & AEAb2derx(1,lll,kkk,iii,1,1))
5656 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5657 & AEAb1derx(1,lll,kkk,iii,2,1))
5658 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5659 & AEAb2derx(1,lll,kkk,iii,2,1))
5660 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5661 call matvec2(auxmat(1,1),b1(1,itl),
5662 & AEAb1derx(1,lll,kkk,iii,1,2))
5663 call matvec2(auxmat(1,1),Ub2(1,l),
5664 & AEAb2derx(1,lll,kkk,iii,1,2))
5665 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5666 & AEAb1derx(1,lll,kkk,iii,2,2))
5667 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5668 & AEAb2derx(1,lll,kkk,iii,2,2))
5677 C---------------------------------------------------------------------------
5678 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5679 & KK,KKderg,AKA,AKAderg,AKAderx)
5683 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5684 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5685 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5690 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5692 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5695 cd if (lprn) write (2,*) 'In kernel'
5697 cd if (lprn) write (2,*) 'kkk=',kkk
5699 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5700 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5702 cd write (2,*) 'lll=',lll
5703 cd write (2,*) 'iii=1'
5705 cd write (2,'(3(2f10.5),5x)')
5706 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5709 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5710 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5712 cd write (2,*) 'lll=',lll
5713 cd write (2,*) 'iii=2'
5715 cd write (2,'(3(2f10.5),5x)')
5716 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5723 C---------------------------------------------------------------------------
5724 double precision function eello4(i,j,k,l,jj,kk)
5725 implicit real*8 (a-h,o-z)
5726 include 'DIMENSIONS'
5727 include 'DIMENSIONS.ZSCOPT'
5728 include 'COMMON.IOUNITS'
5729 include 'COMMON.CHAIN'
5730 include 'COMMON.DERIV'
5731 include 'COMMON.INTERACT'
5732 include 'COMMON.CONTACTS'
5733 include 'COMMON.TORSION'
5734 include 'COMMON.VAR'
5735 include 'COMMON.GEO'
5736 double precision pizda(2,2),ggg1(3),ggg2(3)
5737 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5741 cd print *,'eello4:',i,j,k,l,jj,kk
5742 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5743 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5744 cold eij=facont_hb(jj,i)
5745 cold ekl=facont_hb(kk,k)
5747 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5749 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5750 gcorr_loc(k-1)=gcorr_loc(k-1)
5751 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5753 gcorr_loc(l-1)=gcorr_loc(l-1)
5754 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5756 gcorr_loc(j-1)=gcorr_loc(j-1)
5757 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5762 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5763 & -EAEAderx(2,2,lll,kkk,iii,1)
5764 cd derx(lll,kkk,iii)=0.0d0
5768 cd gcorr_loc(l-1)=0.0d0
5769 cd gcorr_loc(j-1)=0.0d0
5770 cd gcorr_loc(k-1)=0.0d0
5772 cd write (iout,*)'Contacts have occurred for peptide groups',
5773 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5774 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5775 if (j.lt.nres-1) then
5782 if (l.lt.nres-1) then
5790 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5791 ggg1(ll)=eel4*g_contij(ll,1)
5792 ggg2(ll)=eel4*g_contij(ll,2)
5793 ghalf=0.5d0*ggg1(ll)
5795 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5796 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5797 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5798 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5799 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5800 ghalf=0.5d0*ggg2(ll)
5802 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5803 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5804 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5805 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5810 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5811 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5816 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5817 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5823 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5828 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5832 cd write (2,*) iii,gcorr_loc(iii)
5836 cd write (2,*) 'ekont',ekont
5837 cd write (iout,*) 'eello4',ekont*eel4
5840 C---------------------------------------------------------------------------
5841 double precision function eello5(i,j,k,l,jj,kk)
5842 implicit real*8 (a-h,o-z)
5843 include 'DIMENSIONS'
5844 include 'DIMENSIONS.ZSCOPT'
5845 include 'COMMON.IOUNITS'
5846 include 'COMMON.CHAIN'
5847 include 'COMMON.DERIV'
5848 include 'COMMON.INTERACT'
5849 include 'COMMON.CONTACTS'
5850 include 'COMMON.TORSION'
5851 include 'COMMON.VAR'
5852 include 'COMMON.GEO'
5853 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5854 double precision ggg1(3),ggg2(3)
5855 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5860 C /l\ / \ \ / \ / \ / C
5861 C / \ / \ \ / \ / \ / C
5862 C j| o |l1 | o | o| o | | o |o C
5863 C \ |/k\| |/ \| / |/ \| |/ \| C
5864 C \i/ \ / \ / / \ / \ C
5866 C (I) (II) (III) (IV) C
5868 C eello5_1 eello5_2 eello5_3 eello5_4 C
5870 C Antiparallel chains C
5873 C /j\ / \ \ / \ / \ / C
5874 C / \ / \ \ / \ / \ / C
5875 C j1| o |l | o | o| o | | o |o C
5876 C \ |/k\| |/ \| / |/ \| |/ \| C
5877 C \i/ \ / \ / / \ / \ C
5879 C (I) (II) (III) (IV) C
5881 C eello5_1 eello5_2 eello5_3 eello5_4 C
5883 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5885 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5886 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5891 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5893 itk=itortyp(itype(k))
5894 itl=itortyp(itype(l))
5895 itj=itortyp(itype(j))
5900 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5901 cd & eel5_3_num,eel5_4_num)
5905 derx(lll,kkk,iii)=0.0d0
5909 cd eij=facont_hb(jj,i)
5910 cd ekl=facont_hb(kk,k)
5912 cd write (iout,*)'Contacts have occurred for peptide groups',
5913 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5915 C Contribution from the graph I.
5916 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5917 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5918 call transpose2(EUg(1,1,k),auxmat(1,1))
5919 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5920 vv(1)=pizda(1,1)-pizda(2,2)
5921 vv(2)=pizda(1,2)+pizda(2,1)
5922 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5923 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5925 C Explicit gradient in virtual-dihedral angles.
5926 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5927 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5928 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5929 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5930 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5931 vv(1)=pizda(1,1)-pizda(2,2)
5932 vv(2)=pizda(1,2)+pizda(2,1)
5933 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5934 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5935 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5936 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5937 vv(1)=pizda(1,1)-pizda(2,2)
5938 vv(2)=pizda(1,2)+pizda(2,1)
5940 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5941 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5942 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5944 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5945 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5946 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5948 C Cartesian gradient
5952 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5954 vv(1)=pizda(1,1)-pizda(2,2)
5955 vv(2)=pizda(1,2)+pizda(2,1)
5956 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5957 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5958 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5965 C Contribution from graph II
5966 call transpose2(EE(1,1,itk),auxmat(1,1))
5967 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5968 vv(1)=pizda(1,1)+pizda(2,2)
5969 vv(2)=pizda(2,1)-pizda(1,2)
5970 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5971 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5973 C Explicit gradient in virtual-dihedral angles.
5974 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5975 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5976 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5977 vv(1)=pizda(1,1)+pizda(2,2)
5978 vv(2)=pizda(2,1)-pizda(1,2)
5980 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5981 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5982 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5984 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5985 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5986 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5988 C Cartesian gradient
5992 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5994 vv(1)=pizda(1,1)+pizda(2,2)
5995 vv(2)=pizda(2,1)-pizda(1,2)
5996 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5997 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5998 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6007 C Parallel orientation
6008 C Contribution from graph III
6009 call transpose2(EUg(1,1,l),auxmat(1,1))
6010 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6011 vv(1)=pizda(1,1)-pizda(2,2)
6012 vv(2)=pizda(1,2)+pizda(2,1)
6013 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6014 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6016 C Explicit gradient in virtual-dihedral angles.
6017 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6018 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6019 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6020 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6021 vv(1)=pizda(1,1)-pizda(2,2)
6022 vv(2)=pizda(1,2)+pizda(2,1)
6023 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6024 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6025 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6026 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6027 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6028 vv(1)=pizda(1,1)-pizda(2,2)
6029 vv(2)=pizda(1,2)+pizda(2,1)
6030 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6031 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6032 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6033 C Cartesian gradient
6037 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6039 vv(1)=pizda(1,1)-pizda(2,2)
6040 vv(2)=pizda(1,2)+pizda(2,1)
6041 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6042 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6043 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6049 C Contribution from graph IV
6051 call transpose2(EE(1,1,itl),auxmat(1,1))
6052 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6053 vv(1)=pizda(1,1)+pizda(2,2)
6054 vv(2)=pizda(2,1)-pizda(1,2)
6055 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6056 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6058 C Explicit gradient in virtual-dihedral angles.
6059 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6060 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6061 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6062 vv(1)=pizda(1,1)+pizda(2,2)
6063 vv(2)=pizda(2,1)-pizda(1,2)
6064 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6065 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6066 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6067 C Cartesian gradient
6071 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6073 vv(1)=pizda(1,1)+pizda(2,2)
6074 vv(2)=pizda(2,1)-pizda(1,2)
6075 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6076 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6077 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6083 C Antiparallel orientation
6084 C Contribution from graph III
6086 call transpose2(EUg(1,1,j),auxmat(1,1))
6087 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6088 vv(1)=pizda(1,1)-pizda(2,2)
6089 vv(2)=pizda(1,2)+pizda(2,1)
6090 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6091 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6093 C Explicit gradient in virtual-dihedral angles.
6094 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6095 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6096 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6097 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6098 vv(1)=pizda(1,1)-pizda(2,2)
6099 vv(2)=pizda(1,2)+pizda(2,1)
6100 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6101 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6102 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6103 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6104 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6105 vv(1)=pizda(1,1)-pizda(2,2)
6106 vv(2)=pizda(1,2)+pizda(2,1)
6107 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6108 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6109 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6110 C Cartesian gradient
6114 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6116 vv(1)=pizda(1,1)-pizda(2,2)
6117 vv(2)=pizda(1,2)+pizda(2,1)
6118 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6119 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6120 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6126 C Contribution from graph IV
6128 call transpose2(EE(1,1,itj),auxmat(1,1))
6129 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6130 vv(1)=pizda(1,1)+pizda(2,2)
6131 vv(2)=pizda(2,1)-pizda(1,2)
6132 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6133 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6135 C Explicit gradient in virtual-dihedral angles.
6136 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6137 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6138 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6139 vv(1)=pizda(1,1)+pizda(2,2)
6140 vv(2)=pizda(2,1)-pizda(1,2)
6141 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6142 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6143 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6144 C Cartesian gradient
6148 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6150 vv(1)=pizda(1,1)+pizda(2,2)
6151 vv(2)=pizda(2,1)-pizda(1,2)
6152 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6153 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6154 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6161 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6162 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6163 cd write (2,*) 'ijkl',i,j,k,l
6164 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6165 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6167 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6168 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6169 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6170 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6172 if (j.lt.nres-1) then
6179 if (l.lt.nres-1) then
6189 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6191 ggg1(ll)=eel5*g_contij(ll,1)
6192 ggg2(ll)=eel5*g_contij(ll,2)
6193 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6194 ghalf=0.5d0*ggg1(ll)
6196 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6197 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6198 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6199 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6200 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6201 ghalf=0.5d0*ggg2(ll)
6203 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6204 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6205 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6206 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6211 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6212 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6217 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6218 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6224 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6229 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6233 cd write (2,*) iii,g_corr5_loc(iii)
6237 cd write (2,*) 'ekont',ekont
6238 cd write (iout,*) 'eello5',ekont*eel5
6241 c--------------------------------------------------------------------------
6242 double precision function eello6(i,j,k,l,jj,kk)
6243 implicit real*8 (a-h,o-z)
6244 include 'DIMENSIONS'
6245 include 'DIMENSIONS.ZSCOPT'
6246 include 'COMMON.IOUNITS'
6247 include 'COMMON.CHAIN'
6248 include 'COMMON.DERIV'
6249 include 'COMMON.INTERACT'
6250 include 'COMMON.CONTACTS'
6251 include 'COMMON.TORSION'
6252 include 'COMMON.VAR'
6253 include 'COMMON.GEO'
6254 include 'COMMON.FFIELD'
6255 double precision ggg1(3),ggg2(3)
6256 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6261 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6269 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6270 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6274 derx(lll,kkk,iii)=0.0d0
6278 cd eij=facont_hb(jj,i)
6279 cd ekl=facont_hb(kk,k)
6285 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6286 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6287 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6288 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6289 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6290 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6292 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6293 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6294 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6295 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6296 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6297 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6301 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6303 C If turn contributions are considered, they will be handled separately.
6304 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6305 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6306 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6307 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6308 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6309 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6310 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6313 if (j.lt.nres-1) then
6320 if (l.lt.nres-1) then
6328 ggg1(ll)=eel6*g_contij(ll,1)
6329 ggg2(ll)=eel6*g_contij(ll,2)
6330 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6331 ghalf=0.5d0*ggg1(ll)
6333 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6334 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6335 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6336 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6337 ghalf=0.5d0*ggg2(ll)
6338 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6340 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6341 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6342 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6343 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6348 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6349 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6354 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6355 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6361 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6366 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6370 cd write (2,*) iii,g_corr6_loc(iii)
6374 cd write (2,*) 'ekont',ekont
6375 cd write (iout,*) 'eello6',ekont*eel6
6378 c--------------------------------------------------------------------------
6379 double precision function eello6_graph1(i,j,k,l,imat,swap)
6380 implicit real*8 (a-h,o-z)
6381 include 'DIMENSIONS'
6382 include 'DIMENSIONS.ZSCOPT'
6383 include 'COMMON.IOUNITS'
6384 include 'COMMON.CHAIN'
6385 include 'COMMON.DERIV'
6386 include 'COMMON.INTERACT'
6387 include 'COMMON.CONTACTS'
6388 include 'COMMON.TORSION'
6389 include 'COMMON.VAR'
6390 include 'COMMON.GEO'
6391 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6397 C Parallel Antiparallel C
6403 C \ j|/k\| / \ |/k\|l / C
6408 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6409 itk=itortyp(itype(k))
6410 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6411 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6412 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6413 call transpose2(EUgC(1,1,k),auxmat(1,1))
6414 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6415 vv1(1)=pizda1(1,1)-pizda1(2,2)
6416 vv1(2)=pizda1(1,2)+pizda1(2,1)
6417 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6418 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6419 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6420 s5=scalar2(vv(1),Dtobr2(1,i))
6421 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6422 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6423 if (.not. calc_grad) return
6424 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6425 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6426 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6427 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6428 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6429 & +scalar2(vv(1),Dtobr2der(1,i)))
6430 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6431 vv1(1)=pizda1(1,1)-pizda1(2,2)
6432 vv1(2)=pizda1(1,2)+pizda1(2,1)
6433 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6434 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6436 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6437 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6438 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6439 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6440 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6442 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6443 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6444 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6445 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6446 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6448 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6449 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6450 vv1(1)=pizda1(1,1)-pizda1(2,2)
6451 vv1(2)=pizda1(1,2)+pizda1(2,1)
6452 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6453 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6454 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6455 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6464 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6465 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6466 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6467 call transpose2(EUgC(1,1,k),auxmat(1,1))
6468 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6470 vv1(1)=pizda1(1,1)-pizda1(2,2)
6471 vv1(2)=pizda1(1,2)+pizda1(2,1)
6472 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6473 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6474 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6475 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6476 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6477 s5=scalar2(vv(1),Dtobr2(1,i))
6478 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6484 c----------------------------------------------------------------------------
6485 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6486 implicit real*8 (a-h,o-z)
6487 include 'DIMENSIONS'
6488 include 'DIMENSIONS.ZSCOPT'
6489 include 'COMMON.IOUNITS'
6490 include 'COMMON.CHAIN'
6491 include 'COMMON.DERIV'
6492 include 'COMMON.INTERACT'
6493 include 'COMMON.CONTACTS'
6494 include 'COMMON.TORSION'
6495 include 'COMMON.VAR'
6496 include 'COMMON.GEO'
6498 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6499 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6504 C Parallel Antiparallel C
6510 C \ j|/k\| \ |/k\|l C
6515 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6516 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6517 C AL 7/4/01 s1 would occur in the sixth-order moment,
6518 C but not in a cluster cumulant
6520 s1=dip(1,jj,i)*dip(1,kk,k)
6522 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6523 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6524 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6525 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6526 call transpose2(EUg(1,1,k),auxmat(1,1))
6527 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6528 vv(1)=pizda(1,1)-pizda(2,2)
6529 vv(2)=pizda(1,2)+pizda(2,1)
6530 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6531 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6533 eello6_graph2=-(s1+s2+s3+s4)
6535 eello6_graph2=-(s2+s3+s4)
6538 if (.not. calc_grad) return
6539 C Derivatives in gamma(i-1)
6542 s1=dipderg(1,jj,i)*dip(1,kk,k)
6544 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6545 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6546 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6547 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6549 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6551 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6553 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6555 C Derivatives in gamma(k-1)
6557 s1=dip(1,jj,i)*dipderg(1,kk,k)
6559 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6560 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6561 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6562 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6563 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6564 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6565 vv(1)=pizda(1,1)-pizda(2,2)
6566 vv(2)=pizda(1,2)+pizda(2,1)
6567 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6569 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6571 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6573 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6574 C Derivatives in gamma(j-1) or gamma(l-1)
6577 s1=dipderg(3,jj,i)*dip(1,kk,k)
6579 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6580 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6581 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6582 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6583 vv(1)=pizda(1,1)-pizda(2,2)
6584 vv(2)=pizda(1,2)+pizda(2,1)
6585 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6588 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6590 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6593 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6594 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6596 C Derivatives in gamma(l-1) or gamma(j-1)
6599 s1=dip(1,jj,i)*dipderg(3,kk,k)
6601 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6602 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6603 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6604 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6605 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6606 vv(1)=pizda(1,1)-pizda(2,2)
6607 vv(2)=pizda(1,2)+pizda(2,1)
6608 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6611 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6613 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6616 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6617 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6619 C Cartesian derivatives.
6621 write (2,*) 'In eello6_graph2'
6623 write (2,*) 'iii=',iii
6625 write (2,*) 'kkk=',kkk
6627 write (2,'(3(2f10.5),5x)')
6628 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6638 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6640 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6643 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6645 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6646 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6648 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6649 call transpose2(EUg(1,1,k),auxmat(1,1))
6650 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6652 vv(1)=pizda(1,1)-pizda(2,2)
6653 vv(2)=pizda(1,2)+pizda(2,1)
6654 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6655 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6657 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6659 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6662 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6664 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6671 c----------------------------------------------------------------------------
6672 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6673 implicit real*8 (a-h,o-z)
6674 include 'DIMENSIONS'
6675 include 'DIMENSIONS.ZSCOPT'
6676 include 'COMMON.IOUNITS'
6677 include 'COMMON.CHAIN'
6678 include 'COMMON.DERIV'
6679 include 'COMMON.INTERACT'
6680 include 'COMMON.CONTACTS'
6681 include 'COMMON.TORSION'
6682 include 'COMMON.VAR'
6683 include 'COMMON.GEO'
6684 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6686 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6688 C Parallel Antiparallel C
6694 C j|/k\| / |/k\|l / C
6699 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6701 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6702 C energy moment and not to the cluster cumulant.
6703 iti=itortyp(itype(i))
6704 if (j.lt.nres-1) then
6705 itj1=itortyp(itype(j+1))
6709 itk=itortyp(itype(k))
6710 itk1=itortyp(itype(k+1))
6711 if (l.lt.nres-1) then
6712 itl1=itortyp(itype(l+1))
6717 s1=dip(4,jj,i)*dip(4,kk,k)
6719 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6720 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6721 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6722 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6723 call transpose2(EE(1,1,itk),auxmat(1,1))
6724 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6725 vv(1)=pizda(1,1)+pizda(2,2)
6726 vv(2)=pizda(2,1)-pizda(1,2)
6727 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6728 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6730 eello6_graph3=-(s1+s2+s3+s4)
6732 eello6_graph3=-(s2+s3+s4)
6735 if (.not. calc_grad) return
6736 C Derivatives in gamma(k-1)
6737 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6738 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6739 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6740 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6741 C Derivatives in gamma(l-1)
6742 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6743 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6744 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6745 vv(1)=pizda(1,1)+pizda(2,2)
6746 vv(2)=pizda(2,1)-pizda(1,2)
6747 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6748 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6749 C Cartesian derivatives.
6755 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6757 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6760 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6762 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6763 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6765 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6766 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6768 vv(1)=pizda(1,1)+pizda(2,2)
6769 vv(2)=pizda(2,1)-pizda(1,2)
6770 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6772 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6774 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6777 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6779 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6781 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6787 c----------------------------------------------------------------------------
6788 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6789 implicit real*8 (a-h,o-z)
6790 include 'DIMENSIONS'
6791 include 'DIMENSIONS.ZSCOPT'
6792 include 'COMMON.IOUNITS'
6793 include 'COMMON.CHAIN'
6794 include 'COMMON.DERIV'
6795 include 'COMMON.INTERACT'
6796 include 'COMMON.CONTACTS'
6797 include 'COMMON.TORSION'
6798 include 'COMMON.VAR'
6799 include 'COMMON.GEO'
6800 include 'COMMON.FFIELD'
6801 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6802 & auxvec1(2),auxmat1(2,2)
6804 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6806 C Parallel Antiparallel C
6812 C \ j|/k\| \ |/k\|l C
6817 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6819 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6820 C energy moment and not to the cluster cumulant.
6821 cd write (2,*) 'eello_graph4: wturn6',wturn6
6822 iti=itortyp(itype(i))
6823 itj=itortyp(itype(j))
6824 if (j.lt.nres-1) then
6825 itj1=itortyp(itype(j+1))
6829 itk=itortyp(itype(k))
6830 if (k.lt.nres-1) then
6831 itk1=itortyp(itype(k+1))
6835 itl=itortyp(itype(l))
6836 if (l.lt.nres-1) then
6837 itl1=itortyp(itype(l+1))
6841 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6842 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6843 cd & ' itl',itl,' itl1',itl1
6846 s1=dip(3,jj,i)*dip(3,kk,k)
6848 s1=dip(2,jj,j)*dip(2,kk,l)
6851 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6852 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6854 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6855 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6857 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6858 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6860 call transpose2(EUg(1,1,k),auxmat(1,1))
6861 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6862 vv(1)=pizda(1,1)-pizda(2,2)
6863 vv(2)=pizda(2,1)+pizda(1,2)
6864 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6865 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6867 eello6_graph4=-(s1+s2+s3+s4)
6869 eello6_graph4=-(s2+s3+s4)
6871 if (.not. calc_grad) return
6872 C Derivatives in gamma(i-1)
6876 s1=dipderg(2,jj,i)*dip(3,kk,k)
6878 s1=dipderg(4,jj,j)*dip(2,kk,l)
6881 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6883 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6884 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6886 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6887 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6889 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6890 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6891 cd write (2,*) 'turn6 derivatives'
6893 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6895 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6899 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6901 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6905 C Derivatives in gamma(k-1)
6908 s1=dip(3,jj,i)*dipderg(2,kk,k)
6910 s1=dip(2,jj,j)*dipderg(4,kk,l)
6913 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6914 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6916 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6917 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6919 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6920 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6922 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6923 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(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))
6927 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6929 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6931 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6935 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6937 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6940 C Derivatives in gamma(j-1) or gamma(l-1)
6941 if (l.eq.j+1 .and. l.gt.1) then
6942 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6943 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6944 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6945 vv(1)=pizda(1,1)-pizda(2,2)
6946 vv(2)=pizda(2,1)+pizda(1,2)
6947 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6948 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6949 else if (j.gt.1) then
6950 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6951 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6952 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6953 vv(1)=pizda(1,1)-pizda(2,2)
6954 vv(2)=pizda(2,1)+pizda(1,2)
6955 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6956 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6957 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6959 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6962 C Cartesian derivatives.
6969 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6971 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6975 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6977 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6981 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6983 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6985 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6986 & b1(1,itj1),auxvec(1))
6987 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6989 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6990 & b1(1,itl1),auxvec(1))
6991 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6993 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6995 vv(1)=pizda(1,1)-pizda(2,2)
6996 vv(2)=pizda(2,1)+pizda(1,2)
6997 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6999 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7001 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7004 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7007 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7010 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7012 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7014 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7018 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7020 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7023 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7025 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7033 c----------------------------------------------------------------------------
7034 double precision function eello_turn6(i,jj,kk)
7035 implicit real*8 (a-h,o-z)
7036 include 'DIMENSIONS'
7037 include 'DIMENSIONS.ZSCOPT'
7038 include 'COMMON.IOUNITS'
7039 include 'COMMON.CHAIN'
7040 include 'COMMON.DERIV'
7041 include 'COMMON.INTERACT'
7042 include 'COMMON.CONTACTS'
7043 include 'COMMON.TORSION'
7044 include 'COMMON.VAR'
7045 include 'COMMON.GEO'
7046 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7047 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7049 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7050 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7051 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7052 C the respective energy moment and not to the cluster cumulant.
7057 iti=itortyp(itype(i))
7058 itk=itortyp(itype(k))
7059 itk1=itortyp(itype(k+1))
7060 itl=itortyp(itype(l))
7061 itj=itortyp(itype(j))
7062 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7063 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7064 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7069 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7071 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7075 derx_turn(lll,kkk,iii)=0.0d0
7082 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7084 cd write (2,*) 'eello6_5',eello6_5
7086 call transpose2(AEA(1,1,1),auxmat(1,1))
7087 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7088 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7089 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7093 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7094 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7095 s2 = scalar2(b1(1,itk),vtemp1(1))
7097 call transpose2(AEA(1,1,2),atemp(1,1))
7098 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7099 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7100 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7104 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7105 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7106 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7108 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7109 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7110 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7111 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7112 ss13 = scalar2(b1(1,itk),vtemp4(1))
7113 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7117 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7123 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7125 C Derivatives in gamma(i+2)
7127 call transpose2(AEA(1,1,1),auxmatd(1,1))
7128 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7129 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7130 call transpose2(AEAderg(1,1,2),atempd(1,1))
7131 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7132 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7136 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7137 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7138 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7144 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7145 C Derivatives in gamma(i+3)
7147 call transpose2(AEA(1,1,1),auxmatd(1,1))
7148 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7149 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7150 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7154 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7155 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7156 s2d = scalar2(b1(1,itk),vtemp1d(1))
7158 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7159 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7161 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7163 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7164 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7165 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7175 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7176 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7178 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7179 & -0.5d0*ekont*(s2d+s12d)
7181 C Derivatives in gamma(i+4)
7182 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7183 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7184 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7186 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7187 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7188 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7198 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7200 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7202 C Derivatives in gamma(i+5)
7204 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7205 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7206 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7210 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7211 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7212 s2d = scalar2(b1(1,itk),vtemp1d(1))
7214 call transpose2(AEA(1,1,2),atempd(1,1))
7215 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7216 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7220 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7221 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7223 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7224 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7225 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7235 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7236 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7238 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7239 & -0.5d0*ekont*(s2d+s12d)
7241 C Cartesian derivatives
7246 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7247 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7248 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7252 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7253 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7255 s2d = scalar2(b1(1,itk),vtemp1d(1))
7257 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7258 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7259 s8d = -(atempd(1,1)+atempd(2,2))*
7260 & scalar2(cc(1,1,itl),vtemp2(1))
7264 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7266 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7267 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7274 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7277 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7281 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7282 & - 0.5d0*(s8d+s12d)
7284 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7293 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7295 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7296 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7297 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7298 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7299 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7301 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7302 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7303 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7307 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7308 cd & 16*eel_turn6_num
7310 if (j.lt.nres-1) then
7317 if (l.lt.nres-1) then
7325 ggg1(ll)=eel_turn6*g_contij(ll,1)
7326 ggg2(ll)=eel_turn6*g_contij(ll,2)
7327 ghalf=0.5d0*ggg1(ll)
7329 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7330 & +ekont*derx_turn(ll,2,1)
7331 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7332 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7333 & +ekont*derx_turn(ll,4,1)
7334 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7335 ghalf=0.5d0*ggg2(ll)
7337 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7338 & +ekont*derx_turn(ll,2,2)
7339 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7340 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7341 & +ekont*derx_turn(ll,4,2)
7342 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7347 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7352 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7358 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7363 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7367 cd write (2,*) iii,g_corr6_loc(iii)
7370 eello_turn6=ekont*eel_turn6
7371 cd write (2,*) 'ekont',ekont
7372 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7375 crc-------------------------------------------------
7376 SUBROUTINE MATVEC2(A1,V1,V2)
7377 implicit real*8 (a-h,o-z)
7378 include 'DIMENSIONS'
7379 DIMENSION A1(2,2),V1(2),V2(2)
7383 c 3 VI=VI+A1(I,K)*V1(K)
7387 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7388 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7393 C---------------------------------------
7394 SUBROUTINE MATMAT2(A1,A2,A3)
7395 implicit real*8 (a-h,o-z)
7396 include 'DIMENSIONS'
7397 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7398 c DIMENSION AI3(2,2)
7402 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7408 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7409 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7410 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7411 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7419 c-------------------------------------------------------------------------
7420 double precision function scalar2(u,v)
7422 double precision u(2),v(2)
7425 scalar2=u(1)*v(1)+u(2)*v(2)
7429 C-----------------------------------------------------------------------------
7431 subroutine transpose2(a,at)
7433 double precision a(2,2),at(2,2)
7440 c--------------------------------------------------------------------------
7441 subroutine transpose(n,a,at)
7444 double precision a(n,n),at(n,n)
7452 C---------------------------------------------------------------------------
7453 subroutine prodmat3(a1,a2,kk,transp,prod)
7456 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7458 crc double precision auxmat(2,2),prod_(2,2)
7461 crc call transpose2(kk(1,1),auxmat(1,1))
7462 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7463 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7465 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7466 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7467 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7468 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7469 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7470 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7471 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7472 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7475 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7476 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7478 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7479 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7480 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7481 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7482 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7483 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7484 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7485 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7488 c call transpose2(a2(1,1),a2t(1,1))
7491 crc print *,((prod_(i,j),i=1,2),j=1,2)
7492 crc print *,((prod(i,j),i=1,2),j=1,2)
7496 C-----------------------------------------------------------------------------
7497 double precision function scalar(u,v)
7499 double precision u(3),v(3)