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))
4501 if (iabs(itype(i+1)).eq.20) iblock=2
4502 C Regular cosine and sine terms
4503 c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
4504 c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4505 c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4506 c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4507 c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4508 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4509 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4510 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4511 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4512 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4513 cosphi1=dcos(j*phii)
4514 sinphi1=dsin(j*phii)
4515 cosphi2=dcos(j*phii1)
4516 sinphi2=dsin(j*phii1)
4517 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4518 & v2cij*cosphi2+v2sij*sinphi2
4519 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4520 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4522 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4524 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4525 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4526 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4527 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4528 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4529 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4530 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4531 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4532 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4533 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4534 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4535 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4536 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4537 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4540 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4541 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4547 c------------------------------------------------------------------------------
4548 subroutine eback_sc_corr(esccor)
4549 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4550 c conformational states; temporarily implemented as differences
4551 c between UNRES torsional potentials (dependent on three types of
4552 c residues) and the torsional potentials dependent on all 20 types
4553 c of residues computed from AM1 energy surfaces of terminally-blocked
4554 c amino-acid residues.
4555 implicit real*8 (a-h,o-z)
4556 include 'DIMENSIONS'
4557 include 'DIMENSIONS.ZSCOPT'
4558 include 'COMMON.VAR'
4559 include 'COMMON.GEO'
4560 include 'COMMON.LOCAL'
4561 include 'COMMON.TORSION'
4562 include 'COMMON.SCCOR'
4563 include 'COMMON.INTERACT'
4564 include 'COMMON.DERIV'
4565 include 'COMMON.CHAIN'
4566 include 'COMMON.NAMES'
4567 include 'COMMON.IOUNITS'
4568 include 'COMMON.FFIELD'
4569 include 'COMMON.CONTROL'
4571 C Set lprn=.true. for debugging
4574 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4576 do i=itau_start,itau_end
4578 isccori=isccortyp((itype(i-2)))
4579 isccori1=isccortyp((itype(i-1)))
4581 cccc Added 9 May 2012
4582 cc Tauangle is torsional engle depending on the value of first digit
4583 c(see comment below)
4584 cc Omicron is flat angle depending on the value of first digit
4585 c(see comment below)
4588 do intertyp=1,3 !intertyp
4589 cc Added 09 May 2012 (Adasko)
4590 cc Intertyp means interaction type of backbone mainchain correlation:
4591 c 1 = SC...Ca...Ca...Ca
4592 c 2 = Ca...Ca...Ca...SC
4593 c 3 = SC...Ca...Ca...SCi
4595 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4596 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4597 & (itype(i-1).eq.ntyp1)))
4598 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4599 & .or.(itype(i-2).eq.ntyp1)))
4600 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4601 & (itype(i-1).eq.ntyp1)))) cycle
4602 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4603 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4605 do j=1,nterm_sccor(isccori,isccori1)
4606 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4607 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4608 cosphi=dcos(j*tauangle(intertyp,i))
4609 sinphi=dsin(j*tauangle(intertyp,i))
4610 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4611 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4613 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4614 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4615 c &gloc_sc(intertyp,i-3,icg)
4617 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4618 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4619 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4620 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4621 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4625 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4629 c------------------------------------------------------------------------------
4630 subroutine multibody(ecorr)
4631 C This subroutine calculates multi-body contributions to energy following
4632 C the idea of Skolnick et al. If side chains I and J make a contact and
4633 C at the same time side chains I+1 and J+1 make a contact, an extra
4634 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4635 implicit real*8 (a-h,o-z)
4636 include 'DIMENSIONS'
4637 include 'COMMON.IOUNITS'
4638 include 'COMMON.DERIV'
4639 include 'COMMON.INTERACT'
4640 include 'COMMON.CONTACTS'
4641 double precision gx(3),gx1(3)
4644 C Set lprn=.true. for debugging
4648 write (iout,'(a)') 'Contact function values:'
4650 write (iout,'(i2,20(1x,i2,f10.5))')
4651 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4666 num_conti=num_cont(i)
4667 num_conti1=num_cont(i1)
4672 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4673 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4674 cd & ' ishift=',ishift
4675 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4676 C The system gains extra energy.
4677 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4678 endif ! j1==j+-ishift
4687 c------------------------------------------------------------------------------
4688 double precision function esccorr(i,j,k,l,jj,kk)
4689 implicit real*8 (a-h,o-z)
4690 include 'DIMENSIONS'
4691 include 'COMMON.IOUNITS'
4692 include 'COMMON.DERIV'
4693 include 'COMMON.INTERACT'
4694 include 'COMMON.CONTACTS'
4695 double precision gx(3),gx1(3)
4700 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4701 C Calculate the multi-body contribution to energy.
4702 C Calculate multi-body contributions to the gradient.
4703 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4704 cd & k,l,(gacont(m,kk,k),m=1,3)
4706 gx(m) =ekl*gacont(m,jj,i)
4707 gx1(m)=eij*gacont(m,kk,k)
4708 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4709 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4710 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4711 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4715 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4720 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4726 c------------------------------------------------------------------------------
4728 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4729 implicit real*8 (a-h,o-z)
4730 include 'DIMENSIONS'
4731 integer dimen1,dimen2,atom,indx
4732 double precision buffer(dimen1,dimen2)
4733 double precision zapas
4734 common /contacts_hb/ zapas(3,20,maxres,7),
4735 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4736 & num_cont_hb(maxres),jcont_hb(20,maxres)
4737 num_kont=num_cont_hb(atom)
4741 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4744 buffer(i,indx+22)=facont_hb(i,atom)
4745 buffer(i,indx+23)=ees0p(i,atom)
4746 buffer(i,indx+24)=ees0m(i,atom)
4747 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4749 buffer(1,indx+26)=dfloat(num_kont)
4752 c------------------------------------------------------------------------------
4753 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4754 implicit real*8 (a-h,o-z)
4755 include 'DIMENSIONS'
4756 integer dimen1,dimen2,atom,indx
4757 double precision buffer(dimen1,dimen2)
4758 double precision zapas
4759 common /contacts_hb/ zapas(3,20,maxres,7),
4760 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4761 & num_cont_hb(maxres),jcont_hb(20,maxres)
4762 num_kont=buffer(1,indx+26)
4763 num_kont_old=num_cont_hb(atom)
4764 num_cont_hb(atom)=num_kont+num_kont_old
4769 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4772 facont_hb(ii,atom)=buffer(i,indx+22)
4773 ees0p(ii,atom)=buffer(i,indx+23)
4774 ees0m(ii,atom)=buffer(i,indx+24)
4775 jcont_hb(ii,atom)=buffer(i,indx+25)
4779 c------------------------------------------------------------------------------
4781 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4782 C This subroutine calculates multi-body contributions to hydrogen-bonding
4783 implicit real*8 (a-h,o-z)
4784 include 'DIMENSIONS'
4785 include 'DIMENSIONS.ZSCOPT'
4786 include 'COMMON.IOUNITS'
4788 include 'COMMON.INFO'
4790 include 'COMMON.FFIELD'
4791 include 'COMMON.DERIV'
4792 include 'COMMON.INTERACT'
4793 include 'COMMON.CONTACTS'
4795 parameter (max_cont=maxconts)
4796 parameter (max_dim=2*(8*3+2))
4797 parameter (msglen1=max_cont*max_dim*4)
4798 parameter (msglen2=2*msglen1)
4799 integer source,CorrelType,CorrelID,Error
4800 double precision buffer(max_cont,max_dim)
4802 double precision gx(3),gx1(3)
4805 C Set lprn=.true. for debugging
4810 if (fgProcs.le.1) goto 30
4812 write (iout,'(a)') 'Contact function values:'
4814 write (iout,'(2i3,50(1x,i2,f5.2))')
4815 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4816 & j=1,num_cont_hb(i))
4819 C Caution! Following code assumes that electrostatic interactions concerning
4820 C a given atom are split among at most two processors!
4830 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4833 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4834 if (MyRank.gt.0) then
4835 C Send correlation contributions to the preceding processor
4837 nn=num_cont_hb(iatel_s)
4838 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4839 cd write (iout,*) 'The BUFFER array:'
4841 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4843 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4845 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4846 C Clear the contacts of the atom passed to the neighboring processor
4847 nn=num_cont_hb(iatel_s+1)
4849 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4851 num_cont_hb(iatel_s)=0
4853 cd write (iout,*) 'Processor ',MyID,MyRank,
4854 cd & ' is sending correlation contribution to processor',MyID-1,
4855 cd & ' msglen=',msglen
4856 cd write (*,*) 'Processor ',MyID,MyRank,
4857 cd & ' is sending correlation contribution to processor',MyID-1,
4858 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4859 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4860 cd write (iout,*) 'Processor ',MyID,
4861 cd & ' has sent correlation contribution to processor',MyID-1,
4862 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4863 cd write (*,*) 'Processor ',MyID,
4864 cd & ' has sent correlation contribution to processor',MyID-1,
4865 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4867 endif ! (MyRank.gt.0)
4871 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4872 if (MyRank.lt.fgProcs-1) then
4873 C Receive correlation contributions from the next processor
4875 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4876 cd write (iout,*) 'Processor',MyID,
4877 cd & ' is receiving correlation contribution from processor',MyID+1,
4878 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4879 cd write (*,*) 'Processor',MyID,
4880 cd & ' is receiving correlation contribution from processor',MyID+1,
4881 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4883 do while (nbytes.le.0)
4884 call mp_probe(MyID+1,CorrelType,nbytes)
4886 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4887 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4888 cd write (iout,*) 'Processor',MyID,
4889 cd & ' has received correlation contribution from processor',MyID+1,
4890 cd & ' msglen=',msglen,' nbytes=',nbytes
4891 cd write (iout,*) 'The received BUFFER array:'
4893 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4895 if (msglen.eq.msglen1) then
4896 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4897 else if (msglen.eq.msglen2) then
4898 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4899 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4902 & 'ERROR!!!! message length changed while processing correlations.'
4904 & 'ERROR!!!! message length changed while processing correlations.'
4905 call mp_stopall(Error)
4906 endif ! msglen.eq.msglen1
4907 endif ! MyRank.lt.fgProcs-1
4914 write (iout,'(a)') 'Contact function values:'
4916 write (iout,'(2i3,50(1x,i2,f5.2))')
4917 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4918 & j=1,num_cont_hb(i))
4922 C Remove the loop below after debugging !!!
4929 C Calculate the local-electrostatic correlation terms
4930 do i=iatel_s,iatel_e+1
4932 num_conti=num_cont_hb(i)
4933 num_conti1=num_cont_hb(i+1)
4938 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4939 c & ' jj=',jj,' kk=',kk
4940 if (j1.eq.j+1 .or. j1.eq.j-1) then
4941 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4942 C The system gains extra energy.
4943 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4945 else if (j1.eq.j) then
4946 C Contacts I-J and I-(J+1) occur simultaneously.
4947 C The system loses extra energy.
4948 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4953 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4954 c & ' jj=',jj,' kk=',kk
4956 C Contacts I-J and (I+1)-J occur simultaneously.
4957 C The system loses extra energy.
4958 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4965 c------------------------------------------------------------------------------
4966 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4968 C This subroutine calculates multi-body contributions to hydrogen-bonding
4969 implicit real*8 (a-h,o-z)
4970 include 'DIMENSIONS'
4971 include 'DIMENSIONS.ZSCOPT'
4972 include 'COMMON.IOUNITS'
4974 include 'COMMON.INFO'
4976 include 'COMMON.FFIELD'
4977 include 'COMMON.DERIV'
4978 include 'COMMON.INTERACT'
4979 include 'COMMON.CONTACTS'
4981 parameter (max_cont=maxconts)
4982 parameter (max_dim=2*(8*3+2))
4983 parameter (msglen1=max_cont*max_dim*4)
4984 parameter (msglen2=2*msglen1)
4985 integer source,CorrelType,CorrelID,Error
4986 double precision buffer(max_cont,max_dim)
4988 double precision gx(3),gx1(3)
4991 C Set lprn=.true. for debugging
4997 if (fgProcs.le.1) goto 30
4999 write (iout,'(a)') 'Contact function values:'
5001 write (iout,'(2i3,50(1x,i2,f5.2))')
5002 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5003 & j=1,num_cont_hb(i))
5006 C Caution! Following code assumes that electrostatic interactions concerning
5007 C a given atom are split among at most two processors!
5017 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5020 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5021 if (MyRank.gt.0) then
5022 C Send correlation contributions to the preceding processor
5024 nn=num_cont_hb(iatel_s)
5025 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5026 cd write (iout,*) 'The BUFFER array:'
5028 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5030 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5032 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5033 C Clear the contacts of the atom passed to the neighboring processor
5034 nn=num_cont_hb(iatel_s+1)
5036 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5038 num_cont_hb(iatel_s)=0
5040 cd write (iout,*) 'Processor ',MyID,MyRank,
5041 cd & ' is sending correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen
5043 cd write (*,*) 'Processor ',MyID,MyRank,
5044 cd & ' is sending correlation contribution to processor',MyID-1,
5045 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5046 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5047 cd write (iout,*) 'Processor ',MyID,
5048 cd & ' has sent correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5050 cd write (*,*) 'Processor ',MyID,
5051 cd & ' has sent correlation contribution to processor',MyID-1,
5052 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5054 endif ! (MyRank.gt.0)
5058 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5059 if (MyRank.lt.fgProcs-1) then
5060 C Receive correlation contributions from the next processor
5062 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5063 cd write (iout,*) 'Processor',MyID,
5064 cd & ' is receiving correlation contribution from processor',MyID+1,
5065 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5066 cd write (*,*) 'Processor',MyID,
5067 cd & ' is receiving correlation contribution from processor',MyID+1,
5068 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5070 do while (nbytes.le.0)
5071 call mp_probe(MyID+1,CorrelType,nbytes)
5073 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5074 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5075 cd write (iout,*) 'Processor',MyID,
5076 cd & ' has received correlation contribution from processor',MyID+1,
5077 cd & ' msglen=',msglen,' nbytes=',nbytes
5078 cd write (iout,*) 'The received BUFFER array:'
5080 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5082 if (msglen.eq.msglen1) then
5083 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5084 else if (msglen.eq.msglen2) then
5085 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5086 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5089 & 'ERROR!!!! message length changed while processing correlations.'
5091 & 'ERROR!!!! message length changed while processing correlations.'
5092 call mp_stopall(Error)
5093 endif ! msglen.eq.msglen1
5094 endif ! MyRank.lt.fgProcs-1
5101 write (iout,'(a)') 'Contact function values:'
5103 write (iout,'(2i3,50(1x,i2,f5.2))')
5104 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5105 & j=1,num_cont_hb(i))
5111 C Remove the loop below after debugging !!!
5118 C Calculate the dipole-dipole interaction energies
5119 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5120 do i=iatel_s,iatel_e+1
5121 num_conti=num_cont_hb(i)
5128 C Calculate the local-electrostatic correlation terms
5129 do i=iatel_s,iatel_e+1
5131 num_conti=num_cont_hb(i)
5132 num_conti1=num_cont_hb(i+1)
5137 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5138 c & ' jj=',jj,' kk=',kk
5139 if (j1.eq.j+1 .or. j1.eq.j-1) then
5140 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5141 C The system gains extra energy.
5143 sqd1=dsqrt(d_cont(jj,i))
5144 sqd2=dsqrt(d_cont(kk,i1))
5145 sred_geom = sqd1*sqd2
5146 IF (sred_geom.lt.cutoff_corr) THEN
5147 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5149 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5150 c & ' jj=',jj,' kk=',kk
5151 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5152 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5154 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5155 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5158 cd write (iout,*) 'sred_geom=',sred_geom,
5159 cd & ' ekont=',ekont,' fprim=',fprimcont
5160 call calc_eello(i,j,i+1,j1,jj,kk)
5161 if (wcorr4.gt.0.0d0)
5162 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5163 if (wcorr5.gt.0.0d0)
5164 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5165 c print *,"wcorr5",ecorr5
5166 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5167 cd write(2,*)'ijkl',i,j,i+1,j1
5168 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5169 & .or. wturn6.eq.0.0d0))then
5170 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5171 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5172 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5173 cd & 'ecorr6=',ecorr6
5174 cd write (iout,'(4e15.5)') sred_geom,
5175 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5176 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5177 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5178 else if (wturn6.gt.0.0d0
5179 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5180 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5181 eturn6=eturn6+eello_turn6(i,jj,kk)
5182 cd write (2,*) 'multibody_eello:eturn6',eturn6
5186 else if (j1.eq.j) then
5187 C Contacts I-J and I-(J+1) occur simultaneously.
5188 C The system loses extra energy.
5189 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5194 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5195 c & ' jj=',jj,' kk=',kk
5197 C Contacts I-J and (I+1)-J occur simultaneously.
5198 C The system loses extra energy.
5199 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5206 c------------------------------------------------------------------------------
5207 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5208 implicit real*8 (a-h,o-z)
5209 include 'DIMENSIONS'
5210 include 'COMMON.IOUNITS'
5211 include 'COMMON.DERIV'
5212 include 'COMMON.INTERACT'
5213 include 'COMMON.CONTACTS'
5214 double precision gx(3),gx1(3)
5224 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5225 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5226 C Following 4 lines for diagnostics.
5231 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5233 c write (iout,*)'Contacts have occurred for peptide groups',
5234 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5235 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5236 C Calculate the multi-body contribution to energy.
5237 ecorr=ecorr+ekont*ees
5239 C Calculate multi-body contributions to the gradient.
5241 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5242 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5243 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5244 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5245 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5246 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5247 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5248 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5249 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5250 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5251 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5252 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5253 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5254 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5258 gradcorr(ll,m)=gradcorr(ll,m)+
5259 & ees*ekl*gacont_hbr(ll,jj,i)-
5260 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5261 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5266 gradcorr(ll,m)=gradcorr(ll,m)+
5267 & ees*eij*gacont_hbr(ll,kk,k)-
5268 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5269 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5276 C---------------------------------------------------------------------------
5277 subroutine dipole(i,j,jj)
5278 implicit real*8 (a-h,o-z)
5279 include 'DIMENSIONS'
5280 include 'DIMENSIONS.ZSCOPT'
5281 include 'COMMON.IOUNITS'
5282 include 'COMMON.CHAIN'
5283 include 'COMMON.FFIELD'
5284 include 'COMMON.DERIV'
5285 include 'COMMON.INTERACT'
5286 include 'COMMON.CONTACTS'
5287 include 'COMMON.TORSION'
5288 include 'COMMON.VAR'
5289 include 'COMMON.GEO'
5290 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5292 iti1 = itortyp(itype(i+1))
5293 if (j.lt.nres-1) then
5294 itj1 = itortyp(itype(j+1))
5299 dipi(iii,1)=Ub2(iii,i)
5300 dipderi(iii)=Ub2der(iii,i)
5301 dipi(iii,2)=b1(iii,iti1)
5302 dipj(iii,1)=Ub2(iii,j)
5303 dipderj(iii)=Ub2der(iii,j)
5304 dipj(iii,2)=b1(iii,itj1)
5308 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5311 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5314 if (.not.calc_grad) return
5319 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5323 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5328 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5329 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5331 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5333 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5335 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5339 C---------------------------------------------------------------------------
5340 subroutine calc_eello(i,j,k,l,jj,kk)
5342 C This subroutine computes matrices and vectors needed to calculate
5343 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5345 implicit real*8 (a-h,o-z)
5346 include 'DIMENSIONS'
5347 include 'DIMENSIONS.ZSCOPT'
5348 include 'COMMON.IOUNITS'
5349 include 'COMMON.CHAIN'
5350 include 'COMMON.DERIV'
5351 include 'COMMON.INTERACT'
5352 include 'COMMON.CONTACTS'
5353 include 'COMMON.TORSION'
5354 include 'COMMON.VAR'
5355 include 'COMMON.GEO'
5356 include 'COMMON.FFIELD'
5357 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5358 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5361 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5362 cd & ' jj=',jj,' kk=',kk
5363 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5366 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5367 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5370 call transpose2(aa1(1,1),aa1t(1,1))
5371 call transpose2(aa2(1,1),aa2t(1,1))
5374 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5375 & aa1tder(1,1,lll,kkk))
5376 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5377 & aa2tder(1,1,lll,kkk))
5381 C parallel orientation of the two CA-CA-CA frames.
5383 iti=itortyp(itype(i))
5387 itk1=itortyp(itype(k+1))
5388 itj=itortyp(itype(j))
5389 if (l.lt.nres-1) then
5390 itl1=itortyp(itype(l+1))
5394 C A1 kernel(j+1) A2T
5396 cd write (iout,'(3f10.5,5x,3f10.5)')
5397 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5399 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5400 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5401 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5402 C Following matrices are needed only for 6-th order cumulants
5403 IF (wcorr6.gt.0.0d0) THEN
5404 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5405 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5406 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5407 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5408 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5409 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5410 & ADtEAderx(1,1,1,1,1,1))
5412 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5413 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5414 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5415 & ADtEA1derx(1,1,1,1,1,1))
5417 C End 6-th order cumulants
5420 cd write (2,*) 'In calc_eello6'
5422 cd write (2,*) 'iii=',iii
5424 cd write (2,*) 'kkk=',kkk
5426 cd write (2,'(3(2f10.5),5x)')
5427 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5432 call transpose2(EUgder(1,1,k),auxmat(1,1))
5433 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5434 call transpose2(EUg(1,1,k),auxmat(1,1))
5435 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5436 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5440 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5441 & EAEAderx(1,1,lll,kkk,iii,1))
5445 C A1T kernel(i+1) A2
5446 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5447 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5448 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5449 C Following matrices are needed only for 6-th order cumulants
5450 IF (wcorr6.gt.0.0d0) THEN
5451 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5452 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5453 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5454 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5455 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5456 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5457 & ADtEAderx(1,1,1,1,1,2))
5458 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5459 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5460 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5461 & ADtEA1derx(1,1,1,1,1,2))
5463 C End 6-th order cumulants
5464 call transpose2(EUgder(1,1,l),auxmat(1,1))
5465 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5466 call transpose2(EUg(1,1,l),auxmat(1,1))
5467 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5468 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5473 & EAEAderx(1,1,lll,kkk,iii,2))
5478 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5479 C They are needed only when the fifth- or the sixth-order cumulants are
5481 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5482 call transpose2(AEA(1,1,1),auxmat(1,1))
5483 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5484 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5485 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5486 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5487 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5488 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5489 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5490 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5491 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5492 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5493 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5494 call transpose2(AEA(1,1,2),auxmat(1,1))
5495 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5496 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5497 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5498 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5499 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5500 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5501 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5502 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5503 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5504 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5505 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5506 C Calculate the Cartesian derivatives of the vectors.
5510 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5511 call matvec2(auxmat(1,1),b1(1,iti),
5512 & AEAb1derx(1,lll,kkk,iii,1,1))
5513 call matvec2(auxmat(1,1),Ub2(1,i),
5514 & AEAb2derx(1,lll,kkk,iii,1,1))
5515 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5516 & AEAb1derx(1,lll,kkk,iii,2,1))
5517 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5518 & AEAb2derx(1,lll,kkk,iii,2,1))
5519 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5520 call matvec2(auxmat(1,1),b1(1,itj),
5521 & AEAb1derx(1,lll,kkk,iii,1,2))
5522 call matvec2(auxmat(1,1),Ub2(1,j),
5523 & AEAb2derx(1,lll,kkk,iii,1,2))
5524 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5525 & AEAb1derx(1,lll,kkk,iii,2,2))
5526 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5527 & AEAb2derx(1,lll,kkk,iii,2,2))
5534 C Antiparallel orientation of the two CA-CA-CA frames.
5536 iti=itortyp(itype(i))
5540 itk1=itortyp(itype(k+1))
5541 itl=itortyp(itype(l))
5542 itj=itortyp(itype(j))
5543 if (j.lt.nres-1) then
5544 itj1=itortyp(itype(j+1))
5548 C A2 kernel(j-1)T A1T
5549 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5550 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5551 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5552 C Following matrices are needed only for 6-th order cumulants
5553 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5554 & j.eq.i+4 .and. l.eq.i+3)) THEN
5555 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5556 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5557 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5558 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5559 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5560 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5561 & ADtEAderx(1,1,1,1,1,1))
5562 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5563 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5564 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5565 & ADtEA1derx(1,1,1,1,1,1))
5567 C End 6-th order cumulants
5568 call transpose2(EUgder(1,1,k),auxmat(1,1))
5569 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5570 call transpose2(EUg(1,1,k),auxmat(1,1))
5571 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5572 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5576 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5577 & EAEAderx(1,1,lll,kkk,iii,1))
5581 C A2T kernel(i+1)T A1
5582 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5583 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5584 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5585 C Following matrices are needed only for 6-th order cumulants
5586 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5587 & j.eq.i+4 .and. l.eq.i+3)) THEN
5588 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5589 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5590 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5591 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5592 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5593 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5594 & ADtEAderx(1,1,1,1,1,2))
5595 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5597 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5598 & ADtEA1derx(1,1,1,1,1,2))
5600 C End 6-th order cumulants
5601 call transpose2(EUgder(1,1,j),auxmat(1,1))
5602 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5603 call transpose2(EUg(1,1,j),auxmat(1,1))
5604 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5605 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5609 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5610 & EAEAderx(1,1,lll,kkk,iii,2))
5615 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5616 C They are needed only when the fifth- or the sixth-order cumulants are
5618 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5619 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5620 call transpose2(AEA(1,1,1),auxmat(1,1))
5621 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5622 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5623 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5624 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5627 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5628 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5629 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5630 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5631 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5632 call transpose2(AEA(1,1,2),auxmat(1,1))
5633 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5634 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5635 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5636 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5637 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5639 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5640 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5641 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5642 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5643 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5644 C Calculate the Cartesian derivatives of the vectors.
5648 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5649 call matvec2(auxmat(1,1),b1(1,iti),
5650 & AEAb1derx(1,lll,kkk,iii,1,1))
5651 call matvec2(auxmat(1,1),Ub2(1,i),
5652 & AEAb2derx(1,lll,kkk,iii,1,1))
5653 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5654 & AEAb1derx(1,lll,kkk,iii,2,1))
5655 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5656 & AEAb2derx(1,lll,kkk,iii,2,1))
5657 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5658 call matvec2(auxmat(1,1),b1(1,itl),
5659 & AEAb1derx(1,lll,kkk,iii,1,2))
5660 call matvec2(auxmat(1,1),Ub2(1,l),
5661 & AEAb2derx(1,lll,kkk,iii,1,2))
5662 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5663 & AEAb1derx(1,lll,kkk,iii,2,2))
5664 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5665 & AEAb2derx(1,lll,kkk,iii,2,2))
5674 C---------------------------------------------------------------------------
5675 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5676 & KK,KKderg,AKA,AKAderg,AKAderx)
5680 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5681 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5682 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5687 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5689 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5692 cd if (lprn) write (2,*) 'In kernel'
5694 cd if (lprn) write (2,*) 'kkk=',kkk
5696 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5697 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5699 cd write (2,*) 'lll=',lll
5700 cd write (2,*) 'iii=1'
5702 cd write (2,'(3(2f10.5),5x)')
5703 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5706 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5707 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5709 cd write (2,*) 'lll=',lll
5710 cd write (2,*) 'iii=2'
5712 cd write (2,'(3(2f10.5),5x)')
5713 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5720 C---------------------------------------------------------------------------
5721 double precision function eello4(i,j,k,l,jj,kk)
5722 implicit real*8 (a-h,o-z)
5723 include 'DIMENSIONS'
5724 include 'DIMENSIONS.ZSCOPT'
5725 include 'COMMON.IOUNITS'
5726 include 'COMMON.CHAIN'
5727 include 'COMMON.DERIV'
5728 include 'COMMON.INTERACT'
5729 include 'COMMON.CONTACTS'
5730 include 'COMMON.TORSION'
5731 include 'COMMON.VAR'
5732 include 'COMMON.GEO'
5733 double precision pizda(2,2),ggg1(3),ggg2(3)
5734 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5738 cd print *,'eello4:',i,j,k,l,jj,kk
5739 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5740 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5741 cold eij=facont_hb(jj,i)
5742 cold ekl=facont_hb(kk,k)
5744 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5746 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5747 gcorr_loc(k-1)=gcorr_loc(k-1)
5748 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5750 gcorr_loc(l-1)=gcorr_loc(l-1)
5751 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5753 gcorr_loc(j-1)=gcorr_loc(j-1)
5754 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5759 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5760 & -EAEAderx(2,2,lll,kkk,iii,1)
5761 cd derx(lll,kkk,iii)=0.0d0
5765 cd gcorr_loc(l-1)=0.0d0
5766 cd gcorr_loc(j-1)=0.0d0
5767 cd gcorr_loc(k-1)=0.0d0
5769 cd write (iout,*)'Contacts have occurred for peptide groups',
5770 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5771 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5772 if (j.lt.nres-1) then
5779 if (l.lt.nres-1) then
5787 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5788 ggg1(ll)=eel4*g_contij(ll,1)
5789 ggg2(ll)=eel4*g_contij(ll,2)
5790 ghalf=0.5d0*ggg1(ll)
5792 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5793 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5794 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5795 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5796 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5797 ghalf=0.5d0*ggg2(ll)
5799 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5800 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5801 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5802 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5807 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5808 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5813 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5814 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5820 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5825 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5829 cd write (2,*) iii,gcorr_loc(iii)
5833 cd write (2,*) 'ekont',ekont
5834 cd write (iout,*) 'eello4',ekont*eel4
5837 C---------------------------------------------------------------------------
5838 double precision function eello5(i,j,k,l,jj,kk)
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'DIMENSIONS.ZSCOPT'
5842 include 'COMMON.IOUNITS'
5843 include 'COMMON.CHAIN'
5844 include 'COMMON.DERIV'
5845 include 'COMMON.INTERACT'
5846 include 'COMMON.CONTACTS'
5847 include 'COMMON.TORSION'
5848 include 'COMMON.VAR'
5849 include 'COMMON.GEO'
5850 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5851 double precision ggg1(3),ggg2(3)
5852 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5857 C /l\ / \ \ / \ / \ / C
5858 C / \ / \ \ / \ / \ / C
5859 C j| o |l1 | o | o| o | | o |o C
5860 C \ |/k\| |/ \| / |/ \| |/ \| C
5861 C \i/ \ / \ / / \ / \ C
5863 C (I) (II) (III) (IV) C
5865 C eello5_1 eello5_2 eello5_3 eello5_4 C
5867 C Antiparallel chains C
5870 C /j\ / \ \ / \ / \ / C
5871 C / \ / \ \ / \ / \ / C
5872 C j1| o |l | o | o| o | | o |o C
5873 C \ |/k\| |/ \| / |/ \| |/ \| C
5874 C \i/ \ / \ / / \ / \ C
5876 C (I) (II) (III) (IV) C
5878 C eello5_1 eello5_2 eello5_3 eello5_4 C
5880 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5882 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5883 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5888 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5890 itk=itortyp(itype(k))
5891 itl=itortyp(itype(l))
5892 itj=itortyp(itype(j))
5897 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5898 cd & eel5_3_num,eel5_4_num)
5902 derx(lll,kkk,iii)=0.0d0
5906 cd eij=facont_hb(jj,i)
5907 cd ekl=facont_hb(kk,k)
5909 cd write (iout,*)'Contacts have occurred for peptide groups',
5910 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5912 C Contribution from the graph I.
5913 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5914 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5915 call transpose2(EUg(1,1,k),auxmat(1,1))
5916 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5917 vv(1)=pizda(1,1)-pizda(2,2)
5918 vv(2)=pizda(1,2)+pizda(2,1)
5919 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5920 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5922 C Explicit gradient in virtual-dihedral angles.
5923 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5924 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5925 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5926 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5927 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5928 vv(1)=pizda(1,1)-pizda(2,2)
5929 vv(2)=pizda(1,2)+pizda(2,1)
5930 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5931 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5932 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5933 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)-pizda(2,2)
5935 vv(2)=pizda(1,2)+pizda(2,1)
5937 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5938 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5939 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5941 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5942 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5945 C Cartesian gradient
5949 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5951 vv(1)=pizda(1,1)-pizda(2,2)
5952 vv(2)=pizda(1,2)+pizda(2,1)
5953 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5954 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5955 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5962 C Contribution from graph II
5963 call transpose2(EE(1,1,itk),auxmat(1,1))
5964 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5965 vv(1)=pizda(1,1)+pizda(2,2)
5966 vv(2)=pizda(2,1)-pizda(1,2)
5967 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5968 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5970 C Explicit gradient in virtual-dihedral angles.
5971 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5972 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5973 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5974 vv(1)=pizda(1,1)+pizda(2,2)
5975 vv(2)=pizda(2,1)-pizda(1,2)
5977 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5978 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5979 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5981 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5982 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5983 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5985 C Cartesian gradient
5989 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5994 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5995 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6004 C Parallel orientation
6005 C Contribution from graph III
6006 call transpose2(EUg(1,1,l),auxmat(1,1))
6007 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6008 vv(1)=pizda(1,1)-pizda(2,2)
6009 vv(2)=pizda(1,2)+pizda(2,1)
6010 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6011 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6013 C Explicit gradient in virtual-dihedral angles.
6014 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6015 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6016 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6017 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6018 vv(1)=pizda(1,1)-pizda(2,2)
6019 vv(2)=pizda(1,2)+pizda(2,1)
6020 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6021 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6022 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6023 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6024 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6025 vv(1)=pizda(1,1)-pizda(2,2)
6026 vv(2)=pizda(1,2)+pizda(2,1)
6027 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6028 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6029 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6030 C Cartesian gradient
6034 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6036 vv(1)=pizda(1,1)-pizda(2,2)
6037 vv(2)=pizda(1,2)+pizda(2,1)
6038 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6039 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6040 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6046 C Contribution from graph IV
6048 call transpose2(EE(1,1,itl),auxmat(1,1))
6049 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6050 vv(1)=pizda(1,1)+pizda(2,2)
6051 vv(2)=pizda(2,1)-pizda(1,2)
6052 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6053 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6055 C Explicit gradient in virtual-dihedral angles.
6056 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6057 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6058 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6059 vv(1)=pizda(1,1)+pizda(2,2)
6060 vv(2)=pizda(2,1)-pizda(1,2)
6061 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6062 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6063 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6064 C Cartesian gradient
6068 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6070 vv(1)=pizda(1,1)+pizda(2,2)
6071 vv(2)=pizda(2,1)-pizda(1,2)
6072 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6073 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6074 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6080 C Antiparallel orientation
6081 C Contribution from graph III
6083 call transpose2(EUg(1,1,j),auxmat(1,1))
6084 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6085 vv(1)=pizda(1,1)-pizda(2,2)
6086 vv(2)=pizda(1,2)+pizda(2,1)
6087 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6088 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6090 C Explicit gradient in virtual-dihedral angles.
6091 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6092 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6093 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6094 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6095 vv(1)=pizda(1,1)-pizda(2,2)
6096 vv(2)=pizda(1,2)+pizda(2,1)
6097 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6098 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6099 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6100 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6101 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6102 vv(1)=pizda(1,1)-pizda(2,2)
6103 vv(2)=pizda(1,2)+pizda(2,1)
6104 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6105 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6106 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6107 C Cartesian gradient
6111 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6113 vv(1)=pizda(1,1)-pizda(2,2)
6114 vv(2)=pizda(1,2)+pizda(2,1)
6115 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6116 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6117 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6123 C Contribution from graph IV
6125 call transpose2(EE(1,1,itj),auxmat(1,1))
6126 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6127 vv(1)=pizda(1,1)+pizda(2,2)
6128 vv(2)=pizda(2,1)-pizda(1,2)
6129 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6130 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6132 C Explicit gradient in virtual-dihedral angles.
6133 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6134 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6135 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6136 vv(1)=pizda(1,1)+pizda(2,2)
6137 vv(2)=pizda(2,1)-pizda(1,2)
6138 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6139 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6140 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6141 C Cartesian gradient
6145 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6147 vv(1)=pizda(1,1)+pizda(2,2)
6148 vv(2)=pizda(2,1)-pizda(1,2)
6149 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6150 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6151 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6158 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6159 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6160 cd write (2,*) 'ijkl',i,j,k,l
6161 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6162 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6164 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6165 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6166 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6167 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6169 if (j.lt.nres-1) then
6176 if (l.lt.nres-1) then
6186 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6188 ggg1(ll)=eel5*g_contij(ll,1)
6189 ggg2(ll)=eel5*g_contij(ll,2)
6190 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6191 ghalf=0.5d0*ggg1(ll)
6193 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6194 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6195 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6196 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6197 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6198 ghalf=0.5d0*ggg2(ll)
6200 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6201 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6202 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6203 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6208 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6209 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6214 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6215 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6221 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6226 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6230 cd write (2,*) iii,g_corr5_loc(iii)
6234 cd write (2,*) 'ekont',ekont
6235 cd write (iout,*) 'eello5',ekont*eel5
6238 c--------------------------------------------------------------------------
6239 double precision function eello6(i,j,k,l,jj,kk)
6240 implicit real*8 (a-h,o-z)
6241 include 'DIMENSIONS'
6242 include 'DIMENSIONS.ZSCOPT'
6243 include 'COMMON.IOUNITS'
6244 include 'COMMON.CHAIN'
6245 include 'COMMON.DERIV'
6246 include 'COMMON.INTERACT'
6247 include 'COMMON.CONTACTS'
6248 include 'COMMON.TORSION'
6249 include 'COMMON.VAR'
6250 include 'COMMON.GEO'
6251 include 'COMMON.FFIELD'
6252 double precision ggg1(3),ggg2(3)
6253 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6258 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6266 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6267 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6271 derx(lll,kkk,iii)=0.0d0
6275 cd eij=facont_hb(jj,i)
6276 cd ekl=facont_hb(kk,k)
6282 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6283 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6284 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6285 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6286 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6287 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6289 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6290 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6291 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6292 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6293 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6294 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6298 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6300 C If turn contributions are considered, they will be handled separately.
6301 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6302 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6303 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6304 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6305 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6306 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6307 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6310 if (j.lt.nres-1) then
6317 if (l.lt.nres-1) then
6325 ggg1(ll)=eel6*g_contij(ll,1)
6326 ggg2(ll)=eel6*g_contij(ll,2)
6327 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6328 ghalf=0.5d0*ggg1(ll)
6330 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6331 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6332 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6333 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6334 ghalf=0.5d0*ggg2(ll)
6335 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6337 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6338 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6339 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6340 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6345 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6346 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6351 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6352 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6358 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6363 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6367 cd write (2,*) iii,g_corr6_loc(iii)
6371 cd write (2,*) 'ekont',ekont
6372 cd write (iout,*) 'eello6',ekont*eel6
6375 c--------------------------------------------------------------------------
6376 double precision function eello6_graph1(i,j,k,l,imat,swap)
6377 implicit real*8 (a-h,o-z)
6378 include 'DIMENSIONS'
6379 include 'DIMENSIONS.ZSCOPT'
6380 include 'COMMON.IOUNITS'
6381 include 'COMMON.CHAIN'
6382 include 'COMMON.DERIV'
6383 include 'COMMON.INTERACT'
6384 include 'COMMON.CONTACTS'
6385 include 'COMMON.TORSION'
6386 include 'COMMON.VAR'
6387 include 'COMMON.GEO'
6388 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6392 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6394 C Parallel Antiparallel C
6400 C \ j|/k\| / \ |/k\|l / C
6405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6406 itk=itortyp(itype(k))
6407 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6408 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6409 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6410 call transpose2(EUgC(1,1,k),auxmat(1,1))
6411 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6412 vv1(1)=pizda1(1,1)-pizda1(2,2)
6413 vv1(2)=pizda1(1,2)+pizda1(2,1)
6414 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6415 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6416 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6417 s5=scalar2(vv(1),Dtobr2(1,i))
6418 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6419 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6420 if (.not. calc_grad) return
6421 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6422 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6423 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6424 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6425 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6426 & +scalar2(vv(1),Dtobr2der(1,i)))
6427 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6428 vv1(1)=pizda1(1,1)-pizda1(2,2)
6429 vv1(2)=pizda1(1,2)+pizda1(2,1)
6430 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6431 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6433 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6434 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6435 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6436 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6437 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6439 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6440 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6441 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6442 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6443 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6445 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6446 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6447 vv1(1)=pizda1(1,1)-pizda1(2,2)
6448 vv1(2)=pizda1(1,2)+pizda1(2,1)
6449 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6450 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6451 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6452 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6461 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6462 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6463 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6464 call transpose2(EUgC(1,1,k),auxmat(1,1))
6465 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6467 vv1(1)=pizda1(1,1)-pizda1(2,2)
6468 vv1(2)=pizda1(1,2)+pizda1(2,1)
6469 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6470 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6471 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6472 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6473 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6474 s5=scalar2(vv(1),Dtobr2(1,i))
6475 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6481 c----------------------------------------------------------------------------
6482 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6483 implicit real*8 (a-h,o-z)
6484 include 'DIMENSIONS'
6485 include 'DIMENSIONS.ZSCOPT'
6486 include 'COMMON.IOUNITS'
6487 include 'COMMON.CHAIN'
6488 include 'COMMON.DERIV'
6489 include 'COMMON.INTERACT'
6490 include 'COMMON.CONTACTS'
6491 include 'COMMON.TORSION'
6492 include 'COMMON.VAR'
6493 include 'COMMON.GEO'
6495 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6496 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6499 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6501 C Parallel Antiparallel C
6507 C \ j|/k\| \ |/k\|l C
6512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6513 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6514 C AL 7/4/01 s1 would occur in the sixth-order moment,
6515 C but not in a cluster cumulant
6517 s1=dip(1,jj,i)*dip(1,kk,k)
6519 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6521 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6522 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6523 call transpose2(EUg(1,1,k),auxmat(1,1))
6524 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6525 vv(1)=pizda(1,1)-pizda(2,2)
6526 vv(2)=pizda(1,2)+pizda(2,1)
6527 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6528 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6530 eello6_graph2=-(s1+s2+s3+s4)
6532 eello6_graph2=-(s2+s3+s4)
6535 if (.not. calc_grad) return
6536 C Derivatives in gamma(i-1)
6539 s1=dipderg(1,jj,i)*dip(1,kk,k)
6541 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6542 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6543 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6544 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6546 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6548 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6550 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6552 C Derivatives in gamma(k-1)
6554 s1=dip(1,jj,i)*dipderg(1,kk,k)
6556 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6557 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6558 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6559 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6560 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6561 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6562 vv(1)=pizda(1,1)-pizda(2,2)
6563 vv(2)=pizda(1,2)+pizda(2,1)
6564 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6566 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6568 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6570 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6571 C Derivatives in gamma(j-1) or gamma(l-1)
6574 s1=dipderg(3,jj,i)*dip(1,kk,k)
6576 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6577 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6578 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6579 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6580 vv(1)=pizda(1,1)-pizda(2,2)
6581 vv(2)=pizda(1,2)+pizda(2,1)
6582 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6585 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6590 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6591 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6593 C Derivatives in gamma(l-1) or gamma(j-1)
6596 s1=dip(1,jj,i)*dipderg(3,kk,k)
6598 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6599 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6600 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6601 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6602 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6603 vv(1)=pizda(1,1)-pizda(2,2)
6604 vv(2)=pizda(1,2)+pizda(2,1)
6605 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6608 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6610 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6613 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6614 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6616 C Cartesian derivatives.
6618 write (2,*) 'In eello6_graph2'
6620 write (2,*) 'iii=',iii
6622 write (2,*) 'kkk=',kkk
6624 write (2,'(3(2f10.5),5x)')
6625 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6635 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6637 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6640 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6642 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6643 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6645 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6646 call transpose2(EUg(1,1,k),auxmat(1,1))
6647 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6649 vv(1)=pizda(1,1)-pizda(2,2)
6650 vv(2)=pizda(1,2)+pizda(2,1)
6651 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6652 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6654 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6656 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6659 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6661 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6668 c----------------------------------------------------------------------------
6669 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6670 implicit real*8 (a-h,o-z)
6671 include 'DIMENSIONS'
6672 include 'DIMENSIONS.ZSCOPT'
6673 include 'COMMON.IOUNITS'
6674 include 'COMMON.CHAIN'
6675 include 'COMMON.DERIV'
6676 include 'COMMON.INTERACT'
6677 include 'COMMON.CONTACTS'
6678 include 'COMMON.TORSION'
6679 include 'COMMON.VAR'
6680 include 'COMMON.GEO'
6681 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6683 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6685 C Parallel Antiparallel C
6691 C j|/k\| / |/k\|l / C
6696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6698 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6699 C energy moment and not to the cluster cumulant.
6700 iti=itortyp(itype(i))
6701 if (j.lt.nres-1) then
6702 itj1=itortyp(itype(j+1))
6706 itk=itortyp(itype(k))
6707 itk1=itortyp(itype(k+1))
6708 if (l.lt.nres-1) then
6709 itl1=itortyp(itype(l+1))
6714 s1=dip(4,jj,i)*dip(4,kk,k)
6716 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6717 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6718 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6719 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6720 call transpose2(EE(1,1,itk),auxmat(1,1))
6721 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6722 vv(1)=pizda(1,1)+pizda(2,2)
6723 vv(2)=pizda(2,1)-pizda(1,2)
6724 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6725 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6727 eello6_graph3=-(s1+s2+s3+s4)
6729 eello6_graph3=-(s2+s3+s4)
6732 if (.not. calc_grad) return
6733 C Derivatives in gamma(k-1)
6734 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6735 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6736 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6737 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6738 C Derivatives in gamma(l-1)
6739 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6740 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6741 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6742 vv(1)=pizda(1,1)+pizda(2,2)
6743 vv(2)=pizda(2,1)-pizda(1,2)
6744 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6745 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6746 C Cartesian derivatives.
6752 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6754 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6757 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6759 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6760 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6762 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6763 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6765 vv(1)=pizda(1,1)+pizda(2,2)
6766 vv(2)=pizda(2,1)-pizda(1,2)
6767 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6769 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6771 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6774 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6776 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6778 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6784 c----------------------------------------------------------------------------
6785 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6786 implicit real*8 (a-h,o-z)
6787 include 'DIMENSIONS'
6788 include 'DIMENSIONS.ZSCOPT'
6789 include 'COMMON.IOUNITS'
6790 include 'COMMON.CHAIN'
6791 include 'COMMON.DERIV'
6792 include 'COMMON.INTERACT'
6793 include 'COMMON.CONTACTS'
6794 include 'COMMON.TORSION'
6795 include 'COMMON.VAR'
6796 include 'COMMON.GEO'
6797 include 'COMMON.FFIELD'
6798 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6799 & auxvec1(2),auxmat1(2,2)
6801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6803 C Parallel Antiparallel C
6809 C \ j|/k\| \ |/k\|l C
6814 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6816 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6817 C energy moment and not to the cluster cumulant.
6818 cd write (2,*) 'eello_graph4: wturn6',wturn6
6819 iti=itortyp(itype(i))
6820 itj=itortyp(itype(j))
6821 if (j.lt.nres-1) then
6822 itj1=itortyp(itype(j+1))
6826 itk=itortyp(itype(k))
6827 if (k.lt.nres-1) then
6828 itk1=itortyp(itype(k+1))
6832 itl=itortyp(itype(l))
6833 if (l.lt.nres-1) then
6834 itl1=itortyp(itype(l+1))
6838 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6839 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6840 cd & ' itl',itl,' itl1',itl1
6843 s1=dip(3,jj,i)*dip(3,kk,k)
6845 s1=dip(2,jj,j)*dip(2,kk,l)
6848 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6849 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6851 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6852 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6854 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6855 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6857 call transpose2(EUg(1,1,k),auxmat(1,1))
6858 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6859 vv(1)=pizda(1,1)-pizda(2,2)
6860 vv(2)=pizda(2,1)+pizda(1,2)
6861 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6862 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6864 eello6_graph4=-(s1+s2+s3+s4)
6866 eello6_graph4=-(s2+s3+s4)
6868 if (.not. calc_grad) return
6869 C Derivatives in gamma(i-1)
6873 s1=dipderg(2,jj,i)*dip(3,kk,k)
6875 s1=dipderg(4,jj,j)*dip(2,kk,l)
6878 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6880 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6881 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6883 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6884 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6886 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6887 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6888 cd write (2,*) 'turn6 derivatives'
6890 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6892 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6896 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6898 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6902 C Derivatives in gamma(k-1)
6905 s1=dip(3,jj,i)*dipderg(2,kk,k)
6907 s1=dip(2,jj,j)*dipderg(4,kk,l)
6910 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6911 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6913 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6914 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6916 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6917 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6919 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6920 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6921 vv(1)=pizda(1,1)-pizda(2,2)
6922 vv(2)=pizda(2,1)+pizda(1,2)
6923 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6924 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6926 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6928 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6932 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6934 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6937 C Derivatives in gamma(j-1) or gamma(l-1)
6938 if (l.eq.j+1 .and. l.gt.1) then
6939 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6940 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6941 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6942 vv(1)=pizda(1,1)-pizda(2,2)
6943 vv(2)=pizda(2,1)+pizda(1,2)
6944 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6945 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6946 else if (j.gt.1) then
6947 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6948 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6949 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6950 vv(1)=pizda(1,1)-pizda(2,2)
6951 vv(2)=pizda(2,1)+pizda(1,2)
6952 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6953 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6954 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6956 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6959 C Cartesian derivatives.
6966 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6968 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6972 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6974 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6978 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6980 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6982 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6983 & b1(1,itj1),auxvec(1))
6984 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6986 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6987 & b1(1,itl1),auxvec(1))
6988 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6990 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6992 vv(1)=pizda(1,1)-pizda(2,2)
6993 vv(2)=pizda(2,1)+pizda(1,2)
6994 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6996 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6998 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7001 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7004 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7007 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7009 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7011 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7015 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7017 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7020 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7022 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7030 c----------------------------------------------------------------------------
7031 double precision function eello_turn6(i,jj,kk)
7032 implicit real*8 (a-h,o-z)
7033 include 'DIMENSIONS'
7034 include 'DIMENSIONS.ZSCOPT'
7035 include 'COMMON.IOUNITS'
7036 include 'COMMON.CHAIN'
7037 include 'COMMON.DERIV'
7038 include 'COMMON.INTERACT'
7039 include 'COMMON.CONTACTS'
7040 include 'COMMON.TORSION'
7041 include 'COMMON.VAR'
7042 include 'COMMON.GEO'
7043 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7044 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7046 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7047 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7048 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7049 C the respective energy moment and not to the cluster cumulant.
7054 iti=itortyp(itype(i))
7055 itk=itortyp(itype(k))
7056 itk1=itortyp(itype(k+1))
7057 itl=itortyp(itype(l))
7058 itj=itortyp(itype(j))
7059 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7060 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7061 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7066 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7068 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7072 derx_turn(lll,kkk,iii)=0.0d0
7079 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7081 cd write (2,*) 'eello6_5',eello6_5
7083 call transpose2(AEA(1,1,1),auxmat(1,1))
7084 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7085 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7086 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7090 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7091 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7092 s2 = scalar2(b1(1,itk),vtemp1(1))
7094 call transpose2(AEA(1,1,2),atemp(1,1))
7095 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7096 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7097 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7101 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7102 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7103 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7105 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7106 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7107 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7108 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7109 ss13 = scalar2(b1(1,itk),vtemp4(1))
7110 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7114 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7120 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7122 C Derivatives in gamma(i+2)
7124 call transpose2(AEA(1,1,1),auxmatd(1,1))
7125 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7126 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7127 call transpose2(AEAderg(1,1,2),atempd(1,1))
7128 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7129 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7133 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7134 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7135 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7141 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7142 C Derivatives in gamma(i+3)
7144 call transpose2(AEA(1,1,1),auxmatd(1,1))
7145 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7146 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7147 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7151 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7152 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7153 s2d = scalar2(b1(1,itk),vtemp1d(1))
7155 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7156 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7158 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7160 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7161 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7162 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7172 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7173 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7175 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7176 & -0.5d0*ekont*(s2d+s12d)
7178 C Derivatives in gamma(i+4)
7179 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7180 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7181 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7183 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7184 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7185 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7195 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7197 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7199 C Derivatives in gamma(i+5)
7201 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7202 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7203 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7207 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7208 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7209 s2d = scalar2(b1(1,itk),vtemp1d(1))
7211 call transpose2(AEA(1,1,2),atempd(1,1))
7212 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7213 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7217 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7218 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7220 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7221 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7222 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7232 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7233 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7235 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7236 & -0.5d0*ekont*(s2d+s12d)
7238 C Cartesian derivatives
7243 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7244 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7245 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7249 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7250 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7252 s2d = scalar2(b1(1,itk),vtemp1d(1))
7254 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7255 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7256 s8d = -(atempd(1,1)+atempd(2,2))*
7257 & scalar2(cc(1,1,itl),vtemp2(1))
7261 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7263 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7264 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7271 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7274 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7278 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7279 & - 0.5d0*(s8d+s12d)
7281 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7290 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7292 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7293 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7294 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7295 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7296 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7298 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7299 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7300 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7304 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7305 cd & 16*eel_turn6_num
7307 if (j.lt.nres-1) then
7314 if (l.lt.nres-1) then
7322 ggg1(ll)=eel_turn6*g_contij(ll,1)
7323 ggg2(ll)=eel_turn6*g_contij(ll,2)
7324 ghalf=0.5d0*ggg1(ll)
7326 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7327 & +ekont*derx_turn(ll,2,1)
7328 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7329 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7330 & +ekont*derx_turn(ll,4,1)
7331 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7332 ghalf=0.5d0*ggg2(ll)
7334 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7335 & +ekont*derx_turn(ll,2,2)
7336 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7337 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7338 & +ekont*derx_turn(ll,4,2)
7339 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7344 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7349 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7355 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7360 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7364 cd write (2,*) iii,g_corr6_loc(iii)
7367 eello_turn6=ekont*eel_turn6
7368 cd write (2,*) 'ekont',ekont
7369 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7372 crc-------------------------------------------------
7373 SUBROUTINE MATVEC2(A1,V1,V2)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 DIMENSION A1(2,2),V1(2),V2(2)
7380 c 3 VI=VI+A1(I,K)*V1(K)
7384 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7385 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7390 C---------------------------------------
7391 SUBROUTINE MATMAT2(A1,A2,A3)
7392 implicit real*8 (a-h,o-z)
7393 include 'DIMENSIONS'
7394 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7395 c DIMENSION AI3(2,2)
7399 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7405 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7406 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7407 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7408 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7416 c-------------------------------------------------------------------------
7417 double precision function scalar2(u,v)
7419 double precision u(2),v(2)
7422 scalar2=u(1)*v(1)+u(2)*v(2)
7426 C-----------------------------------------------------------------------------
7428 subroutine transpose2(a,at)
7430 double precision a(2,2),at(2,2)
7437 c--------------------------------------------------------------------------
7438 subroutine transpose(n,a,at)
7441 double precision a(n,n),at(n,n)
7449 C---------------------------------------------------------------------------
7450 subroutine prodmat3(a1,a2,kk,transp,prod)
7453 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7455 crc double precision auxmat(2,2),prod_(2,2)
7458 crc call transpose2(kk(1,1),auxmat(1,1))
7459 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7460 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7462 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7463 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7464 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7465 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7466 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7467 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7468 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7469 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7472 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7473 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7475 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7476 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7477 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7478 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7479 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7480 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7481 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7482 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7485 c call transpose2(a2(1,1),a2t(1,1))
7488 crc print *,((prod_(i,j),i=1,2),j=1,2)
7489 crc print *,((prod(i,j),i=1,2),j=1,2)
7493 C-----------------------------------------------------------------------------
7494 double precision function scalar(u,v)
7496 double precision u(3),v(3)