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+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
157 c if (dyn_ss) call dyn_set_nss
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 c & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'DIMENSIONS.ZSCOPT'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'DIMENSIONS.ZSCOPT'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.ENEPS'
356 include 'COMMON.SBRIDGE'
357 include 'COMMON.NAMES'
358 include 'COMMON.IOUNITS'
359 include 'COMMON.CONTACTS'
363 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
366 eneps_temp(j,i)=0.0d0
373 if (itypi.eq.ntyp1) cycle
374 itypi1=iabs(itype(i+1))
381 C Calculate SC interaction energy.
384 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
385 cd & 'iend=',iend(i,iint)
386 do j=istart(i,iint),iend(i,iint)
388 if (itypj.eq.ntyp1) cycle
392 C Change 12/1/95 to calculate four-body interactions
393 rij=xj*xj+yj*yj+zj*zj
395 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
396 eps0ij=eps(itypi,itypj)
398 e1=fac*fac*aa(itypi,itypj)
399 e2=fac*bb(itypi,itypj)
401 ij=icant(itypi,itypj)
402 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
403 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
404 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
405 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
406 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
407 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
408 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
409 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
410 if (bb(itypi,itypj).gt.0.0d0) then
417 C Calculate the components of the gradient in DC and X
419 fac=-rrij*(e1+evdwij)
424 gvdwx(k,i)=gvdwx(k,i)-gg(k)
425 gvdwx(k,j)=gvdwx(k,j)+gg(k)
429 gvdwc(l,k)=gvdwc(l,k)+gg(l)
434 C 12/1/95, revised on 5/20/97
436 C Calculate the contact function. The ith column of the array JCONT will
437 C contain the numbers of atoms that make contacts with the atom I (of numbers
438 C greater than I). The arrays FACONT and GACONT will contain the values of
439 C the contact function and its derivative.
441 C Uncomment next line, if the correlation interactions include EVDW explicitly.
442 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
443 C Uncomment next line, if the correlation interactions are contact function only
444 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
446 sigij=sigma(itypi,itypj)
447 r0ij=rs0(itypi,itypj)
449 C Check whether the SC's are not too far to make a contact.
452 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
453 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
455 if (fcont.gt.0.0D0) then
456 C If the SC-SC distance if close to sigma, apply spline.
457 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
458 cAdam & fcont1,fprimcont1)
459 cAdam fcont1=1.0d0-fcont1
460 cAdam if (fcont1.gt.0.0d0) then
461 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
462 cAdam fcont=fcont*fcont1
464 C Uncomment following 4 lines to have the geometric average of the epsilon0's
465 cga eps0ij=1.0d0/dsqrt(eps0ij)
467 cga gg(k)=gg(k)*eps0ij
469 cga eps0ij=-evdwij*eps0ij
470 C Uncomment for AL's type of SC correlation interactions.
472 num_conti=num_conti+1
474 facont(num_conti,i)=fcont*eps0ij
475 fprimcont=eps0ij*fprimcont/rij
477 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
478 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
479 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
480 C Uncomment following 3 lines for Skolnick's type of SC correlation.
481 gacont(1,num_conti,i)=-fprimcont*xj
482 gacont(2,num_conti,i)=-fprimcont*yj
483 gacont(3,num_conti,i)=-fprimcont*zj
484 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
485 cd write (iout,'(2i3,3f10.5)')
486 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
492 num_cont(i)=num_conti
497 gvdwc(j,i)=expon*gvdwc(j,i)
498 gvdwx(j,i)=expon*gvdwx(j,i)
502 C******************************************************************************
506 C To save time, the factor of EXPON has been extracted from ALL components
507 C of GVDWC and GRADX. Remember to multiply them by this factor before further
510 C******************************************************************************
513 C-----------------------------------------------------------------------------
514 subroutine eljk(evdw,evdw_t)
516 C This subroutine calculates the interaction energy of nonbonded side chains
517 C assuming the LJK potential of interaction.
519 implicit real*8 (a-h,o-z)
521 include 'DIMENSIONS.ZSCOPT'
522 include "DIMENSIONS.COMPAR"
525 include 'COMMON.LOCAL'
526 include 'COMMON.CHAIN'
527 include 'COMMON.DERIV'
528 include 'COMMON.INTERACT'
529 include 'COMMON.ENEPS'
530 include 'COMMON.IOUNITS'
531 include 'COMMON.NAMES'
536 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
539 eneps_temp(j,i)=0.0d0
546 if (itypi.eq.ntyp1) cycle
547 itypi1=iabs(itype(i+1))
552 C Calculate SC interaction energy.
555 do j=istart(i,iint),iend(i,iint)
557 if (itypj.eq.ntyp1) cycle
561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
563 e_augm=augm(itypi,itypj)*fac_augm
566 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
567 fac=r_shift_inv**expon
568 e1=fac*fac*aa(itypi,itypj)
569 e2=fac*bb(itypi,itypj)
571 ij=icant(itypi,itypj)
572 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
573 & /dabs(eps(itypi,itypj))
574 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
575 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
576 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
577 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
578 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
579 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
580 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
581 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
582 if (bb(itypi,itypj).gt.0.0d0) then
589 C Calculate the components of the gradient in DC and X
591 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
596 gvdwx(k,i)=gvdwx(k,i)-gg(k)
597 gvdwx(k,j)=gvdwx(k,j)+gg(k)
601 gvdwc(l,k)=gvdwc(l,k)+gg(l)
611 gvdwc(j,i)=expon*gvdwc(j,i)
612 gvdwx(j,i)=expon*gvdwx(j,i)
618 C-----------------------------------------------------------------------------
619 subroutine ebp(evdw,evdw_t)
621 C This subroutine calculates the interaction energy of nonbonded side chains
622 C assuming the Berne-Pechukas potential of interaction.
624 implicit real*8 (a-h,o-z)
626 include 'DIMENSIONS.ZSCOPT'
627 include "DIMENSIONS.COMPAR"
630 include 'COMMON.LOCAL'
631 include 'COMMON.CHAIN'
632 include 'COMMON.DERIV'
633 include 'COMMON.NAMES'
634 include 'COMMON.INTERACT'
635 include 'COMMON.ENEPS'
636 include 'COMMON.IOUNITS'
637 include 'COMMON.CALC'
639 c double precision rrsave(maxdim)
645 eneps_temp(j,i)=0.0d0
650 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
651 c if (icall.eq.0) then
659 itypi1=iabs(itype(i+1))
663 dxi=dc_norm(1,nres+i)
664 dyi=dc_norm(2,nres+i)
665 dzi=dc_norm(3,nres+i)
666 dsci_inv=vbld_inv(i+nres)
668 C Calculate SC interaction energy.
671 do j=istart(i,iint),iend(i,iint)
674 dscj_inv=vbld_inv(j+nres)
675 chi1=chi(itypi,itypj)
676 chi2=chi(itypj,itypi)
683 alf12=0.5D0*(alf1+alf2)
684 C For diagnostics only!!!
697 dxj=dc_norm(1,nres+j)
698 dyj=dc_norm(2,nres+j)
699 dzj=dc_norm(3,nres+j)
700 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
701 cd if (icall.eq.0) then
707 C Calculate the angle-dependent terms of energy & contributions to derivatives.
709 C Calculate whole angle-dependent part of epsilon and contributions
711 fac=(rrij*sigsq)**expon2
712 e1=fac*fac*aa(itypi,itypj)
713 e2=fac*bb(itypi,itypj)
714 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
715 eps2der=evdwij*eps3rt
716 eps3der=evdwij*eps2rt
717 evdwij=evdwij*eps2rt*eps3rt
718 ij=icant(itypi,itypj)
719 aux=eps1*eps2rt**2*eps3rt**2
720 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
721 & /dabs(eps(itypi,itypj))
722 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
723 if (bb(itypi,itypj).gt.0.0d0) then
730 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
731 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
732 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
733 cd & restyp(itypi),i,restyp(itypj),j,
734 cd & epsi,sigm,chi1,chi2,chip1,chip2,
735 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
736 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
739 C Calculate gradient components.
740 e1=e1*eps1*eps2rt**2*eps3rt**2
741 fac=-expon*(e1+evdwij)
744 C Calculate radial part of the gradient
748 C Calculate the angular part of the gradient and sum add the contributions
749 C to the appropriate components of the Cartesian gradient.
758 C-----------------------------------------------------------------------------
759 subroutine egb(evdw,evdw_t)
761 C This subroutine calculates the interaction energy of nonbonded side chains
762 C assuming the Gay-Berne potential of interaction.
764 implicit real*8 (a-h,o-z)
766 include 'DIMENSIONS.ZSCOPT'
767 include "DIMENSIONS.COMPAR"
770 include 'COMMON.LOCAL'
771 include 'COMMON.CHAIN'
772 include 'COMMON.DERIV'
773 include 'COMMON.NAMES'
774 include 'COMMON.INTERACT'
775 include 'COMMON.ENEPS'
776 include 'COMMON.IOUNITS'
777 include 'COMMON.CALC'
778 include 'COMMON.SBRIDGE'
785 eneps_temp(j,i)=0.0d0
788 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
792 c if (icall.gt.0) lprn=.true.
796 itypi1=iabs(itype(i+1))
800 dxi=dc_norm(1,nres+i)
801 dyi=dc_norm(2,nres+i)
802 dzi=dc_norm(3,nres+i)
803 dsci_inv=vbld_inv(i+nres)
805 C Calculate SC interaction energy.
808 do j=istart(i,iint),iend(i,iint)
809 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
810 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
811 C formation no electrostatic interactions should be calculated. If it
812 C would be allowed NaN would appear
813 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
814 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
815 C residue can or cannot form disulfide bond. There is still bug allowing
816 C Cys...Cys...Cys bond formation
817 call dyn_ssbond_ene(i,j,evdwij)
818 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
821 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
822 c & 'evdw',i,j,evdwij,' ss'
826 dscj_inv=vbld_inv(j+nres)
827 sig0ij=sigma(itypi,itypj)
828 chi1=chi(itypi,itypj)
829 chi2=chi(itypj,itypi)
836 alf12=0.5D0*(alf1+alf2)
837 C For diagnostics only!!!
850 dxj=dc_norm(1,nres+j)
851 dyj=dc_norm(2,nres+j)
852 dzj=dc_norm(3,nres+j)
853 c write (iout,*) i,j,xj,yj,zj
854 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
856 C Calculate angle-dependent terms of energy and contributions to their
860 sig=sig0ij*dsqrt(sigsq)
861 rij_shift=1.0D0/rij-sig+sig0ij
862 C I hate to put IF's in the loops, but here don't have another choice!!!!
863 if (rij_shift.le.0.0D0) then
868 c---------------------------------------------------------------
869 rij_shift=1.0D0/rij_shift
871 e1=fac*fac*aa(itypi,itypj)
872 e2=fac*bb(itypi,itypj)
873 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
874 eps2der=evdwij*eps3rt
875 eps3der=evdwij*eps2rt
876 evdwij=evdwij*eps2rt*eps3rt
877 if (bb(itypi,itypj).gt.0) then
882 ij=icant(itypi,itypj)
883 aux=eps1*eps2rt**2*eps3rt**2
884 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
885 & /dabs(eps(itypi,itypj))
886 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
887 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
888 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
889 c & aux*e2/eps(itypi,itypj)
890 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
892 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
893 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
894 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
895 & restyp(itypi),i,restyp(itypj),j,
896 & epsi,sigm,chi1,chi2,chip1,chip2,
897 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
898 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
902 C Calculate gradient components.
903 e1=e1*eps1*eps2rt**2*eps3rt**2
904 fac=-expon*(e1+evdwij)*rij_shift
907 C Calculate the radial part of the gradient
911 C Calculate angular part of the gradient.
920 C-----------------------------------------------------------------------------
921 subroutine egbv(evdw,evdw_t)
923 C This subroutine calculates the interaction energy of nonbonded side chains
924 C assuming the Gay-Berne-Vorobjev potential of interaction.
926 implicit real*8 (a-h,o-z)
928 include 'DIMENSIONS.ZSCOPT'
929 include "DIMENSIONS.COMPAR"
932 include 'COMMON.LOCAL'
933 include 'COMMON.CHAIN'
934 include 'COMMON.DERIV'
935 include 'COMMON.NAMES'
936 include 'COMMON.INTERACT'
937 include 'COMMON.ENEPS'
938 include 'COMMON.IOUNITS'
939 include 'COMMON.CALC'
946 eneps_temp(j,i)=0.0d0
951 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
954 c if (icall.gt.0) lprn=.true.
958 itypi1=iabs(itype(i+1))
962 dxi=dc_norm(1,nres+i)
963 dyi=dc_norm(2,nres+i)
964 dzi=dc_norm(3,nres+i)
965 dsci_inv=vbld_inv(i+nres)
967 C Calculate SC interaction energy.
970 do j=istart(i,iint),iend(i,iint)
973 dscj_inv=vbld_inv(j+nres)
974 sig0ij=sigma(itypi,itypj)
976 chi1=chi(itypi,itypj)
977 chi2=chi(itypj,itypi)
984 alf12=0.5D0*(alf1+alf2)
985 C For diagnostics only!!!
998 dxj=dc_norm(1,nres+j)
999 dyj=dc_norm(2,nres+j)
1000 dzj=dc_norm(3,nres+j)
1001 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1003 C Calculate angle-dependent terms of energy and contributions to their
1007 sig=sig0ij*dsqrt(sigsq)
1008 rij_shift=1.0D0/rij-sig+r0ij
1009 C I hate to put IF's in the loops, but here don't have another choice!!!!
1010 if (rij_shift.le.0.0D0) then
1015 c---------------------------------------------------------------
1016 rij_shift=1.0D0/rij_shift
1017 fac=rij_shift**expon
1018 e1=fac*fac*aa(itypi,itypj)
1019 e2=fac*bb(itypi,itypj)
1020 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1021 eps2der=evdwij*eps3rt
1022 eps3der=evdwij*eps2rt
1023 fac_augm=rrij**expon
1024 e_augm=augm(itypi,itypj)*fac_augm
1025 evdwij=evdwij*eps2rt*eps3rt
1026 if (bb(itypi,itypj).gt.0.0d0) then
1027 evdw=evdw+evdwij+e_augm
1029 evdw_t=evdw_t+evdwij+e_augm
1031 ij=icant(itypi,itypj)
1032 aux=eps1*eps2rt**2*eps3rt**2
1033 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1034 & /dabs(eps(itypi,itypj))
1035 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1036 c eneps_temp(ij)=eneps_temp(ij)
1037 c & +(evdwij+e_augm)/eps(itypi,itypj)
1039 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1040 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1041 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1042 c & restyp(itypi),i,restyp(itypj),j,
1043 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1044 c & chi1,chi2,chip1,chip2,
1045 c & eps1,eps2rt**2,eps3rt**2,
1046 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1050 C Calculate gradient components.
1051 e1=e1*eps1*eps2rt**2*eps3rt**2
1052 fac=-expon*(e1+evdwij)*rij_shift
1054 fac=rij*fac-2*expon*rrij*e_augm
1055 C Calculate the radial part of the gradient
1059 C Calculate angular part of the gradient.
1067 C-----------------------------------------------------------------------------
1068 subroutine sc_angular
1069 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1070 C om12. Called by ebp, egb, and egbv.
1072 include 'COMMON.CALC'
1076 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1077 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1078 om12=dxi*dxj+dyi*dyj+dzi*dzj
1080 C Calculate eps1(om12) and its derivative in om12
1081 faceps1=1.0D0-om12*chiom12
1082 faceps1_inv=1.0D0/faceps1
1083 eps1=dsqrt(faceps1_inv)
1084 C Following variable is eps1*deps1/dom12
1085 eps1_om12=faceps1_inv*chiom12
1086 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1091 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1092 sigsq=1.0D0-facsig*faceps1_inv
1093 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1094 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1095 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1096 C Calculate eps2 and its derivatives in om1, om2, and om12.
1099 chipom12=chip12*om12
1100 facp=1.0D0-om12*chipom12
1102 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1103 C Following variable is the square root of eps2
1104 eps2rt=1.0D0-facp1*facp_inv
1105 C Following three variables are the derivatives of the square root of eps
1106 C in om1, om2, and om12.
1107 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1108 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1109 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1110 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1111 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1112 C Calculate whole angle-dependent part of epsilon and contributions
1113 C to its derivatives
1116 C----------------------------------------------------------------------------
1118 implicit real*8 (a-h,o-z)
1119 include 'DIMENSIONS'
1120 include 'DIMENSIONS.ZSCOPT'
1121 include 'COMMON.CHAIN'
1122 include 'COMMON.DERIV'
1123 include 'COMMON.CALC'
1124 double precision dcosom1(3),dcosom2(3)
1125 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1126 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1127 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1128 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1130 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1131 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1134 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1137 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1138 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1139 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1140 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1141 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1142 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1145 C Calculate the components of the gradient in DC and X
1149 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1154 c------------------------------------------------------------------------------
1155 subroutine vec_and_deriv
1156 implicit real*8 (a-h,o-z)
1157 include 'DIMENSIONS'
1158 include 'DIMENSIONS.ZSCOPT'
1159 include 'COMMON.IOUNITS'
1160 include 'COMMON.GEO'
1161 include 'COMMON.VAR'
1162 include 'COMMON.LOCAL'
1163 include 'COMMON.CHAIN'
1164 include 'COMMON.VECTORS'
1165 include 'COMMON.DERIV'
1166 include 'COMMON.INTERACT'
1167 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1168 C Compute the local reference systems. For reference system (i), the
1169 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1170 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1172 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1173 if (i.eq.nres-1) then
1174 C Case of the last full residue
1175 C Compute the Z-axis
1176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1177 costh=dcos(pi-theta(nres))
1178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1183 C Compute the derivatives of uz
1185 uzder(2,1,1)=-dc_norm(3,i-1)
1186 uzder(3,1,1)= dc_norm(2,i-1)
1187 uzder(1,2,1)= dc_norm(3,i-1)
1189 uzder(3,2,1)=-dc_norm(1,i-1)
1190 uzder(1,3,1)=-dc_norm(2,i-1)
1191 uzder(2,3,1)= dc_norm(1,i-1)
1194 uzder(2,1,2)= dc_norm(3,i)
1195 uzder(3,1,2)=-dc_norm(2,i)
1196 uzder(1,2,2)=-dc_norm(3,i)
1198 uzder(3,2,2)= dc_norm(1,i)
1199 uzder(1,3,2)= dc_norm(2,i)
1200 uzder(2,3,2)=-dc_norm(1,i)
1203 C Compute the Y-axis
1206 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1209 C Compute the derivatives of uy
1212 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1213 & -dc_norm(k,i)*dc_norm(j,i-1)
1214 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1216 uyder(j,j,1)=uyder(j,j,1)-costh
1217 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1222 uygrad(l,k,j,i)=uyder(l,k,j)
1223 uzgrad(l,k,j,i)=uzder(l,k,j)
1227 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1228 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1229 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1230 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1234 C Compute the Z-axis
1235 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1236 costh=dcos(pi-theta(i+2))
1237 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1242 C Compute the derivatives of uz
1244 uzder(2,1,1)=-dc_norm(3,i+1)
1245 uzder(3,1,1)= dc_norm(2,i+1)
1246 uzder(1,2,1)= dc_norm(3,i+1)
1248 uzder(3,2,1)=-dc_norm(1,i+1)
1249 uzder(1,3,1)=-dc_norm(2,i+1)
1250 uzder(2,3,1)= dc_norm(1,i+1)
1253 uzder(2,1,2)= dc_norm(3,i)
1254 uzder(3,1,2)=-dc_norm(2,i)
1255 uzder(1,2,2)=-dc_norm(3,i)
1257 uzder(3,2,2)= dc_norm(1,i)
1258 uzder(1,3,2)= dc_norm(2,i)
1259 uzder(2,3,2)=-dc_norm(1,i)
1262 C Compute the Y-axis
1265 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1268 C Compute the derivatives of uy
1271 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1272 & -dc_norm(k,i)*dc_norm(j,i+1)
1273 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1275 uyder(j,j,1)=uyder(j,j,1)-costh
1276 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1281 uygrad(l,k,j,i)=uyder(l,k,j)
1282 uzgrad(l,k,j,i)=uzder(l,k,j)
1286 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1287 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1288 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1289 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1295 vbld_inv_temp(1)=vbld_inv(i+1)
1296 if (i.lt.nres-1) then
1297 vbld_inv_temp(2)=vbld_inv(i+2)
1299 vbld_inv_temp(2)=vbld_inv(i)
1304 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1305 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1313 C-----------------------------------------------------------------------------
1314 subroutine vec_and_deriv_test
1315 implicit real*8 (a-h,o-z)
1316 include 'DIMENSIONS'
1317 include 'DIMENSIONS.ZSCOPT'
1318 include 'COMMON.IOUNITS'
1319 include 'COMMON.GEO'
1320 include 'COMMON.VAR'
1321 include 'COMMON.LOCAL'
1322 include 'COMMON.CHAIN'
1323 include 'COMMON.VECTORS'
1324 dimension uyder(3,3,2),uzder(3,3,2)
1325 C Compute the local reference systems. For reference system (i), the
1326 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1327 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1329 if (i.eq.nres-1) then
1330 C Case of the last full residue
1331 C Compute the Z-axis
1332 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1333 costh=dcos(pi-theta(nres))
1334 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1335 c write (iout,*) 'fac',fac,
1336 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1337 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1341 C Compute the derivatives of uz
1343 uzder(2,1,1)=-dc_norm(3,i-1)
1344 uzder(3,1,1)= dc_norm(2,i-1)
1345 uzder(1,2,1)= dc_norm(3,i-1)
1347 uzder(3,2,1)=-dc_norm(1,i-1)
1348 uzder(1,3,1)=-dc_norm(2,i-1)
1349 uzder(2,3,1)= dc_norm(1,i-1)
1352 uzder(2,1,2)= dc_norm(3,i)
1353 uzder(3,1,2)=-dc_norm(2,i)
1354 uzder(1,2,2)=-dc_norm(3,i)
1356 uzder(3,2,2)= dc_norm(1,i)
1357 uzder(1,3,2)= dc_norm(2,i)
1358 uzder(2,3,2)=-dc_norm(1,i)
1360 C Compute the Y-axis
1362 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1365 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1366 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1367 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1369 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1372 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1373 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1376 c write (iout,*) 'facy',facy,
1377 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1378 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1380 uy(k,i)=facy*uy(k,i)
1382 C Compute the derivatives of uy
1385 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1386 & -dc_norm(k,i)*dc_norm(j,i-1)
1387 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1389 c uyder(j,j,1)=uyder(j,j,1)-costh
1390 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1391 uyder(j,j,1)=uyder(j,j,1)
1392 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1393 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1399 uygrad(l,k,j,i)=uyder(l,k,j)
1400 uzgrad(l,k,j,i)=uzder(l,k,j)
1404 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1405 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1406 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1407 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1410 C Compute the Z-axis
1411 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1412 costh=dcos(pi-theta(i+2))
1413 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1414 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1418 C Compute the derivatives of uz
1420 uzder(2,1,1)=-dc_norm(3,i+1)
1421 uzder(3,1,1)= dc_norm(2,i+1)
1422 uzder(1,2,1)= dc_norm(3,i+1)
1424 uzder(3,2,1)=-dc_norm(1,i+1)
1425 uzder(1,3,1)=-dc_norm(2,i+1)
1426 uzder(2,3,1)= dc_norm(1,i+1)
1429 uzder(2,1,2)= dc_norm(3,i)
1430 uzder(3,1,2)=-dc_norm(2,i)
1431 uzder(1,2,2)=-dc_norm(3,i)
1433 uzder(3,2,2)= dc_norm(1,i)
1434 uzder(1,3,2)= dc_norm(2,i)
1435 uzder(2,3,2)=-dc_norm(1,i)
1437 C Compute the Y-axis
1439 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1440 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1441 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1443 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1446 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1447 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1450 c write (iout,*) 'facy',facy,
1451 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1452 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1454 uy(k,i)=facy*uy(k,i)
1456 C Compute the derivatives of uy
1459 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1460 & -dc_norm(k,i)*dc_norm(j,i+1)
1461 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1463 c uyder(j,j,1)=uyder(j,j,1)-costh
1464 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1465 uyder(j,j,1)=uyder(j,j,1)
1466 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1467 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1473 uygrad(l,k,j,i)=uyder(l,k,j)
1474 uzgrad(l,k,j,i)=uzder(l,k,j)
1478 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1479 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1480 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1481 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1488 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1489 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1496 C-----------------------------------------------------------------------------
1497 subroutine check_vecgrad
1498 implicit real*8 (a-h,o-z)
1499 include 'DIMENSIONS'
1500 include 'DIMENSIONS.ZSCOPT'
1501 include 'COMMON.IOUNITS'
1502 include 'COMMON.GEO'
1503 include 'COMMON.VAR'
1504 include 'COMMON.LOCAL'
1505 include 'COMMON.CHAIN'
1506 include 'COMMON.VECTORS'
1507 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1508 dimension uyt(3,maxres),uzt(3,maxres)
1509 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1510 double precision delta /1.0d-7/
1513 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1514 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1515 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1516 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1517 cd & (dc_norm(if90,i),if90=1,3)
1518 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1519 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1520 cd write(iout,'(a)')
1526 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1527 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1540 cd write (iout,*) 'i=',i
1542 erij(k)=dc_norm(k,i)
1546 dc_norm(k,i)=erij(k)
1548 dc_norm(j,i)=dc_norm(j,i)+delta
1549 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1551 c dc_norm(k,i)=dc_norm(k,i)/fac
1553 c write (iout,*) (dc_norm(k,i),k=1,3)
1554 c write (iout,*) (erij(k),k=1,3)
1557 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1558 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1559 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1560 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1562 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1563 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1564 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1567 dc_norm(k,i)=erij(k)
1570 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1571 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1572 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1573 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1574 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1575 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1576 cd write (iout,'(a)')
1581 C--------------------------------------------------------------------------
1582 subroutine set_matrices
1583 implicit real*8 (a-h,o-z)
1584 include 'DIMENSIONS'
1585 include 'DIMENSIONS.ZSCOPT'
1586 include 'COMMON.IOUNITS'
1587 include 'COMMON.GEO'
1588 include 'COMMON.VAR'
1589 include 'COMMON.LOCAL'
1590 include 'COMMON.CHAIN'
1591 include 'COMMON.DERIV'
1592 include 'COMMON.INTERACT'
1593 include 'COMMON.CONTACTS'
1594 include 'COMMON.TORSION'
1595 include 'COMMON.VECTORS'
1596 include 'COMMON.FFIELD'
1597 double precision auxvec(2),auxmat(2,2)
1599 C Compute the virtual-bond-torsional-angle dependent quantities needed
1600 C to calculate the el-loc multibody terms of various order.
1603 if (i .lt. nres+1) then
1640 if (i .gt. 3 .and. i .lt. nres+1) then
1641 obrot_der(1,i-2)=-sin1
1642 obrot_der(2,i-2)= cos1
1643 Ugder(1,1,i-2)= sin1
1644 Ugder(1,2,i-2)=-cos1
1645 Ugder(2,1,i-2)=-cos1
1646 Ugder(2,2,i-2)=-sin1
1649 obrot2_der(1,i-2)=-dwasin2
1650 obrot2_der(2,i-2)= dwacos2
1651 Ug2der(1,1,i-2)= dwasin2
1652 Ug2der(1,2,i-2)=-dwacos2
1653 Ug2der(2,1,i-2)=-dwacos2
1654 Ug2der(2,2,i-2)=-dwasin2
1656 obrot_der(1,i-2)=0.0d0
1657 obrot_der(2,i-2)=0.0d0
1658 Ugder(1,1,i-2)=0.0d0
1659 Ugder(1,2,i-2)=0.0d0
1660 Ugder(2,1,i-2)=0.0d0
1661 Ugder(2,2,i-2)=0.0d0
1662 obrot2_der(1,i-2)=0.0d0
1663 obrot2_der(2,i-2)=0.0d0
1664 Ug2der(1,1,i-2)=0.0d0
1665 Ug2der(1,2,i-2)=0.0d0
1666 Ug2der(2,1,i-2)=0.0d0
1667 Ug2der(2,2,i-2)=0.0d0
1669 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1670 iti = itortyp(itype(i-2))
1674 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1675 iti1 = itortyp(itype(i-1))
1679 cd write (iout,*) '*******i',i,' iti1',iti
1680 cd write (iout,*) 'b1',b1(:,iti)
1681 cd write (iout,*) 'b2',b2(:,iti)
1682 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1683 if (i .gt. iatel_s+2) then
1684 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1685 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1686 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1687 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1688 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1689 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1690 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1700 DtUg2(l,k,i-2)=0.0d0
1704 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1705 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1706 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1707 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1708 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1709 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1710 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1712 muder(k,i-2)=Ub2der(k,i-2)
1714 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1715 iti1 = itortyp(itype(i-1))
1720 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1722 C Vectors and matrices dependent on a single virtual-bond dihedral.
1723 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1724 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1725 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1726 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1727 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1728 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1729 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1730 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1731 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1732 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1733 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1735 C Matrices dependent on two consecutive virtual-bond dihedrals.
1736 C The order of matrices is from left to right.
1738 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1739 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1740 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1741 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1742 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1743 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1744 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1745 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1748 cd iti = itortyp(itype(i))
1751 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1752 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1757 C--------------------------------------------------------------------------
1758 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1760 C This subroutine calculates the average interaction energy and its gradient
1761 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1762 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1763 C The potential depends both on the distance of peptide-group centers and on
1764 C the orientation of the CA-CA virtual bonds.
1766 implicit real*8 (a-h,o-z)
1767 include 'DIMENSIONS'
1768 include 'DIMENSIONS.ZSCOPT'
1769 include 'COMMON.CONTROL'
1770 include 'COMMON.IOUNITS'
1771 include 'COMMON.GEO'
1772 include 'COMMON.VAR'
1773 include 'COMMON.LOCAL'
1774 include 'COMMON.CHAIN'
1775 include 'COMMON.DERIV'
1776 include 'COMMON.INTERACT'
1777 include 'COMMON.CONTACTS'
1778 include 'COMMON.TORSION'
1779 include 'COMMON.VECTORS'
1780 include 'COMMON.FFIELD'
1781 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1782 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1783 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1784 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1785 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1786 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1787 double precision scal_el /0.5d0/
1789 C 13-go grudnia roku pamietnego...
1790 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1791 & 0.0d0,1.0d0,0.0d0,
1792 & 0.0d0,0.0d0,1.0d0/
1793 cd write(iout,*) 'In EELEC'
1795 cd write(iout,*) 'Type',i
1796 cd write(iout,*) 'B1',B1(:,i)
1797 cd write(iout,*) 'B2',B2(:,i)
1798 cd write(iout,*) 'CC',CC(:,:,i)
1799 cd write(iout,*) 'DD',DD(:,:,i)
1800 cd write(iout,*) 'EE',EE(:,:,i)
1802 cd call check_vecgrad
1804 if (icheckgrad.eq.1) then
1806 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1808 dc_norm(k,i)=dc(k,i)*fac
1810 c write (iout,*) 'i',i,' fac',fac
1813 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1814 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1815 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1816 cd if (wel_loc.gt.0.0d0) then
1817 if (icheckgrad.eq.1) then
1818 call vec_and_deriv_test
1825 cd write (iout,*) 'i=',i
1827 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1830 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1831 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1844 cd print '(a)','Enter EELEC'
1845 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1847 gel_loc_loc(i)=0.0d0
1850 do i=iatel_s,iatel_e
1851 if (itel(i).eq.0) goto 1215
1855 dx_normi=dc_norm(1,i)
1856 dy_normi=dc_norm(2,i)
1857 dz_normi=dc_norm(3,i)
1858 xmedi=c(1,i)+0.5d0*dxi
1859 ymedi=c(2,i)+0.5d0*dyi
1860 zmedi=c(3,i)+0.5d0*dzi
1862 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1863 do j=ielstart(i),ielend(i)
1864 if (itel(j).eq.0) goto 1216
1868 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1869 aaa=app(iteli,itelj)
1870 bbb=bpp(iteli,itelj)
1871 C Diagnostics only!!!
1877 ael6i=ael6(iteli,itelj)
1878 ael3i=ael3(iteli,itelj)
1882 dx_normj=dc_norm(1,j)
1883 dy_normj=dc_norm(2,j)
1884 dz_normj=dc_norm(3,j)
1885 xj=c(1,j)+0.5D0*dxj-xmedi
1886 yj=c(2,j)+0.5D0*dyj-ymedi
1887 zj=c(3,j)+0.5D0*dzj-zmedi
1888 rij=xj*xj+yj*yj+zj*zj
1894 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1895 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1896 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1897 fac=cosa-3.0D0*cosb*cosg
1899 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1900 if (j.eq.i+2) ev1=scal_el*ev1
1905 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1908 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1909 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1910 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1913 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1914 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1915 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1916 cd & xmedi,ymedi,zmedi,xj,yj,zj
1918 C Calculate contributions to the Cartesian gradient.
1921 facvdw=-6*rrmij*(ev1+evdwij)
1922 facel=-3*rrmij*(el1+eesij)
1929 * Radial derivatives. First process both termini of the fragment (i,j)
1936 gelc(k,i)=gelc(k,i)+ghalf
1937 gelc(k,j)=gelc(k,j)+ghalf
1940 * Loop over residues i+1 thru j-1.
1944 gelc(l,k)=gelc(l,k)+ggg(l)
1952 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1953 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1956 * Loop over residues i+1 thru j-1.
1960 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1967 fac=-3*rrmij*(facvdw+facvdw+facel)
1973 * Radial derivatives. First process both termini of the fragment (i,j)
1980 gelc(k,i)=gelc(k,i)+ghalf
1981 gelc(k,j)=gelc(k,j)+ghalf
1984 * Loop over residues i+1 thru j-1.
1988 gelc(l,k)=gelc(l,k)+ggg(l)
1995 ecosa=2.0D0*fac3*fac1+fac4
1998 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1999 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2001 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2002 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2004 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2005 cd & (dcosg(k),k=1,3)
2007 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2011 gelc(k,i)=gelc(k,i)+ghalf
2012 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2013 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2014 gelc(k,j)=gelc(k,j)+ghalf
2015 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2016 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2020 gelc(l,k)=gelc(l,k)+ggg(l)
2025 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2026 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2027 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2029 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2030 C energy of a peptide unit is assumed in the form of a second-order
2031 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2032 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2033 C are computed for EVERY pair of non-contiguous peptide groups.
2035 if (j.lt.nres-1) then
2046 muij(kkk)=mu(k,i)*mu(l,j)
2049 cd write (iout,*) 'EELEC: i',i,' j',j
2050 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2051 cd write(iout,*) 'muij',muij
2052 ury=scalar(uy(1,i),erij)
2053 urz=scalar(uz(1,i),erij)
2054 vry=scalar(uy(1,j),erij)
2055 vrz=scalar(uz(1,j),erij)
2056 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2057 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2058 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2059 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2060 C For diagnostics only
2065 fac=dsqrt(-ael6i)*r3ij
2066 cd write (2,*) 'fac=',fac
2067 C For diagnostics only
2073 cd write (iout,'(4i5,4f10.5)')
2074 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2075 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2076 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2077 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2078 cd write (iout,'(4f10.5)')
2079 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2080 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2081 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2082 cd write (iout,'(2i3,9f10.5/)') i,j,
2083 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2085 C Derivatives of the elements of A in virtual-bond vectors
2086 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2093 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2094 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2095 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2096 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2097 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2098 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2099 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2100 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2101 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2102 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2103 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2104 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2114 C Compute radial contributions to the gradient
2136 C Add the contributions coming from er
2139 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2140 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2141 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2142 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2145 C Derivatives in DC(i)
2146 ghalf1=0.5d0*agg(k,1)
2147 ghalf2=0.5d0*agg(k,2)
2148 ghalf3=0.5d0*agg(k,3)
2149 ghalf4=0.5d0*agg(k,4)
2150 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2151 & -3.0d0*uryg(k,2)*vry)+ghalf1
2152 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2153 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2154 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2155 & -3.0d0*urzg(k,2)*vry)+ghalf3
2156 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2157 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2158 C Derivatives in DC(i+1)
2159 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2160 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2161 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2162 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2163 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2164 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2165 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2166 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2167 C Derivatives in DC(j)
2168 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2169 & -3.0d0*vryg(k,2)*ury)+ghalf1
2170 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2171 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2172 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2173 & -3.0d0*vryg(k,2)*urz)+ghalf3
2174 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2175 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2176 C Derivatives in DC(j+1) or DC(nres-1)
2177 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2178 & -3.0d0*vryg(k,3)*ury)
2179 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2180 & -3.0d0*vrzg(k,3)*ury)
2181 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2182 & -3.0d0*vryg(k,3)*urz)
2183 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2184 & -3.0d0*vrzg(k,3)*urz)
2189 C Derivatives in DC(i+1)
2190 cd aggi1(k,1)=agg(k,1)
2191 cd aggi1(k,2)=agg(k,2)
2192 cd aggi1(k,3)=agg(k,3)
2193 cd aggi1(k,4)=agg(k,4)
2194 C Derivatives in DC(j)
2199 C Derivatives in DC(j+1)
2204 if (j.eq.nres-1 .and. i.lt.j-2) then
2206 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2207 cd aggj1(k,l)=agg(k,l)
2213 C Check the loc-el terms by numerical integration
2223 aggi(k,l)=-aggi(k,l)
2224 aggi1(k,l)=-aggi1(k,l)
2225 aggj(k,l)=-aggj(k,l)
2226 aggj1(k,l)=-aggj1(k,l)
2229 if (j.lt.nres-1) then
2235 aggi(k,l)=-aggi(k,l)
2236 aggi1(k,l)=-aggi1(k,l)
2237 aggj(k,l)=-aggj(k,l)
2238 aggj1(k,l)=-aggj1(k,l)
2249 aggi(k,l)=-aggi(k,l)
2250 aggi1(k,l)=-aggi1(k,l)
2251 aggj(k,l)=-aggj(k,l)
2252 aggj1(k,l)=-aggj1(k,l)
2258 IF (wel_loc.gt.0.0d0) THEN
2259 C Contribution to the local-electrostatic energy coming from the i-j pair
2260 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2262 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2263 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2264 eel_loc=eel_loc+eel_loc_ij
2265 C Partial derivatives in virtual-bond dihedral angles gamma
2268 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2269 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2270 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2271 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2272 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2273 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2274 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2275 cd write(iout,*) 'agg ',agg
2276 cd write(iout,*) 'aggi ',aggi
2277 cd write(iout,*) 'aggi1',aggi1
2278 cd write(iout,*) 'aggj ',aggj
2279 cd write(iout,*) 'aggj1',aggj1
2281 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2283 ggg(l)=agg(l,1)*muij(1)+
2284 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2288 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2291 C Remaining derivatives of eello
2293 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2294 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2295 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2296 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2297 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2298 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2299 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2300 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2304 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2305 C Contributions from turns
2310 call eturn34(i,j,eello_turn3,eello_turn4)
2312 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2313 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2315 C Calculate the contact function. The ith column of the array JCONT will
2316 C contain the numbers of atoms that make contacts with the atom I (of numbers
2317 C greater than I). The arrays FACONT and GACONT will contain the values of
2318 C the contact function and its derivative.
2319 c r0ij=1.02D0*rpp(iteli,itelj)
2320 c r0ij=1.11D0*rpp(iteli,itelj)
2321 r0ij=2.20D0*rpp(iteli,itelj)
2322 c r0ij=1.55D0*rpp(iteli,itelj)
2323 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2324 if (fcont.gt.0.0D0) then
2325 num_conti=num_conti+1
2326 if (num_conti.gt.maxconts) then
2327 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2328 & ' will skip next contacts for this conf.'
2330 jcont_hb(num_conti,i)=j
2331 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2332 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2333 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2335 d_cont(num_conti,i)=rij
2336 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2337 C --- Electrostatic-interaction matrix ---
2338 a_chuj(1,1,num_conti,i)=a22
2339 a_chuj(1,2,num_conti,i)=a23
2340 a_chuj(2,1,num_conti,i)=a32
2341 a_chuj(2,2,num_conti,i)=a33
2342 C --- Gradient of rij
2344 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2347 c a_chuj(1,1,num_conti,i)=-0.61d0
2348 c a_chuj(1,2,num_conti,i)= 0.4d0
2349 c a_chuj(2,1,num_conti,i)= 0.65d0
2350 c a_chuj(2,2,num_conti,i)= 0.50d0
2351 c else if (i.eq.2) then
2352 c a_chuj(1,1,num_conti,i)= 0.0d0
2353 c a_chuj(1,2,num_conti,i)= 0.0d0
2354 c a_chuj(2,1,num_conti,i)= 0.0d0
2355 c a_chuj(2,2,num_conti,i)= 0.0d0
2357 C --- and its gradients
2358 cd write (iout,*) 'i',i,' j',j
2360 cd write (iout,*) 'iii 1 kkk',kkk
2361 cd write (iout,*) agg(kkk,:)
2364 cd write (iout,*) 'iii 2 kkk',kkk
2365 cd write (iout,*) aggi(kkk,:)
2368 cd write (iout,*) 'iii 3 kkk',kkk
2369 cd write (iout,*) aggi1(kkk,:)
2372 cd write (iout,*) 'iii 4 kkk',kkk
2373 cd write (iout,*) aggj(kkk,:)
2376 cd write (iout,*) 'iii 5 kkk',kkk
2377 cd write (iout,*) aggj1(kkk,:)
2384 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2385 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2386 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2387 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2388 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2390 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2396 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2397 C Calculate contact energies
2399 wij=cosa-3.0D0*cosb*cosg
2402 c fac3=dsqrt(-ael6i)/r0ij**3
2403 fac3=dsqrt(-ael6i)*r3ij
2404 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2405 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2407 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2408 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2409 C Diagnostics. Comment out or remove after debugging!
2410 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2411 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2412 c ees0m(num_conti,i)=0.0D0
2414 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2415 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2416 facont_hb(num_conti,i)=fcont
2418 C Angular derivatives of the contact function
2419 ees0pij1=fac3/ees0pij
2420 ees0mij1=fac3/ees0mij
2421 fac3p=-3.0D0*fac3*rrmij
2422 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2423 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2425 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2426 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2427 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2428 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2429 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2430 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2431 ecosap=ecosa1+ecosa2
2432 ecosbp=ecosb1+ecosb2
2433 ecosgp=ecosg1+ecosg2
2434 ecosam=ecosa1-ecosa2
2435 ecosbm=ecosb1-ecosb2
2436 ecosgm=ecosg1-ecosg2
2445 fprimcont=fprimcont/rij
2446 cd facont_hb(num_conti,i)=1.0D0
2447 C Following line is for diagnostics.
2450 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2451 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2454 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2455 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2457 gggp(1)=gggp(1)+ees0pijp*xj
2458 gggp(2)=gggp(2)+ees0pijp*yj
2459 gggp(3)=gggp(3)+ees0pijp*zj
2460 gggm(1)=gggm(1)+ees0mijp*xj
2461 gggm(2)=gggm(2)+ees0mijp*yj
2462 gggm(3)=gggm(3)+ees0mijp*zj
2463 C Derivatives due to the contact function
2464 gacont_hbr(1,num_conti,i)=fprimcont*xj
2465 gacont_hbr(2,num_conti,i)=fprimcont*yj
2466 gacont_hbr(3,num_conti,i)=fprimcont*zj
2468 ghalfp=0.5D0*gggp(k)
2469 ghalfm=0.5D0*gggm(k)
2470 gacontp_hb1(k,num_conti,i)=ghalfp
2471 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2472 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2473 gacontp_hb2(k,num_conti,i)=ghalfp
2474 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2475 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2476 gacontp_hb3(k,num_conti,i)=gggp(k)
2477 gacontm_hb1(k,num_conti,i)=ghalfm
2478 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2479 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2480 gacontm_hb2(k,num_conti,i)=ghalfm
2481 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2482 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2483 gacontm_hb3(k,num_conti,i)=gggm(k)
2486 C Diagnostics. Comment out or remove after debugging!
2488 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2489 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2490 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2491 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2492 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2493 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2496 endif ! num_conti.le.maxconts
2501 num_cont_hb(i)=num_conti
2505 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2506 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2508 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2509 ccc eel_loc=eel_loc+eello_turn3
2512 C-----------------------------------------------------------------------------
2513 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2514 C Third- and fourth-order contributions from turns
2515 implicit real*8 (a-h,o-z)
2516 include 'DIMENSIONS'
2517 include 'DIMENSIONS.ZSCOPT'
2518 include 'COMMON.IOUNITS'
2519 include 'COMMON.GEO'
2520 include 'COMMON.VAR'
2521 include 'COMMON.LOCAL'
2522 include 'COMMON.CHAIN'
2523 include 'COMMON.DERIV'
2524 include 'COMMON.INTERACT'
2525 include 'COMMON.CONTACTS'
2526 include 'COMMON.TORSION'
2527 include 'COMMON.VECTORS'
2528 include 'COMMON.FFIELD'
2530 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2531 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2532 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2533 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2534 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2535 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2537 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2539 C Third-order contributions
2546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2547 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2548 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2549 call transpose2(auxmat(1,1),auxmat1(1,1))
2550 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2551 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2552 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2553 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2554 cd & ' eello_turn3_num',4*eello_turn3_num
2556 C Derivatives in gamma(i)
2557 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2558 call transpose2(auxmat2(1,1),pizda(1,1))
2559 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2560 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2561 C Derivatives in gamma(i+1)
2562 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2563 call transpose2(auxmat2(1,1),pizda(1,1))
2564 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2565 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2566 & +0.5d0*(pizda(1,1)+pizda(2,2))
2567 C Cartesian derivatives
2569 a_temp(1,1)=aggi(l,1)
2570 a_temp(1,2)=aggi(l,2)
2571 a_temp(2,1)=aggi(l,3)
2572 a_temp(2,2)=aggi(l,4)
2573 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2574 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2575 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 a_temp(1,1)=aggi1(l,1)
2577 a_temp(1,2)=aggi1(l,2)
2578 a_temp(2,1)=aggi1(l,3)
2579 a_temp(2,2)=aggi1(l,4)
2580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2581 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2582 & +0.5d0*(pizda(1,1)+pizda(2,2))
2583 a_temp(1,1)=aggj(l,1)
2584 a_temp(1,2)=aggj(l,2)
2585 a_temp(2,1)=aggj(l,3)
2586 a_temp(2,2)=aggj(l,4)
2587 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2588 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2589 & +0.5d0*(pizda(1,1)+pizda(2,2))
2590 a_temp(1,1)=aggj1(l,1)
2591 a_temp(1,2)=aggj1(l,2)
2592 a_temp(2,1)=aggj1(l,3)
2593 a_temp(2,2)=aggj1(l,4)
2594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2595 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2596 & +0.5d0*(pizda(1,1)+pizda(2,2))
2599 else if (j.eq.i+3) then
2600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2602 C Fourth-order contributions
2610 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2611 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2612 iti1=itortyp(itype(i+1))
2613 iti2=itortyp(itype(i+2))
2614 iti3=itortyp(itype(i+3))
2615 call transpose2(EUg(1,1,i+1),e1t(1,1))
2616 call transpose2(Eug(1,1,i+2),e2t(1,1))
2617 call transpose2(Eug(1,1,i+3),e3t(1,1))
2618 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2619 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2620 s1=scalar2(b1(1,iti2),auxvec(1))
2621 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2622 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2623 s2=scalar2(b1(1,iti1),auxvec(1))
2624 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2625 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2626 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2627 eello_turn4=eello_turn4-(s1+s2+s3)
2628 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2629 cd & ' eello_turn4_num',8*eello_turn4_num
2630 C Derivatives in gamma(i)
2632 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2633 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2634 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2635 s1=scalar2(b1(1,iti2),auxvec(1))
2636 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2638 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2639 C Derivatives in gamma(i+1)
2640 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2641 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2642 s2=scalar2(b1(1,iti1),auxvec(1))
2643 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2644 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2645 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2646 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2647 C Derivatives in gamma(i+2)
2648 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2649 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2650 s1=scalar2(b1(1,iti2),auxvec(1))
2651 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2652 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2653 s2=scalar2(b1(1,iti1),auxvec(1))
2654 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2655 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2656 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2657 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2658 C Cartesian derivatives
2659 C Derivatives of this turn contributions in DC(i+2)
2660 if (j.lt.nres-1) then
2662 a_temp(1,1)=agg(l,1)
2663 a_temp(1,2)=agg(l,2)
2664 a_temp(2,1)=agg(l,3)
2665 a_temp(2,2)=agg(l,4)
2666 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2667 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2668 s1=scalar2(b1(1,iti2),auxvec(1))
2669 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2670 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2671 s2=scalar2(b1(1,iti1),auxvec(1))
2672 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2673 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2674 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2676 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2679 C Remaining derivatives of this turn contribution
2681 a_temp(1,1)=aggi(l,1)
2682 a_temp(1,2)=aggi(l,2)
2683 a_temp(2,1)=aggi(l,3)
2684 a_temp(2,2)=aggi(l,4)
2685 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2686 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2687 s1=scalar2(b1(1,iti2),auxvec(1))
2688 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2689 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2690 s2=scalar2(b1(1,iti1),auxvec(1))
2691 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2692 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2693 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2694 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2695 a_temp(1,1)=aggi1(l,1)
2696 a_temp(1,2)=aggi1(l,2)
2697 a_temp(2,1)=aggi1(l,3)
2698 a_temp(2,2)=aggi1(l,4)
2699 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2700 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2701 s1=scalar2(b1(1,iti2),auxvec(1))
2702 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2703 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2704 s2=scalar2(b1(1,iti1),auxvec(1))
2705 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2706 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2707 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2708 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2709 a_temp(1,1)=aggj(l,1)
2710 a_temp(1,2)=aggj(l,2)
2711 a_temp(2,1)=aggj(l,3)
2712 a_temp(2,2)=aggj(l,4)
2713 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2714 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2715 s1=scalar2(b1(1,iti2),auxvec(1))
2716 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2717 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2718 s2=scalar2(b1(1,iti1),auxvec(1))
2719 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2720 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2721 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2722 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2723 a_temp(1,1)=aggj1(l,1)
2724 a_temp(1,2)=aggj1(l,2)
2725 a_temp(2,1)=aggj1(l,3)
2726 a_temp(2,2)=aggj1(l,4)
2727 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2728 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2729 s1=scalar2(b1(1,iti2),auxvec(1))
2730 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2731 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2732 s2=scalar2(b1(1,iti1),auxvec(1))
2733 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2734 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2735 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2736 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2742 C-----------------------------------------------------------------------------
2743 subroutine vecpr(u,v,w)
2744 implicit real*8(a-h,o-z)
2745 dimension u(3),v(3),w(3)
2746 w(1)=u(2)*v(3)-u(3)*v(2)
2747 w(2)=-u(1)*v(3)+u(3)*v(1)
2748 w(3)=u(1)*v(2)-u(2)*v(1)
2751 C-----------------------------------------------------------------------------
2752 subroutine unormderiv(u,ugrad,unorm,ungrad)
2753 C This subroutine computes the derivatives of a normalized vector u, given
2754 C the derivatives computed without normalization conditions, ugrad. Returns
2757 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2758 double precision vec(3)
2759 double precision scalar
2761 c write (2,*) 'ugrad',ugrad
2764 vec(i)=scalar(ugrad(1,i),u(1))
2766 c write (2,*) 'vec',vec
2769 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2772 c write (2,*) 'ungrad',ungrad
2775 C-----------------------------------------------------------------------------
2776 subroutine escp(evdw2,evdw2_14)
2778 C This subroutine calculates the excluded-volume interaction energy between
2779 C peptide-group centers and side chains and its gradient in virtual-bond and
2780 C side-chain vectors.
2782 implicit real*8 (a-h,o-z)
2783 include 'DIMENSIONS'
2784 include 'DIMENSIONS.ZSCOPT'
2785 include 'COMMON.GEO'
2786 include 'COMMON.VAR'
2787 include 'COMMON.LOCAL'
2788 include 'COMMON.CHAIN'
2789 include 'COMMON.DERIV'
2790 include 'COMMON.INTERACT'
2791 include 'COMMON.FFIELD'
2792 include 'COMMON.IOUNITS'
2796 cd print '(a)','Enter ESCP'
2797 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2798 c & ' scal14',scal14
2799 do i=iatscp_s,iatscp_e
2801 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2802 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2803 if (iteli.eq.0) goto 1225
2804 xi=0.5D0*(c(1,i)+c(1,i+1))
2805 yi=0.5D0*(c(2,i)+c(2,i+1))
2806 zi=0.5D0*(c(3,i)+c(3,i+1))
2808 do iint=1,nscp_gr(i)
2810 do j=iscpstart(i,iint),iscpend(i,iint)
2811 itypj=iabs(itype(j))
2812 C Uncomment following three lines for SC-p interactions
2816 C Uncomment following three lines for Ca-p interactions
2820 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2822 e1=fac*fac*aad(itypj,iteli)
2823 e2=fac*bad(itypj,iteli)
2824 if (iabs(j-i) .le. 2) then
2827 evdw2_14=evdw2_14+e1+e2
2830 c write (iout,*) i,j,evdwij
2834 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2836 fac=-(evdwij+e1)*rrij
2841 cd write (iout,*) 'j<i'
2842 C Uncomment following three lines for SC-p interactions
2844 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2847 cd write (iout,*) 'j>i'
2850 C Uncomment following line for SC-p interactions
2851 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2855 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2859 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2860 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2863 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2873 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2874 gradx_scp(j,i)=expon*gradx_scp(j,i)
2877 C******************************************************************************
2881 C To save time the factor EXPON has been extracted from ALL components
2882 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2885 C******************************************************************************
2888 C--------------------------------------------------------------------------
2889 subroutine edis(ehpb)
2891 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2893 implicit real*8 (a-h,o-z)
2894 include 'DIMENSIONS'
2895 include 'COMMON.SBRIDGE'
2896 include 'COMMON.CHAIN'
2897 include 'COMMON.DERIV'
2898 include 'COMMON.VAR'
2899 include 'COMMON.INTERACT'
2900 include 'COMMON.IOUNITS'
2903 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2904 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2905 if (link_end.eq.0) return
2906 do i=link_start,link_end
2907 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2908 C CA-CA distance used in regularization of structure.
2911 C iii and jjj point to the residues for which the distance is assigned.
2912 if (ii.gt.nres) then
2919 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2920 c & dhpb(i),dhpb1(i),forcon(i)
2921 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2922 C distance and angle dependent SS bond potential.
2923 if (.not.dyn_ss .and. i.le.nss) then
2924 C 15/02/13 CC dynamic SSbond - additional check
2925 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2926 & iabs(itype(jjj)).eq.1) then
2927 call ssbond_ene(iii,jjj,eij)
2930 cd write (iout,*) "eij",eij
2931 else if (ii.gt.nres .and. jj.gt.nres) then
2932 c Restraints from contact prediction
2934 if (dhpb1(i).gt.0.0d0) then
2935 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2936 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2937 c write (iout,*) "beta nmr",
2938 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2942 C Get the force constant corresponding to this distance.
2944 C Calculate the contribution to energy.
2945 ehpb=ehpb+waga*rdis*rdis
2946 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2948 C Evaluate gradient.
2953 ggg(j)=fac*(c(j,jj)-c(j,ii))
2956 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2957 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2960 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2961 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2964 C Calculate the distance between the two points and its difference from the
2967 if (dhpb1(i).gt.0.0d0) then
2968 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2969 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2970 c write (iout,*) "alph nmr",
2971 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2974 C Get the force constant corresponding to this distance.
2976 C Calculate the contribution to energy.
2977 ehpb=ehpb+waga*rdis*rdis
2978 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2980 C Evaluate gradient.
2984 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2985 cd & ' waga=',waga,' fac=',fac
2987 ggg(j)=fac*(c(j,jj)-c(j,ii))
2989 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2990 C If this is a SC-SC distance, we need to calculate the contributions to the
2991 C Cartesian gradient in the SC vectors (ghpbx).
2994 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2995 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2999 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3000 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3007 C--------------------------------------------------------------------------
3008 subroutine ssbond_ene(i,j,eij)
3010 C Calculate the distance and angle dependent SS-bond potential energy
3011 C using a free-energy function derived based on RHF/6-31G** ab initio
3012 C calculations of diethyl disulfide.
3014 C A. Liwo and U. Kozlowska, 11/24/03
3016 implicit real*8 (a-h,o-z)
3017 include 'DIMENSIONS'
3018 include 'DIMENSIONS.ZSCOPT'
3019 include 'COMMON.SBRIDGE'
3020 include 'COMMON.CHAIN'
3021 include 'COMMON.DERIV'
3022 include 'COMMON.LOCAL'
3023 include 'COMMON.INTERACT'
3024 include 'COMMON.VAR'
3025 include 'COMMON.IOUNITS'
3026 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3027 itypi=iabs(itype(i))
3031 dxi=dc_norm(1,nres+i)
3032 dyi=dc_norm(2,nres+i)
3033 dzi=dc_norm(3,nres+i)
3034 dsci_inv=dsc_inv(itypi)
3035 itypj=iabs(itype(j))
3036 dscj_inv=dsc_inv(itypj)
3040 dxj=dc_norm(1,nres+j)
3041 dyj=dc_norm(2,nres+j)
3042 dzj=dc_norm(3,nres+j)
3043 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3048 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3049 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3050 om12=dxi*dxj+dyi*dyj+dzi*dzj
3052 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3053 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3059 deltat12=om2-om1+2.0d0
3061 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3062 & +akct*deltad*deltat12+ebr
3063 c & +akct*deltad*deltat12
3064 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3065 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3066 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3067 & " deltat12",deltat12," eij",eij,"ebr",ebr
3068 ed=2*akcm*deltad+akct*deltat12
3070 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3071 eom1=-2*akth*deltat1-pom1-om2*pom2
3072 eom2= 2*akth*deltat2+pom1-om1*pom2
3075 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3078 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3079 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3080 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3081 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3084 C Calculate the components of the gradient in DC and X
3088 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3093 C--------------------------------------------------------------------------
3094 subroutine ebond(estr)
3096 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3098 implicit real*8 (a-h,o-z)
3099 include 'DIMENSIONS'
3100 include 'DIMENSIONS.ZSCOPT'
3101 include 'COMMON.LOCAL'
3102 include 'COMMON.GEO'
3103 include 'COMMON.INTERACT'
3104 include 'COMMON.DERIV'
3105 include 'COMMON.VAR'
3106 include 'COMMON.CHAIN'
3107 include 'COMMON.IOUNITS'
3108 include 'COMMON.NAMES'
3109 include 'COMMON.FFIELD'
3110 include 'COMMON.CONTROL'
3111 double precision u(3),ud(3)
3112 logical :: lprn=.false.
3115 diff = vbld(i)-vbldp0
3116 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3119 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3124 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3131 diff=vbld(i+nres)-vbldsc0(1,iti)
3133 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3134 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3135 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3137 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3141 diff=vbld(i+nres)-vbldsc0(j,iti)
3142 ud(j)=aksc(j,iti)*diff
3143 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3157 uprod2=uprod2*u(k)*u(k)
3161 usumsqder=usumsqder+ud(j)*uprod2
3164 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3165 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3166 estr=estr+uprod/usum
3168 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3176 C--------------------------------------------------------------------------
3177 subroutine ebend(etheta)
3179 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3180 C angles gamma and its derivatives in consecutive thetas and gammas.
3182 implicit real*8 (a-h,o-z)
3183 include 'DIMENSIONS'
3184 include 'DIMENSIONS.ZSCOPT'
3185 include 'COMMON.LOCAL'
3186 include 'COMMON.GEO'
3187 include 'COMMON.INTERACT'
3188 include 'COMMON.DERIV'
3189 include 'COMMON.VAR'
3190 include 'COMMON.CHAIN'
3191 include 'COMMON.IOUNITS'
3192 include 'COMMON.NAMES'
3193 include 'COMMON.FFIELD'
3194 common /calcthet/ term1,term2,termm,diffak,ratak,
3195 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3196 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3197 double precision y(2),z(2)
3199 time11=dexp(-2*time)
3202 c write (iout,*) "nres",nres
3203 c write (*,'(a,i2)') 'EBEND ICG=',icg
3204 c write (iout,*) ithet_start,ithet_end
3205 do i=ithet_start,ithet_end
3206 C Zero the energy function and its derivative at 0 or pi.
3207 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3209 ichir1=isign(1,itype(i-2))
3210 ichir2=isign(1,itype(i))
3211 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3212 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3213 if (itype(i-1).eq.10) then
3214 itype1=isign(10,itype(i-2))
3215 ichir11=isign(1,itype(i-2))
3216 ichir12=isign(1,itype(i-2))
3217 itype2=isign(10,itype(i))
3218 ichir21=isign(1,itype(i))
3219 ichir22=isign(1,itype(i))
3221 c if (i.gt.ithet_start .and.
3222 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3223 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3231 c if (i.lt.nres .and. itel(i).ne.0) then
3243 call proc_proc(phii,icrc)
3244 if (icrc.eq.1) phii=150.0
3258 call proc_proc(phii1,icrc)
3259 if (icrc.eq.1) phii1=150.0
3271 C Calculate the "mean" value of theta from the part of the distribution
3272 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3273 C In following comments this theta will be referred to as t_c.
3274 thet_pred_mean=0.0d0
3276 athetk=athet(k,it,ichir1,ichir2)
3277 bthetk=bthet(k,it,ichir1,ichir2)
3279 athetk=athet(k,itype1,ichir11,ichir12)
3280 bthetk=bthet(k,itype2,ichir21,ichir22)
3282 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3284 c write (iout,*) "thet_pred_mean",thet_pred_mean
3285 dthett=thet_pred_mean*ssd
3286 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3287 c write (iout,*) "thet_pred_mean",thet_pred_mean
3288 C Derivatives of the "mean" values in gamma1 and gamma2.
3289 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3290 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3291 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3292 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3294 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3295 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3296 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3297 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3299 if (theta(i).gt.pi-delta) then
3300 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3302 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3303 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3304 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3306 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3308 else if (theta(i).lt.delta) then
3309 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3310 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3311 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3313 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3314 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3317 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3320 etheta=etheta+ethetai
3321 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3322 c & rad2deg*phii,rad2deg*phii1,ethetai
3323 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3324 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3325 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3328 C Ufff.... We've done all this!!!
3331 C---------------------------------------------------------------------------
3332 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3334 implicit real*8 (a-h,o-z)
3335 include 'DIMENSIONS'
3336 include 'COMMON.LOCAL'
3337 include 'COMMON.IOUNITS'
3338 common /calcthet/ term1,term2,termm,diffak,ratak,
3339 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3340 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3341 C Calculate the contributions to both Gaussian lobes.
3342 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3343 C The "polynomial part" of the "standard deviation" of this part of
3347 sig=sig*thet_pred_mean+polthet(j,it)
3349 C Derivative of the "interior part" of the "standard deviation of the"
3350 C gamma-dependent Gaussian lobe in t_c.
3351 sigtc=3*polthet(3,it)
3353 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3356 C Set the parameters of both Gaussian lobes of the distribution.
3357 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3358 fac=sig*sig+sigc0(it)
3361 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3362 sigsqtc=-4.0D0*sigcsq*sigtc
3363 c print *,i,sig,sigtc,sigsqtc
3364 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3365 sigtc=-sigtc/(fac*fac)
3366 C Following variable is sigma(t_c)**(-2)
3367 sigcsq=sigcsq*sigcsq
3369 sig0inv=1.0D0/sig0i**2
3370 delthec=thetai-thet_pred_mean
3371 delthe0=thetai-theta0i
3372 term1=-0.5D0*sigcsq*delthec*delthec
3373 term2=-0.5D0*sig0inv*delthe0*delthe0
3374 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3375 C NaNs in taking the logarithm. We extract the largest exponent which is added
3376 C to the energy (this being the log of the distribution) at the end of energy
3377 C term evaluation for this virtual-bond angle.
3378 if (term1.gt.term2) then
3380 term2=dexp(term2-termm)
3384 term1=dexp(term1-termm)
3387 C The ratio between the gamma-independent and gamma-dependent lobes of
3388 C the distribution is a Gaussian function of thet_pred_mean too.
3389 diffak=gthet(2,it)-thet_pred_mean
3390 ratak=diffak/gthet(3,it)**2
3391 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3392 C Let's differentiate it in thet_pred_mean NOW.
3394 C Now put together the distribution terms to make complete distribution.
3395 termexp=term1+ak*term2
3396 termpre=sigc+ak*sig0i
3397 C Contribution of the bending energy from this theta is just the -log of
3398 C the sum of the contributions from the two lobes and the pre-exponential
3399 C factor. Simple enough, isn't it?
3400 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3401 C NOW the derivatives!!!
3402 C 6/6/97 Take into account the deformation.
3403 E_theta=(delthec*sigcsq*term1
3404 & +ak*delthe0*sig0inv*term2)/termexp
3405 E_tc=((sigtc+aktc*sig0i)/termpre
3406 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3407 & aktc*term2)/termexp)
3410 c-----------------------------------------------------------------------------
3411 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3412 implicit real*8 (a-h,o-z)
3413 include 'DIMENSIONS'
3414 include 'COMMON.LOCAL'
3415 include 'COMMON.IOUNITS'
3416 common /calcthet/ term1,term2,termm,diffak,ratak,
3417 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3418 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3419 delthec=thetai-thet_pred_mean
3420 delthe0=thetai-theta0i
3421 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3422 t3 = thetai-thet_pred_mean
3426 t14 = t12+t6*sigsqtc
3428 t21 = thetai-theta0i
3434 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3435 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3436 & *(-t12*t9-ak*sig0inv*t27)
3440 C--------------------------------------------------------------------------
3441 subroutine ebend(etheta)
3443 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3444 C angles gamma and its derivatives in consecutive thetas and gammas.
3445 C ab initio-derived potentials from
3446 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3448 implicit real*8 (a-h,o-z)
3449 include 'DIMENSIONS'
3450 include 'DIMENSIONS.ZSCOPT'
3451 include 'COMMON.LOCAL'
3452 include 'COMMON.GEO'
3453 include 'COMMON.INTERACT'
3454 include 'COMMON.DERIV'
3455 include 'COMMON.VAR'
3456 include 'COMMON.CHAIN'
3457 include 'COMMON.IOUNITS'
3458 include 'COMMON.NAMES'
3459 include 'COMMON.FFIELD'
3460 include 'COMMON.CONTROL'
3461 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3462 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3463 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3464 & sinph1ph2(maxdouble,maxdouble)
3465 logical lprn /.false./, lprn1 /.false./
3467 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3468 do i=ithet_start,ithet_end
3469 if (iabs(itype(i+1)).eq.20) iblock=2
3470 if (iabs(itype(i+1)).ne.20) iblock=1
3474 theti2=0.5d0*theta(i)
3475 ityp2=ithetyp((itype(i-1)))
3477 coskt(k)=dcos(k*theti2)
3478 sinkt(k)=dsin(k*theti2)
3483 if (phii.ne.phii) phii=150.0
3487 ityp1=ithetyp(iabs(itype(i-2)))
3489 cosph1(k)=dcos(k*phii)
3490 sinph1(k)=dsin(k*phii)
3503 if (phii1.ne.phii1) phii1=150.0
3508 ityp3=ithetyp((itype(i)))
3510 cosph2(k)=dcos(k*phii1)
3511 sinph2(k)=dsin(k*phii1)
3521 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3522 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3524 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3527 ccl=cosph1(l)*cosph2(k-l)
3528 ssl=sinph1(l)*sinph2(k-l)
3529 scl=sinph1(l)*cosph2(k-l)
3530 csl=cosph1(l)*sinph2(k-l)
3531 cosph1ph2(l,k)=ccl-ssl
3532 cosph1ph2(k,l)=ccl+ssl
3533 sinph1ph2(l,k)=scl+csl
3534 sinph1ph2(k,l)=scl-csl
3538 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3539 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3540 write (iout,*) "coskt and sinkt"
3542 write (iout,*) k,coskt(k),sinkt(k)
3546 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3547 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3550 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3,
3552 & " ethetai",ethetai
3555 write (iout,*) "cosph and sinph"
3557 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3559 write (iout,*) "cosph1ph2 and sinph2ph2"
3562 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3563 & sinph1ph2(l,k),sinph1ph2(k,l)
3566 write(iout,*) "ethetai",ethetai
3570 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3571 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3572 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3573 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3574 ethetai=ethetai+sinkt(m)*aux
3575 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3576 dephii=dephii+k*sinkt(m)*(
3577 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3578 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3579 dephii1=dephii1+k*sinkt(m)*(
3580 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3581 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3583 & write (iout,*) "m",m," k",k," bbthet",
3584 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3585 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3586 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3587 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3591 & write(iout,*) "ethetai",ethetai
3595 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3596 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3597 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3598 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3599 ethetai=ethetai+sinkt(m)*aux
3600 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3601 dephii=dephii+l*sinkt(m)*(
3602 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3603 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3604 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3605 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3606 dephii1=dephii1+(k-l)*sinkt(m)*(
3607 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3608 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3609 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3610 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3612 write (iout,*) "m",m," k",k," l",l," ffthet",
3613 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3614 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3615 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3616 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ethetai",
3618 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3619 & cosph1ph2(k,l)*sinkt(m),
3620 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3626 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3627 & i,theta(i)*rad2deg,phii*rad2deg,
3628 & phii1*rad2deg,ethetai
3629 etheta=etheta+ethetai
3630 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3631 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3632 gloc(nphi+i-2,icg)=wang*dethetai
3638 c-----------------------------------------------------------------------------
3639 subroutine esc(escloc)
3640 C Calculate the local energy of a side chain and its derivatives in the
3641 C corresponding virtual-bond valence angles THETA and the spherical angles
3643 implicit real*8 (a-h,o-z)
3644 include 'DIMENSIONS'
3645 include 'DIMENSIONS.ZSCOPT'
3646 include 'COMMON.GEO'
3647 include 'COMMON.LOCAL'
3648 include 'COMMON.VAR'
3649 include 'COMMON.INTERACT'
3650 include 'COMMON.DERIV'
3651 include 'COMMON.CHAIN'
3652 include 'COMMON.IOUNITS'
3653 include 'COMMON.NAMES'
3654 include 'COMMON.FFIELD'
3655 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3656 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3657 common /sccalc/ time11,time12,time112,theti,it,nlobit
3660 c write (iout,'(a)') 'ESC'
3661 do i=loc_start,loc_end
3663 if (it.eq.10) goto 1
3664 nlobit=nlob(iabs(it))
3665 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3666 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3667 theti=theta(i+1)-pipol
3671 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3673 if (x(2).gt.pi-delta) then
3677 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3679 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3680 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3682 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3683 & ddersc0(1),dersc(1))
3684 call spline2(x(2),pi-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),pi-delta,delta,esclocbi0,esclocbi1,
3691 & dersc0(2),esclocbi,dersc02)
3692 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3694 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
3706 c write (iout,*) escloci
3707 else if (x(2).lt.delta) then
3711 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3713 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3714 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3716 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3717 & ddersc0(1),dersc(1))
3718 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3719 & ddersc0(3),dersc(3))
3721 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3723 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3724 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3725 & dersc0(2),esclocbi,dersc02)
3726 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3731 call splinthet(x(2),0.5d0*delta,ss,ssd)
3733 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3735 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3736 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3738 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3739 c write (iout,*) escloci
3741 call enesc(x,escloci,dersc,ddummy,.false.)
3744 escloc=escloc+escloci
3745 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3747 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3749 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3750 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3755 C---------------------------------------------------------------------------
3756 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3757 implicit real*8 (a-h,o-z)
3758 include 'DIMENSIONS'
3759 include 'COMMON.GEO'
3760 include 'COMMON.LOCAL'
3761 include 'COMMON.IOUNITS'
3762 common /sccalc/ time11,time12,time112,theti,it,nlobit
3763 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3764 double precision contr(maxlob,-1:1)
3766 c write (iout,*) 'it=',it,' nlobit=',nlobit
3770 if (mixed) ddersc(j)=0.0d0
3774 C Because of periodicity of the dependence of the SC energy in omega we have
3775 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3776 C To avoid underflows, first compute & store the exponents.
3784 z(k)=x(k)-censc(k,j,it)
3789 Axk=Axk+gaussc(l,k,j,it)*z(l)
3795 expfac=expfac+Ax(k,j,iii)*z(k)
3803 C As in the case of ebend, we want to avoid underflows in exponentiation and
3804 C subsequent NaNs and INFs in energy calculation.
3805 C Find the largest exponent
3809 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3813 cd print *,'it=',it,' emin=',emin
3815 C Compute the contribution to SC energy and derivatives
3819 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3820 cd print *,'j=',j,' expfac=',expfac
3821 escloc_i=escloc_i+expfac
3823 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3827 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3828 & +gaussc(k,2,j,it))*expfac
3835 dersc(1)=dersc(1)/cos(theti)**2
3836 ddersc(1)=ddersc(1)/cos(theti)**2
3839 escloci=-(dlog(escloc_i)-emin)
3841 dersc(j)=dersc(j)/escloc_i
3845 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3850 C------------------------------------------------------------------------------
3851 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3852 implicit real*8 (a-h,o-z)
3853 include 'DIMENSIONS'
3854 include 'COMMON.GEO'
3855 include 'COMMON.LOCAL'
3856 include 'COMMON.IOUNITS'
3857 common /sccalc/ time11,time12,time112,theti,it,nlobit
3858 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3859 double precision contr(maxlob)
3870 z(k)=x(k)-censc(k,j,it)
3876 Axk=Axk+gaussc(l,k,j,it)*z(l)
3882 expfac=expfac+Ax(k,j)*z(k)
3887 C As in the case of ebend, we want to avoid underflows in exponentiation and
3888 C subsequent NaNs and INFs in energy calculation.
3889 C Find the largest exponent
3892 if (emin.gt.contr(j)) emin=contr(j)
3896 C Compute the contribution to SC energy and derivatives
3900 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3901 escloc_i=escloc_i+expfac
3903 dersc(k)=dersc(k)+Ax(k,j)*expfac
3905 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3906 & +gaussc(1,2,j,it))*expfac
3910 dersc(1)=dersc(1)/cos(theti)**2
3911 dersc12=dersc12/cos(theti)**2
3912 escloci=-(dlog(escloc_i)-emin)
3914 dersc(j)=dersc(j)/escloc_i
3916 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3920 c----------------------------------------------------------------------------------
3921 subroutine esc(escloc)
3922 C Calculate the local energy of a side chain and its derivatives in the
3923 C corresponding virtual-bond valence angles THETA and the spherical angles
3924 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3925 C added by Urszula Kozlowska. 07/11/2007
3927 implicit real*8 (a-h,o-z)
3928 include 'DIMENSIONS'
3929 include 'DIMENSIONS.ZSCOPT'
3930 include 'COMMON.GEO'
3931 include 'COMMON.LOCAL'
3932 include 'COMMON.VAR'
3933 include 'COMMON.SCROT'
3934 include 'COMMON.INTERACT'
3935 include 'COMMON.DERIV'
3936 include 'COMMON.CHAIN'
3937 include 'COMMON.IOUNITS'
3938 include 'COMMON.NAMES'
3939 include 'COMMON.FFIELD'
3940 include 'COMMON.CONTROL'
3941 include 'COMMON.VECTORS'
3942 double precision x_prime(3),y_prime(3),z_prime(3)
3943 & , sumene,dsc_i,dp2_i,x(65),
3944 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3945 & de_dxx,de_dyy,de_dzz,de_dt
3946 double precision s1_t,s1_6_t,s2_t,s2_6_t
3948 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3949 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3950 & dt_dCi(3),dt_dCi1(3)
3951 common /sccalc/ time11,time12,time112,theti,it,nlobit
3954 do i=loc_start,loc_end
3955 costtab(i+1) =dcos(theta(i+1))
3956 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3957 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3958 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3959 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3960 cosfac=dsqrt(cosfac2)
3961 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3962 sinfac=dsqrt(sinfac2)
3964 if (it.eq.10) goto 1
3966 C Compute the axes of tghe local cartesian coordinates system; store in
3967 c x_prime, y_prime and z_prime
3974 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3975 C & dc_norm(3,i+nres)
3977 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3978 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3981 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3984 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3985 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3986 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3987 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3988 c & " xy",scalar(x_prime(1),y_prime(1)),
3989 c & " xz",scalar(x_prime(1),z_prime(1)),
3990 c & " yy",scalar(y_prime(1),y_prime(1)),
3991 c & " yz",scalar(y_prime(1),z_prime(1)),
3992 c & " zz",scalar(z_prime(1),z_prime(1))
3994 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3995 C to local coordinate system. Store in xx, yy, zz.
4001 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4002 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4003 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4010 C Compute the energy of the ith side cbain
4012 c write (2,*) "xx",xx," yy",yy," zz",zz
4015 x(j) = sc_parmin(j,it)
4018 Cc diagnostics - remove later
4020 yy1 = dsin(alph(2))*dcos(omeg(2))
4021 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4022 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4023 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4025 C," --- ", xx_w,yy_w,zz_w
4028 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4029 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4031 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4032 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4034 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4035 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4036 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4037 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4038 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4040 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4041 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4042 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4043 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4044 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4046 dsc_i = 0.743d0+x(61)
4048 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4049 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4050 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4051 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4052 s1=(1+x(63))/(0.1d0 + dscp1)
4053 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4054 s2=(1+x(65))/(0.1d0 + dscp2)
4055 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4056 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4057 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4058 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4060 c & dscp1,dscp2,sumene
4061 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4062 escloc = escloc + sumene
4063 c write (2,*) "escloc",escloc
4064 if (.not. calc_grad) goto 1
4068 C This section to check the numerical derivatives of the energy of ith side
4069 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4070 C #define DEBUG in the code to turn it on.
4072 write (2,*) "sumene =",sumene
4076 write (2,*) xx,yy,zz
4077 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4078 de_dxx_num=(sumenep-sumene)/aincr
4080 write (2,*) "xx+ sumene from enesc=",sumenep
4083 write (2,*) xx,yy,zz
4084 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4085 de_dyy_num=(sumenep-sumene)/aincr
4087 write (2,*) "yy+ sumene from enesc=",sumenep
4090 write (2,*) xx,yy,zz
4091 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4092 de_dzz_num=(sumenep-sumene)/aincr
4094 write (2,*) "zz+ sumene from enesc=",sumenep
4095 costsave=cost2tab(i+1)
4096 sintsave=sint2tab(i+1)
4097 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4098 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4099 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4100 de_dt_num=(sumenep-sumene)/aincr
4101 write (2,*) " t+ sumene from enesc=",sumenep
4102 cost2tab(i+1)=costsave
4103 sint2tab(i+1)=sintsave
4104 C End of diagnostics section.
4107 C Compute the gradient of esc
4109 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4110 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4111 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4112 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4113 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4114 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4115 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4116 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4117 pom1=(sumene3*sint2tab(i+1)+sumene1)
4118 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4119 pom2=(sumene4*cost2tab(i+1)+sumene2)
4120 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4121 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4122 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4123 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4125 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4126 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4127 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4129 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4130 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4131 & +(pom1+pom2)*pom_dx
4133 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4136 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4137 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4138 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4140 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4141 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4142 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4143 & +x(59)*zz**2 +x(60)*xx*zz
4144 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4145 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4146 & +(pom1-pom2)*pom_dy
4148 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4151 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4152 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4153 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4154 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4155 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4156 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4157 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4158 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4160 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4163 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4164 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4165 & +pom1*pom_dt1+pom2*pom_dt2
4167 write(2,*), "de_dt = ", de_dt,de_dt_num
4171 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4172 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4173 cosfac2xx=cosfac2*xx
4174 sinfac2yy=sinfac2*yy
4176 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4178 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4180 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4181 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4182 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4183 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4184 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4185 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4186 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4187 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4188 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4189 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4193 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4194 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4195 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4196 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4200 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4201 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4202 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4204 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4205 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4209 dXX_Ctab(k,i)=dXX_Ci(k)
4210 dXX_C1tab(k,i)=dXX_Ci1(k)
4211 dYY_Ctab(k,i)=dYY_Ci(k)
4212 dYY_C1tab(k,i)=dYY_Ci1(k)
4213 dZZ_Ctab(k,i)=dZZ_Ci(k)
4214 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4215 dXX_XYZtab(k,i)=dXX_XYZ(k)
4216 dYY_XYZtab(k,i)=dYY_XYZ(k)
4217 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4221 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4222 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4223 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4224 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4225 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4227 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4228 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4229 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4230 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4231 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4232 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4233 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4234 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4236 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4237 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4239 C to check gradient call subroutine check_grad
4246 c------------------------------------------------------------------------------
4247 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4249 C This procedure calculates two-body contact function g(rij) and its derivative:
4252 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4255 C where x=(rij-r0ij)/delta
4257 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4260 double precision rij,r0ij,eps0ij,fcont,fprimcont
4261 double precision x,x2,x4,delta
4265 if (x.lt.-1.0D0) then
4268 else if (x.le.1.0D0) then
4271 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4272 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4279 c------------------------------------------------------------------------------
4280 subroutine splinthet(theti,delta,ss,ssder)
4281 implicit real*8 (a-h,o-z)
4282 include 'DIMENSIONS'
4283 include 'DIMENSIONS.ZSCOPT'
4284 include 'COMMON.VAR'
4285 include 'COMMON.GEO'
4288 if (theti.gt.pipol) then
4289 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4291 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4296 c------------------------------------------------------------------------------
4297 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4299 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4300 double precision ksi,ksi2,ksi3,a1,a2,a3
4301 a1=fprim0*delta/(f1-f0)
4307 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4308 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4311 c------------------------------------------------------------------------------
4312 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4314 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4315 double precision ksi,ksi2,ksi3,a1,a2,a3
4320 a2=3*(f1x-f0x)-2*fprim0x*delta
4321 a3=fprim0x*delta-2*(f1x-f0x)
4322 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4325 C-----------------------------------------------------------------------------
4327 C-----------------------------------------------------------------------------
4328 subroutine etor(etors,edihcnstr,fact)
4329 implicit real*8 (a-h,o-z)
4330 include 'DIMENSIONS'
4331 include 'DIMENSIONS.ZSCOPT'
4332 include 'COMMON.VAR'
4333 include 'COMMON.GEO'
4334 include 'COMMON.LOCAL'
4335 include 'COMMON.TORSION'
4336 include 'COMMON.INTERACT'
4337 include 'COMMON.DERIV'
4338 include 'COMMON.CHAIN'
4339 include 'COMMON.NAMES'
4340 include 'COMMON.IOUNITS'
4341 include 'COMMON.FFIELD'
4342 include 'COMMON.TORCNSTR'
4344 C Set lprn=.true. for debugging
4348 do i=iphi_start,iphi_end
4349 itori=itortyp(itype(i-2))
4350 itori1=itortyp(itype(i-1))
4353 C Proline-Proline pair is a special case...
4354 if (itori.eq.3 .and. itori1.eq.3) then
4355 if (phii.gt.-dwapi3) then
4357 fac=1.0D0/(1.0D0-cosphi)
4358 etorsi=v1(1,3,3)*fac
4359 etorsi=etorsi+etorsi
4360 etors=etors+etorsi-v1(1,3,3)
4361 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4364 v1ij=v1(j+1,itori,itori1)
4365 v2ij=v2(j+1,itori,itori1)
4368 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4369 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4373 v1ij=v1(j,itori,itori1)
4374 v2ij=v2(j,itori,itori1)
4377 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4378 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4382 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4383 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4384 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4385 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4386 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4388 ! 6/20/98 - dihedral angle constraints
4391 itori=idih_constr(i)
4394 if (difi.gt.drange(i)) then
4396 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4397 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4398 else if (difi.lt.-drange(i)) then
4400 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4401 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4403 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4404 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4406 ! write (iout,*) 'edihcnstr',edihcnstr
4409 c------------------------------------------------------------------------------
4411 subroutine etor(etors,edihcnstr,fact)
4412 implicit real*8 (a-h,o-z)
4413 include 'DIMENSIONS'
4414 include 'DIMENSIONS.ZSCOPT'
4415 include 'COMMON.VAR'
4416 include 'COMMON.GEO'
4417 include 'COMMON.LOCAL'
4418 include 'COMMON.TORSION'
4419 include 'COMMON.INTERACT'
4420 include 'COMMON.DERIV'
4421 include 'COMMON.CHAIN'
4422 include 'COMMON.NAMES'
4423 include 'COMMON.IOUNITS'
4424 include 'COMMON.FFIELD'
4425 include 'COMMON.TORCNSTR'
4427 C Set lprn=.true. for debugging
4431 do i=iphi_start,iphi_end
4432 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4433 if (iabs(itype(i)).eq.20) then
4438 itori=itortyp(itype(i-2))
4439 itori1=itortyp(itype(i-1))
4442 C Regular cosine and sine terms
4443 do j=1,nterm(itori,itori1,iblock)
4444 v1ij=v1(j,itori,itori1,iblock)
4445 v2ij=v2(j,itori,itori1,iblock)
4448 etors=etors+v1ij*cosphi+v2ij*sinphi
4449 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4453 C E = SUM ----------------------------------- - v1
4454 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4456 cosphi=dcos(0.5d0*phii)
4457 sinphi=dsin(0.5d0*phii)
4458 do j=1,nlor(itori,itori1,iblock)
4459 vl1ij=vlor1(j,itori,itori1)
4460 vl2ij=vlor2(j,itori,itori1)
4461 vl3ij=vlor3(j,itori,itori1)
4462 pom=vl2ij*cosphi+vl3ij*sinphi
4463 pom1=1.0d0/(pom*pom+1.0d0)
4464 etors=etors+vl1ij*pom1
4466 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4468 C Subtract the constant term
4469 etors=etors-v0(itori,itori1,iblock)
4471 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4472 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4473 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4474 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4475 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4478 ! 6/20/98 - dihedral angle constraints
4481 itori=idih_constr(i)
4483 difi=pinorm(phii-phi0(i))
4485 if (difi.gt.drange(i)) then
4487 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4488 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4489 edihi=0.25d0*ftors*difi**4
4490 else if (difi.lt.-drange(i)) then
4492 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4493 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4494 edihi=0.25d0*ftors*difi**4
4498 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4500 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4501 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4503 ! write (iout,*) 'edihcnstr',edihcnstr
4506 c----------------------------------------------------------------------------
4507 subroutine etor_d(etors_d,fact2)
4508 C 6/23/01 Compute double torsional energy
4509 implicit real*8 (a-h,o-z)
4510 include 'DIMENSIONS'
4511 include 'DIMENSIONS.ZSCOPT'
4512 include 'COMMON.VAR'
4513 include 'COMMON.GEO'
4514 include 'COMMON.LOCAL'
4515 include 'COMMON.TORSION'
4516 include 'COMMON.INTERACT'
4517 include 'COMMON.DERIV'
4518 include 'COMMON.CHAIN'
4519 include 'COMMON.NAMES'
4520 include 'COMMON.IOUNITS'
4521 include 'COMMON.FFIELD'
4522 include 'COMMON.TORCNSTR'
4524 C Set lprn=.true. for debugging
4528 do i=iphi_start,iphi_end-1
4529 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4531 itori=itortyp(itype(i-2))
4532 itori1=itortyp(itype(i-1))
4533 itori2=itortyp(itype(i))
4539 if (iabs(itype(i+1)).eq.20) iblock=2
4540 C Regular cosine and sine terms
4541 c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
4542 c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4543 c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4544 c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4545 c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4546 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4547 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4548 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4549 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4550 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4552 cosphi1=dcos(j*phii)
4553 sinphi1=dsin(j*phii)
4554 cosphi2=dcos(j*phii1)
4555 sinphi2=dsin(j*phii1)
4556 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4557 & v2cij*cosphi2+v2sij*sinphi2
4558 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4559 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4561 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4563 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4564 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4565 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4566 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4567 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4568 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4569 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4570 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4571 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4572 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4573 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4574 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4575 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4576 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4579 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4580 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4586 c------------------------------------------------------------------------------
4587 subroutine eback_sc_corr(esccor)
4588 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4589 c conformational states; temporarily implemented as differences
4590 c between UNRES torsional potentials (dependent on three types of
4591 c residues) and the torsional potentials dependent on all 20 types
4592 c of residues computed from AM1 energy surfaces of terminally-blocked
4593 c amino-acid residues.
4594 implicit real*8 (a-h,o-z)
4595 include 'DIMENSIONS'
4596 include 'DIMENSIONS.ZSCOPT'
4597 include 'COMMON.VAR'
4598 include 'COMMON.GEO'
4599 include 'COMMON.LOCAL'
4600 include 'COMMON.TORSION'
4601 include 'COMMON.SCCOR'
4602 include 'COMMON.INTERACT'
4603 include 'COMMON.DERIV'
4604 include 'COMMON.CHAIN'
4605 include 'COMMON.NAMES'
4606 include 'COMMON.IOUNITS'
4607 include 'COMMON.FFIELD'
4608 include 'COMMON.CONTROL'
4610 C Set lprn=.true. for debugging
4613 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4615 do i=itau_start,itau_end
4617 isccori=isccortyp((itype(i-2)))
4618 isccori1=isccortyp((itype(i-1)))
4620 cccc Added 9 May 2012
4621 cc Tauangle is torsional engle depending on the value of first digit
4622 c(see comment below)
4623 cc Omicron is flat angle depending on the value of first digit
4624 c(see comment below)
4627 do intertyp=1,3 !intertyp
4628 cc Added 09 May 2012 (Adasko)
4629 cc Intertyp means interaction type of backbone mainchain correlation:
4630 c 1 = SC...Ca...Ca...Ca
4631 c 2 = Ca...Ca...Ca...SC
4632 c 3 = SC...Ca...Ca...SCi
4634 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4635 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4636 & (itype(i-1).eq.ntyp1)))
4637 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4638 & .or.(itype(i-2).eq.ntyp1)))
4639 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4640 & (itype(i-1).eq.ntyp1)))) cycle
4641 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4642 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4644 do j=1,nterm_sccor(isccori,isccori1)
4645 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4646 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4647 cosphi=dcos(j*tauangle(intertyp,i))
4648 sinphi=dsin(j*tauangle(intertyp,i))
4649 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4650 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4652 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4653 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4654 c &gloc_sc(intertyp,i-3,icg)
4656 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4657 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4658 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4659 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4660 c gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4664 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4668 c------------------------------------------------------------------------------
4669 subroutine multibody(ecorr)
4670 C This subroutine calculates multi-body contributions to energy following
4671 C the idea of Skolnick et al. If side chains I and J make a contact and
4672 C at the same time side chains I+1 and J+1 make a contact, an extra
4673 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4674 implicit real*8 (a-h,o-z)
4675 include 'DIMENSIONS'
4676 include 'COMMON.IOUNITS'
4677 include 'COMMON.DERIV'
4678 include 'COMMON.INTERACT'
4679 include 'COMMON.CONTACTS'
4680 double precision gx(3),gx1(3)
4683 C Set lprn=.true. for debugging
4687 write (iout,'(a)') 'Contact function values:'
4689 write (iout,'(i2,20(1x,i2,f10.5))')
4690 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4705 num_conti=num_cont(i)
4706 num_conti1=num_cont(i1)
4711 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4712 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4713 cd & ' ishift=',ishift
4714 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4715 C The system gains extra energy.
4716 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4717 endif ! j1==j+-ishift
4726 c------------------------------------------------------------------------------
4727 double precision function esccorr(i,j,k,l,jj,kk)
4728 implicit real*8 (a-h,o-z)
4729 include 'DIMENSIONS'
4730 include 'COMMON.IOUNITS'
4731 include 'COMMON.DERIV'
4732 include 'COMMON.INTERACT'
4733 include 'COMMON.CONTACTS'
4734 double precision gx(3),gx1(3)
4739 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4740 C Calculate the multi-body contribution to energy.
4741 C Calculate multi-body contributions to the gradient.
4742 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4743 cd & k,l,(gacont(m,kk,k),m=1,3)
4745 gx(m) =ekl*gacont(m,jj,i)
4746 gx1(m)=eij*gacont(m,kk,k)
4747 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4748 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4749 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4750 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4754 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4759 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4765 c------------------------------------------------------------------------------
4767 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4768 implicit real*8 (a-h,o-z)
4769 include 'DIMENSIONS'
4770 integer dimen1,dimen2,atom,indx
4771 double precision buffer(dimen1,dimen2)
4772 double precision zapas
4773 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4774 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4775 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4776 num_kont=num_cont_hb(atom)
4780 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4783 buffer(i,indx+22)=facont_hb(i,atom)
4784 buffer(i,indx+23)=ees0p(i,atom)
4785 buffer(i,indx+24)=ees0m(i,atom)
4786 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4788 buffer(1,indx+26)=dfloat(num_kont)
4791 c------------------------------------------------------------------------------
4792 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4793 implicit real*8 (a-h,o-z)
4794 include 'DIMENSIONS'
4795 integer dimen1,dimen2,atom,indx
4796 double precision buffer(dimen1,dimen2)
4797 double precision zapas
4798 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4799 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4800 & ees0m(ntyp,maxres),
4801 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4802 num_kont=buffer(1,indx+26)
4803 num_kont_old=num_cont_hb(atom)
4804 num_cont_hb(atom)=num_kont+num_kont_old
4809 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4812 facont_hb(ii,atom)=buffer(i,indx+22)
4813 ees0p(ii,atom)=buffer(i,indx+23)
4814 ees0m(ii,atom)=buffer(i,indx+24)
4815 jcont_hb(ii,atom)=buffer(i,indx+25)
4819 c------------------------------------------------------------------------------
4821 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4822 C This subroutine calculates multi-body contributions to hydrogen-bonding
4823 implicit real*8 (a-h,o-z)
4824 include 'DIMENSIONS'
4825 include 'DIMENSIONS.ZSCOPT'
4826 include 'COMMON.IOUNITS'
4828 include 'COMMON.INFO'
4830 include 'COMMON.FFIELD'
4831 include 'COMMON.DERIV'
4832 include 'COMMON.INTERACT'
4833 include 'COMMON.CONTACTS'
4835 parameter (max_cont=maxconts)
4836 parameter (max_dim=2*(8*3+2))
4837 parameter (msglen1=max_cont*max_dim*4)
4838 parameter (msglen2=2*msglen1)
4839 integer source,CorrelType,CorrelID,Error
4840 double precision buffer(max_cont,max_dim)
4842 double precision gx(3),gx1(3)
4845 C Set lprn=.true. for debugging
4850 if (fgProcs.le.1) goto 30
4852 write (iout,'(a)') 'Contact function values:'
4854 write (iout,'(2i3,50(1x,i2,f5.2))')
4855 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4856 & j=1,num_cont_hb(i))
4859 C Caution! Following code assumes that electrostatic interactions concerning
4860 C a given atom are split among at most two processors!
4870 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4873 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4874 if (MyRank.gt.0) then
4875 C Send correlation contributions to the preceding processor
4877 nn=num_cont_hb(iatel_s)
4878 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4879 cd write (iout,*) 'The BUFFER array:'
4881 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4883 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4885 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4886 C Clear the contacts of the atom passed to the neighboring processor
4887 nn=num_cont_hb(iatel_s+1)
4889 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4891 num_cont_hb(iatel_s)=0
4893 cd write (iout,*) 'Processor ',MyID,MyRank,
4894 cd & ' is sending correlation contribution to processor',MyID-1,
4895 cd & ' msglen=',msglen
4896 cd write (*,*) 'Processor ',MyID,MyRank,
4897 cd & ' is sending correlation contribution to processor',MyID-1,
4898 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4899 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4900 cd write (iout,*) 'Processor ',MyID,
4901 cd & ' has sent correlation contribution to processor',MyID-1,
4902 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4903 cd write (*,*) 'Processor ',MyID,
4904 cd & ' has sent correlation contribution to processor',MyID-1,
4905 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4907 endif ! (MyRank.gt.0)
4911 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4912 if (MyRank.lt.fgProcs-1) then
4913 C Receive correlation contributions from the next processor
4915 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4916 cd write (iout,*) 'Processor',MyID,
4917 cd & ' is receiving correlation contribution from processor',MyID+1,
4918 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4919 cd write (*,*) 'Processor',MyID,
4920 cd & ' is receiving correlation contribution from processor',MyID+1,
4921 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4923 do while (nbytes.le.0)
4924 call mp_probe(MyID+1,CorrelType,nbytes)
4926 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4927 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4928 cd write (iout,*) 'Processor',MyID,
4929 cd & ' has received correlation contribution from processor',MyID+1,
4930 cd & ' msglen=',msglen,' nbytes=',nbytes
4931 cd write (iout,*) 'The received BUFFER array:'
4933 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4935 if (msglen.eq.msglen1) then
4936 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4937 else if (msglen.eq.msglen2) then
4938 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4939 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4942 & 'ERROR!!!! message length changed while processing correlations.'
4944 & 'ERROR!!!! message length changed while processing correlations.'
4945 call mp_stopall(Error)
4946 endif ! msglen.eq.msglen1
4947 endif ! MyRank.lt.fgProcs-1
4954 write (iout,'(a)') 'Contact function values:'
4956 write (iout,'(2i3,50(1x,i2,f5.2))')
4957 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4958 & j=1,num_cont_hb(i))
4962 C Remove the loop below after debugging !!!
4969 C Calculate the local-electrostatic correlation terms
4970 do i=iatel_s,iatel_e+1
4972 num_conti=num_cont_hb(i)
4973 num_conti1=num_cont_hb(i+1)
4978 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4979 c & ' jj=',jj,' kk=',kk
4980 if (j1.eq.j+1 .or. j1.eq.j-1) then
4981 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4982 C The system gains extra energy.
4983 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4985 else if (j1.eq.j) then
4986 C Contacts I-J and I-(J+1) occur simultaneously.
4987 C The system loses extra energy.
4988 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4993 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4994 c & ' jj=',jj,' kk=',kk
4996 C Contacts I-J and (I+1)-J occur simultaneously.
4997 C The system loses extra energy.
4998 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5005 c------------------------------------------------------------------------------
5006 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5008 C This subroutine calculates multi-body contributions to hydrogen-bonding
5009 implicit real*8 (a-h,o-z)
5010 include 'DIMENSIONS'
5011 include 'DIMENSIONS.ZSCOPT'
5012 include 'COMMON.IOUNITS'
5014 include 'COMMON.INFO'
5016 include 'COMMON.FFIELD'
5017 include 'COMMON.DERIV'
5018 include 'COMMON.INTERACT'
5019 include 'COMMON.CONTACTS'
5021 parameter (max_cont=maxconts)
5022 parameter (max_dim=2*(8*3+2))
5023 parameter (msglen1=max_cont*max_dim*4)
5024 parameter (msglen2=2*msglen1)
5025 integer source,CorrelType,CorrelID,Error
5026 double precision buffer(max_cont,max_dim)
5028 double precision gx(3),gx1(3)
5031 C Set lprn=.true. for debugging
5037 if (fgProcs.le.1) goto 30
5039 write (iout,'(a)') 'Contact function values:'
5041 write (iout,'(2i3,50(1x,i2,f5.2))')
5042 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5043 & j=1,num_cont_hb(i))
5046 C Caution! Following code assumes that electrostatic interactions concerning
5047 C a given atom are split among at most two processors!
5057 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5060 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5061 if (MyRank.gt.0) then
5062 C Send correlation contributions to the preceding processor
5064 nn=num_cont_hb(iatel_s)
5065 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5066 cd write (iout,*) 'The BUFFER array:'
5068 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5070 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5072 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5073 C Clear the contacts of the atom passed to the neighboring processor
5074 nn=num_cont_hb(iatel_s+1)
5076 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5078 num_cont_hb(iatel_s)=0
5080 cd write (iout,*) 'Processor ',MyID,MyRank,
5081 cd & ' is sending correlation contribution to processor',MyID-1,
5082 cd & ' msglen=',msglen
5083 cd write (*,*) 'Processor ',MyID,MyRank,
5084 cd & ' is sending correlation contribution to processor',MyID-1,
5085 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5086 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5087 cd write (iout,*) 'Processor ',MyID,
5088 cd & ' has sent correlation contribution to processor',MyID-1,
5089 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5090 cd write (*,*) 'Processor ',MyID,
5091 cd & ' has sent correlation contribution to processor',MyID-1,
5092 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5094 endif ! (MyRank.gt.0)
5098 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5099 if (MyRank.lt.fgProcs-1) then
5100 C Receive correlation contributions from the next processor
5102 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5103 cd write (iout,*) 'Processor',MyID,
5104 cd & ' is receiving correlation contribution from processor',MyID+1,
5105 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5106 cd write (*,*) 'Processor',MyID,
5107 cd & ' is receiving correlation contribution from processor',MyID+1,
5108 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5110 do while (nbytes.le.0)
5111 call mp_probe(MyID+1,CorrelType,nbytes)
5113 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5114 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5115 cd write (iout,*) 'Processor',MyID,
5116 cd & ' has received correlation contribution from processor',MyID+1,
5117 cd & ' msglen=',msglen,' nbytes=',nbytes
5118 cd write (iout,*) 'The received BUFFER array:'
5120 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5122 if (msglen.eq.msglen1) then
5123 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5124 else if (msglen.eq.msglen2) then
5125 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5126 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5129 & 'ERROR!!!! message length changed while processing correlations.'
5131 & 'ERROR!!!! message length changed while processing correlations.'
5132 call mp_stopall(Error)
5133 endif ! msglen.eq.msglen1
5134 endif ! MyRank.lt.fgProcs-1
5141 write (iout,'(a)') 'Contact function values:'
5143 write (iout,'(2i3,50(1x,i2,f5.2))')
5144 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5145 & j=1,num_cont_hb(i))
5151 C Remove the loop below after debugging !!!
5158 C Calculate the dipole-dipole interaction energies
5159 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5160 do i=iatel_s,iatel_e+1
5161 num_conti=num_cont_hb(i)
5168 C Calculate the local-electrostatic correlation terms
5169 do i=iatel_s,iatel_e+1
5171 num_conti=num_cont_hb(i)
5172 num_conti1=num_cont_hb(i+1)
5177 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5178 c & ' jj=',jj,' kk=',kk
5179 if (j1.eq.j+1 .or. j1.eq.j-1) then
5180 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5181 C The system gains extra energy.
5183 sqd1=dsqrt(d_cont(jj,i))
5184 sqd2=dsqrt(d_cont(kk,i1))
5185 sred_geom = sqd1*sqd2
5186 IF (sred_geom.lt.cutoff_corr) THEN
5187 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5189 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5190 c & ' jj=',jj,' kk=',kk
5191 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5192 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5194 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5195 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5198 cd write (iout,*) 'sred_geom=',sred_geom,
5199 cd & ' ekont=',ekont,' fprim=',fprimcont
5200 call calc_eello(i,j,i+1,j1,jj,kk)
5201 if (wcorr4.gt.0.0d0)
5202 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5203 if (wcorr5.gt.0.0d0)
5204 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5205 c print *,"wcorr5",ecorr5
5206 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5207 cd write(2,*)'ijkl',i,j,i+1,j1
5208 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5209 & .or. wturn6.eq.0.0d0))then
5210 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5211 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5212 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5213 cd & 'ecorr6=',ecorr6
5214 cd write (iout,'(4e15.5)') sred_geom,
5215 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5216 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5217 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5218 else if (wturn6.gt.0.0d0
5219 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5220 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5221 eturn6=eturn6+eello_turn6(i,jj,kk)
5222 cd write (2,*) 'multibody_eello:eturn6',eturn6
5226 else if (j1.eq.j) then
5227 C Contacts I-J and I-(J+1) occur simultaneously.
5228 C The system loses extra energy.
5229 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5234 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5235 c & ' jj=',jj,' kk=',kk
5237 C Contacts I-J and (I+1)-J occur simultaneously.
5238 C The system loses extra energy.
5239 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5246 c------------------------------------------------------------------------------
5247 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5248 implicit real*8 (a-h,o-z)
5249 include 'DIMENSIONS'
5250 include 'COMMON.IOUNITS'
5251 include 'COMMON.DERIV'
5252 include 'COMMON.INTERACT'
5253 include 'COMMON.CONTACTS'
5254 double precision gx(3),gx1(3)
5264 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5265 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5266 C Following 4 lines for diagnostics.
5271 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5273 c write (iout,*)'Contacts have occurred for peptide groups',
5274 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5275 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5276 C Calculate the multi-body contribution to energy.
5277 ecorr=ecorr+ekont*ees
5279 C Calculate multi-body contributions to the gradient.
5281 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5282 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5283 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5284 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5285 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5286 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5287 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5288 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5289 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5290 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5291 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5292 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5293 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5294 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5298 gradcorr(ll,m)=gradcorr(ll,m)+
5299 & ees*ekl*gacont_hbr(ll,jj,i)-
5300 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5301 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5306 gradcorr(ll,m)=gradcorr(ll,m)+
5307 & ees*eij*gacont_hbr(ll,kk,k)-
5308 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5309 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5316 C---------------------------------------------------------------------------
5317 subroutine dipole(i,j,jj)
5318 implicit real*8 (a-h,o-z)
5319 include 'DIMENSIONS'
5320 include 'DIMENSIONS.ZSCOPT'
5321 include 'COMMON.IOUNITS'
5322 include 'COMMON.CHAIN'
5323 include 'COMMON.FFIELD'
5324 include 'COMMON.DERIV'
5325 include 'COMMON.INTERACT'
5326 include 'COMMON.CONTACTS'
5327 include 'COMMON.TORSION'
5328 include 'COMMON.VAR'
5329 include 'COMMON.GEO'
5330 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5332 iti1 = itortyp(itype(i+1))
5333 if (j.lt.nres-1) then
5334 itj1 = itortyp(itype(j+1))
5339 dipi(iii,1)=Ub2(iii,i)
5340 dipderi(iii)=Ub2der(iii,i)
5341 dipi(iii,2)=b1(iii,iti1)
5342 dipj(iii,1)=Ub2(iii,j)
5343 dipderj(iii)=Ub2der(iii,j)
5344 dipj(iii,2)=b1(iii,itj1)
5348 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5351 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5354 if (.not.calc_grad) return
5359 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5363 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5368 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5369 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5371 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5373 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5375 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5379 C---------------------------------------------------------------------------
5380 subroutine calc_eello(i,j,k,l,jj,kk)
5382 C This subroutine computes matrices and vectors needed to calculate
5383 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5385 implicit real*8 (a-h,o-z)
5386 include 'DIMENSIONS'
5387 include 'DIMENSIONS.ZSCOPT'
5388 include 'COMMON.IOUNITS'
5389 include 'COMMON.CHAIN'
5390 include 'COMMON.DERIV'
5391 include 'COMMON.INTERACT'
5392 include 'COMMON.CONTACTS'
5393 include 'COMMON.TORSION'
5394 include 'COMMON.VAR'
5395 include 'COMMON.GEO'
5396 include 'COMMON.FFIELD'
5397 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5398 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5401 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5402 cd & ' jj=',jj,' kk=',kk
5403 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5406 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5407 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5410 call transpose2(aa1(1,1),aa1t(1,1))
5411 call transpose2(aa2(1,1),aa2t(1,1))
5414 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5415 & aa1tder(1,1,lll,kkk))
5416 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5417 & aa2tder(1,1,lll,kkk))
5421 C parallel orientation of the two CA-CA-CA frames.
5423 iti=itortyp(itype(i))
5427 itk1=itortyp(itype(k+1))
5428 itj=itortyp(itype(j))
5429 if (l.lt.nres-1) then
5430 itl1=itortyp(itype(l+1))
5434 C A1 kernel(j+1) A2T
5436 cd write (iout,'(3f10.5,5x,3f10.5)')
5437 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5439 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5440 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5441 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5442 C Following matrices are needed only for 6-th order cumulants
5443 IF (wcorr6.gt.0.0d0) THEN
5444 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5445 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5446 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5447 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5448 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5449 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5450 & ADtEAderx(1,1,1,1,1,1))
5452 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5453 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5454 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5455 & ADtEA1derx(1,1,1,1,1,1))
5457 C End 6-th order cumulants
5460 cd write (2,*) 'In calc_eello6'
5462 cd write (2,*) 'iii=',iii
5464 cd write (2,*) 'kkk=',kkk
5466 cd write (2,'(3(2f10.5),5x)')
5467 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5472 call transpose2(EUgder(1,1,k),auxmat(1,1))
5473 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5474 call transpose2(EUg(1,1,k),auxmat(1,1))
5475 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5476 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5480 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5481 & EAEAderx(1,1,lll,kkk,iii,1))
5485 C A1T kernel(i+1) A2
5486 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5487 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5488 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5489 C Following matrices are needed only for 6-th order cumulants
5490 IF (wcorr6.gt.0.0d0) THEN
5491 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5492 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5493 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5494 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5495 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5496 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5497 & ADtEAderx(1,1,1,1,1,2))
5498 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5499 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5500 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5501 & ADtEA1derx(1,1,1,1,1,2))
5503 C End 6-th order cumulants
5504 call transpose2(EUgder(1,1,l),auxmat(1,1))
5505 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5506 call transpose2(EUg(1,1,l),auxmat(1,1))
5507 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5508 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5512 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5513 & EAEAderx(1,1,lll,kkk,iii,2))
5518 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5519 C They are needed only when the fifth- or the sixth-order cumulants are
5521 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5522 call transpose2(AEA(1,1,1),auxmat(1,1))
5523 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5524 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5525 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5526 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5527 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5528 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5529 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5530 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5531 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5532 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5533 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5534 call transpose2(AEA(1,1,2),auxmat(1,1))
5535 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5536 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5537 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5538 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5539 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5540 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5541 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5542 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5543 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5544 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5545 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5546 C Calculate the Cartesian derivatives of the vectors.
5550 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5551 call matvec2(auxmat(1,1),b1(1,iti),
5552 & AEAb1derx(1,lll,kkk,iii,1,1))
5553 call matvec2(auxmat(1,1),Ub2(1,i),
5554 & AEAb2derx(1,lll,kkk,iii,1,1))
5555 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5556 & AEAb1derx(1,lll,kkk,iii,2,1))
5557 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5558 & AEAb2derx(1,lll,kkk,iii,2,1))
5559 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5560 call matvec2(auxmat(1,1),b1(1,itj),
5561 & AEAb1derx(1,lll,kkk,iii,1,2))
5562 call matvec2(auxmat(1,1),Ub2(1,j),
5563 & AEAb2derx(1,lll,kkk,iii,1,2))
5564 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5565 & AEAb1derx(1,lll,kkk,iii,2,2))
5566 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5567 & AEAb2derx(1,lll,kkk,iii,2,2))
5574 C Antiparallel orientation of the two CA-CA-CA frames.
5576 iti=itortyp(itype(i))
5580 itk1=itortyp(itype(k+1))
5581 itl=itortyp(itype(l))
5582 itj=itortyp(itype(j))
5583 if (j.lt.nres-1) then
5584 itj1=itortyp(itype(j+1))
5588 C A2 kernel(j-1)T A1T
5589 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5590 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5591 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5592 C Following matrices are needed only for 6-th order cumulants
5593 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5594 & j.eq.i+4 .and. l.eq.i+3)) THEN
5595 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5596 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5597 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5598 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5599 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5600 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5601 & ADtEAderx(1,1,1,1,1,1))
5602 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5603 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5604 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5605 & ADtEA1derx(1,1,1,1,1,1))
5607 C End 6-th order cumulants
5608 call transpose2(EUgder(1,1,k),auxmat(1,1))
5609 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5610 call transpose2(EUg(1,1,k),auxmat(1,1))
5611 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5612 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5616 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5617 & EAEAderx(1,1,lll,kkk,iii,1))
5621 C A2T kernel(i+1)T A1
5622 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5623 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5624 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5625 C Following matrices are needed only for 6-th order cumulants
5626 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5627 & j.eq.i+4 .and. l.eq.i+3)) THEN
5628 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5629 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5630 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5631 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5632 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5633 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5634 & ADtEAderx(1,1,1,1,1,2))
5635 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5636 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5637 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5638 & ADtEA1derx(1,1,1,1,1,2))
5640 C End 6-th order cumulants
5641 call transpose2(EUgder(1,1,j),auxmat(1,1))
5642 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5643 call transpose2(EUg(1,1,j),auxmat(1,1))
5644 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5645 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5649 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5650 & EAEAderx(1,1,lll,kkk,iii,2))
5655 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5656 C They are needed only when the fifth- or the sixth-order cumulants are
5658 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5659 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5660 call transpose2(AEA(1,1,1),auxmat(1,1))
5661 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5662 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5663 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5664 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5665 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5666 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5667 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5668 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5669 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5670 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5671 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5672 call transpose2(AEA(1,1,2),auxmat(1,1))
5673 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5674 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5675 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5676 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5677 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5678 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5679 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5680 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5681 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5682 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5683 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5684 C Calculate the Cartesian derivatives of the vectors.
5688 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5689 call matvec2(auxmat(1,1),b1(1,iti),
5690 & AEAb1derx(1,lll,kkk,iii,1,1))
5691 call matvec2(auxmat(1,1),Ub2(1,i),
5692 & AEAb2derx(1,lll,kkk,iii,1,1))
5693 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5694 & AEAb1derx(1,lll,kkk,iii,2,1))
5695 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5696 & AEAb2derx(1,lll,kkk,iii,2,1))
5697 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5698 call matvec2(auxmat(1,1),b1(1,itl),
5699 & AEAb1derx(1,lll,kkk,iii,1,2))
5700 call matvec2(auxmat(1,1),Ub2(1,l),
5701 & AEAb2derx(1,lll,kkk,iii,1,2))
5702 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5703 & AEAb1derx(1,lll,kkk,iii,2,2))
5704 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5705 & AEAb2derx(1,lll,kkk,iii,2,2))
5714 C---------------------------------------------------------------------------
5715 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5716 & KK,KKderg,AKA,AKAderg,AKAderx)
5720 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5721 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5722 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5727 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5729 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5732 cd if (lprn) write (2,*) 'In kernel'
5734 cd if (lprn) write (2,*) 'kkk=',kkk
5736 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5737 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5739 cd write (2,*) 'lll=',lll
5740 cd write (2,*) 'iii=1'
5742 cd write (2,'(3(2f10.5),5x)')
5743 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5746 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5747 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5749 cd write (2,*) 'lll=',lll
5750 cd write (2,*) 'iii=2'
5752 cd write (2,'(3(2f10.5),5x)')
5753 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5760 C---------------------------------------------------------------------------
5761 double precision function eello4(i,j,k,l,jj,kk)
5762 implicit real*8 (a-h,o-z)
5763 include 'DIMENSIONS'
5764 include 'DIMENSIONS.ZSCOPT'
5765 include 'COMMON.IOUNITS'
5766 include 'COMMON.CHAIN'
5767 include 'COMMON.DERIV'
5768 include 'COMMON.INTERACT'
5769 include 'COMMON.CONTACTS'
5770 include 'COMMON.TORSION'
5771 include 'COMMON.VAR'
5772 include 'COMMON.GEO'
5773 double precision pizda(2,2),ggg1(3),ggg2(3)
5774 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5778 cd print *,'eello4:',i,j,k,l,jj,kk
5779 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5780 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5781 cold eij=facont_hb(jj,i)
5782 cold ekl=facont_hb(kk,k)
5784 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5786 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5787 gcorr_loc(k-1)=gcorr_loc(k-1)
5788 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5790 gcorr_loc(l-1)=gcorr_loc(l-1)
5791 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5793 gcorr_loc(j-1)=gcorr_loc(j-1)
5794 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5799 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5800 & -EAEAderx(2,2,lll,kkk,iii,1)
5801 cd derx(lll,kkk,iii)=0.0d0
5805 cd gcorr_loc(l-1)=0.0d0
5806 cd gcorr_loc(j-1)=0.0d0
5807 cd gcorr_loc(k-1)=0.0d0
5809 cd write (iout,*)'Contacts have occurred for peptide groups',
5810 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5811 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5812 if (j.lt.nres-1) then
5819 if (l.lt.nres-1) then
5827 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5828 ggg1(ll)=eel4*g_contij(ll,1)
5829 ggg2(ll)=eel4*g_contij(ll,2)
5830 ghalf=0.5d0*ggg1(ll)
5832 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5833 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5834 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5835 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5836 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5837 ghalf=0.5d0*ggg2(ll)
5839 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5840 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5841 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5842 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5847 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5848 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5853 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5854 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5860 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5865 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5869 cd write (2,*) iii,gcorr_loc(iii)
5873 cd write (2,*) 'ekont',ekont
5874 cd write (iout,*) 'eello4',ekont*eel4
5877 C---------------------------------------------------------------------------
5878 double precision function eello5(i,j,k,l,jj,kk)
5879 implicit real*8 (a-h,o-z)
5880 include 'DIMENSIONS'
5881 include 'DIMENSIONS.ZSCOPT'
5882 include 'COMMON.IOUNITS'
5883 include 'COMMON.CHAIN'
5884 include 'COMMON.DERIV'
5885 include 'COMMON.INTERACT'
5886 include 'COMMON.CONTACTS'
5887 include 'COMMON.TORSION'
5888 include 'COMMON.VAR'
5889 include 'COMMON.GEO'
5890 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5891 double precision ggg1(3),ggg2(3)
5892 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5897 C /l\ / \ \ / \ / \ / C
5898 C / \ / \ \ / \ / \ / C
5899 C j| o |l1 | o | o| o | | o |o C
5900 C \ |/k\| |/ \| / |/ \| |/ \| C
5901 C \i/ \ / \ / / \ / \ C
5903 C (I) (II) (III) (IV) C
5905 C eello5_1 eello5_2 eello5_3 eello5_4 C
5907 C Antiparallel chains C
5910 C /j\ / \ \ / \ / \ / C
5911 C / \ / \ \ / \ / \ / C
5912 C j1| o |l | o | o| o | | o |o C
5913 C \ |/k\| |/ \| / |/ \| |/ \| C
5914 C \i/ \ / \ / / \ / \ C
5916 C (I) (II) (III) (IV) C
5918 C eello5_1 eello5_2 eello5_3 eello5_4 C
5920 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5922 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5923 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5928 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5930 itk=itortyp(itype(k))
5931 itl=itortyp(itype(l))
5932 itj=itortyp(itype(j))
5937 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5938 cd & eel5_3_num,eel5_4_num)
5942 derx(lll,kkk,iii)=0.0d0
5946 cd eij=facont_hb(jj,i)
5947 cd ekl=facont_hb(kk,k)
5949 cd write (iout,*)'Contacts have occurred for peptide groups',
5950 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5952 C Contribution from the graph I.
5953 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5954 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5955 call transpose2(EUg(1,1,k),auxmat(1,1))
5956 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5957 vv(1)=pizda(1,1)-pizda(2,2)
5958 vv(2)=pizda(1,2)+pizda(2,1)
5959 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5960 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5962 C Explicit gradient in virtual-dihedral angles.
5963 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5964 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5965 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5966 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5967 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5968 vv(1)=pizda(1,1)-pizda(2,2)
5969 vv(2)=pizda(1,2)+pizda(2,1)
5970 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5971 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5972 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5973 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5974 vv(1)=pizda(1,1)-pizda(2,2)
5975 vv(2)=pizda(1,2)+pizda(2,1)
5977 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5978 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5979 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5981 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5982 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5983 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5985 C Cartesian gradient
5989 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5991 vv(1)=pizda(1,1)-pizda(2,2)
5992 vv(2)=pizda(1,2)+pizda(2,1)
5993 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5994 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5995 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6002 C Contribution from graph II
6003 call transpose2(EE(1,1,itk),auxmat(1,1))
6004 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6005 vv(1)=pizda(1,1)+pizda(2,2)
6006 vv(2)=pizda(2,1)-pizda(1,2)
6007 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6008 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6010 C Explicit gradient in virtual-dihedral angles.
6011 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6012 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6013 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6014 vv(1)=pizda(1,1)+pizda(2,2)
6015 vv(2)=pizda(2,1)-pizda(1,2)
6017 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6018 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6019 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6021 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6022 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6023 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6025 C Cartesian gradient
6029 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6031 vv(1)=pizda(1,1)+pizda(2,2)
6032 vv(2)=pizda(2,1)-pizda(1,2)
6033 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6034 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6035 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6044 C Parallel orientation
6045 C Contribution from graph III
6046 call transpose2(EUg(1,1,l),auxmat(1,1))
6047 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6048 vv(1)=pizda(1,1)-pizda(2,2)
6049 vv(2)=pizda(1,2)+pizda(2,1)
6050 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6051 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6053 C Explicit gradient in virtual-dihedral angles.
6054 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6055 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6056 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6057 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6058 vv(1)=pizda(1,1)-pizda(2,2)
6059 vv(2)=pizda(1,2)+pizda(2,1)
6060 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6061 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6062 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6063 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6064 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6065 vv(1)=pizda(1,1)-pizda(2,2)
6066 vv(2)=pizda(1,2)+pizda(2,1)
6067 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6068 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6069 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6070 C Cartesian gradient
6074 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6076 vv(1)=pizda(1,1)-pizda(2,2)
6077 vv(2)=pizda(1,2)+pizda(2,1)
6078 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6079 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6086 C Contribution from graph IV
6088 call transpose2(EE(1,1,itl),auxmat(1,1))
6089 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6090 vv(1)=pizda(1,1)+pizda(2,2)
6091 vv(2)=pizda(2,1)-pizda(1,2)
6092 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6093 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6095 C Explicit gradient in virtual-dihedral angles.
6096 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6097 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6098 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6099 vv(1)=pizda(1,1)+pizda(2,2)
6100 vv(2)=pizda(2,1)-pizda(1,2)
6101 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6102 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6103 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6104 C Cartesian gradient
6108 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6110 vv(1)=pizda(1,1)+pizda(2,2)
6111 vv(2)=pizda(2,1)-pizda(1,2)
6112 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6113 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6114 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6120 C Antiparallel orientation
6121 C Contribution from graph III
6123 call transpose2(EUg(1,1,j),auxmat(1,1))
6124 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6125 vv(1)=pizda(1,1)-pizda(2,2)
6126 vv(2)=pizda(1,2)+pizda(2,1)
6127 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6128 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6130 C Explicit gradient in virtual-dihedral angles.
6131 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6132 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6133 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6134 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6135 vv(1)=pizda(1,1)-pizda(2,2)
6136 vv(2)=pizda(1,2)+pizda(2,1)
6137 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6138 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6139 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6140 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6141 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6142 vv(1)=pizda(1,1)-pizda(2,2)
6143 vv(2)=pizda(1,2)+pizda(2,1)
6144 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6145 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6146 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6147 C Cartesian gradient
6151 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6153 vv(1)=pizda(1,1)-pizda(2,2)
6154 vv(2)=pizda(1,2)+pizda(2,1)
6155 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6156 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6157 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6163 C Contribution from graph IV
6165 call transpose2(EE(1,1,itj),auxmat(1,1))
6166 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6167 vv(1)=pizda(1,1)+pizda(2,2)
6168 vv(2)=pizda(2,1)-pizda(1,2)
6169 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6170 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6172 C Explicit gradient in virtual-dihedral angles.
6173 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6174 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6175 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6176 vv(1)=pizda(1,1)+pizda(2,2)
6177 vv(2)=pizda(2,1)-pizda(1,2)
6178 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6179 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6180 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6181 C Cartesian gradient
6185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6187 vv(1)=pizda(1,1)+pizda(2,2)
6188 vv(2)=pizda(2,1)-pizda(1,2)
6189 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6190 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6191 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6198 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6199 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6200 cd write (2,*) 'ijkl',i,j,k,l
6201 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6202 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6204 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6205 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6206 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6207 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6209 if (j.lt.nres-1) then
6216 if (l.lt.nres-1) then
6226 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6228 ggg1(ll)=eel5*g_contij(ll,1)
6229 ggg2(ll)=eel5*g_contij(ll,2)
6230 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6231 ghalf=0.5d0*ggg1(ll)
6233 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6234 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6235 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6236 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6237 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6238 ghalf=0.5d0*ggg2(ll)
6240 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6241 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6242 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6243 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6248 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6249 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6254 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6255 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6261 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6266 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6270 cd write (2,*) iii,g_corr5_loc(iii)
6274 cd write (2,*) 'ekont',ekont
6275 cd write (iout,*) 'eello5',ekont*eel5
6278 c--------------------------------------------------------------------------
6279 double precision function eello6(i,j,k,l,jj,kk)
6280 implicit real*8 (a-h,o-z)
6281 include 'DIMENSIONS'
6282 include 'DIMENSIONS.ZSCOPT'
6283 include 'COMMON.IOUNITS'
6284 include 'COMMON.CHAIN'
6285 include 'COMMON.DERIV'
6286 include 'COMMON.INTERACT'
6287 include 'COMMON.CONTACTS'
6288 include 'COMMON.TORSION'
6289 include 'COMMON.VAR'
6290 include 'COMMON.GEO'
6291 include 'COMMON.FFIELD'
6292 double precision ggg1(3),ggg2(3)
6293 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6298 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6306 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6307 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6311 derx(lll,kkk,iii)=0.0d0
6315 cd eij=facont_hb(jj,i)
6316 cd ekl=facont_hb(kk,k)
6322 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6323 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6324 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6325 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6326 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6327 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6329 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6330 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6331 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6332 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6333 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6334 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6338 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6340 C If turn contributions are considered, they will be handled separately.
6341 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6342 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6343 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6344 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6345 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6346 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6347 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6350 if (j.lt.nres-1) then
6357 if (l.lt.nres-1) then
6365 ggg1(ll)=eel6*g_contij(ll,1)
6366 ggg2(ll)=eel6*g_contij(ll,2)
6367 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6368 ghalf=0.5d0*ggg1(ll)
6370 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6371 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6372 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6373 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6374 ghalf=0.5d0*ggg2(ll)
6375 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6377 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6378 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6379 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6380 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6385 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6386 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6391 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6392 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6398 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6403 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6407 cd write (2,*) iii,g_corr6_loc(iii)
6411 cd write (2,*) 'ekont',ekont
6412 cd write (iout,*) 'eello6',ekont*eel6
6415 c--------------------------------------------------------------------------
6416 double precision function eello6_graph1(i,j,k,l,imat,swap)
6417 implicit real*8 (a-h,o-z)
6418 include 'DIMENSIONS'
6419 include 'DIMENSIONS.ZSCOPT'
6420 include 'COMMON.IOUNITS'
6421 include 'COMMON.CHAIN'
6422 include 'COMMON.DERIV'
6423 include 'COMMON.INTERACT'
6424 include 'COMMON.CONTACTS'
6425 include 'COMMON.TORSION'
6426 include 'COMMON.VAR'
6427 include 'COMMON.GEO'
6428 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6434 C Parallel Antiparallel C
6440 C \ j|/k\| / \ |/k\|l / C
6445 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6446 itk=itortyp(itype(k))
6447 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6448 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6449 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6450 call transpose2(EUgC(1,1,k),auxmat(1,1))
6451 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6452 vv1(1)=pizda1(1,1)-pizda1(2,2)
6453 vv1(2)=pizda1(1,2)+pizda1(2,1)
6454 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6455 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6456 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6457 s5=scalar2(vv(1),Dtobr2(1,i))
6458 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6459 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6460 if (.not. calc_grad) return
6461 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6462 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6463 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6464 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6465 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6466 & +scalar2(vv(1),Dtobr2der(1,i)))
6467 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6468 vv1(1)=pizda1(1,1)-pizda1(2,2)
6469 vv1(2)=pizda1(1,2)+pizda1(2,1)
6470 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6471 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6473 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6474 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6475 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6476 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6477 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6479 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6480 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6481 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6482 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6483 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6485 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6486 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6487 vv1(1)=pizda1(1,1)-pizda1(2,2)
6488 vv1(2)=pizda1(1,2)+pizda1(2,1)
6489 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6490 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6491 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6492 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6501 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6502 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6503 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6504 call transpose2(EUgC(1,1,k),auxmat(1,1))
6505 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6507 vv1(1)=pizda1(1,1)-pizda1(2,2)
6508 vv1(2)=pizda1(1,2)+pizda1(2,1)
6509 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6510 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6511 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6512 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6513 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6514 s5=scalar2(vv(1),Dtobr2(1,i))
6515 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6521 c----------------------------------------------------------------------------
6522 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6523 implicit real*8 (a-h,o-z)
6524 include 'DIMENSIONS'
6525 include 'DIMENSIONS.ZSCOPT'
6526 include 'COMMON.IOUNITS'
6527 include 'COMMON.CHAIN'
6528 include 'COMMON.DERIV'
6529 include 'COMMON.INTERACT'
6530 include 'COMMON.CONTACTS'
6531 include 'COMMON.TORSION'
6532 include 'COMMON.VAR'
6533 include 'COMMON.GEO'
6535 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6536 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6539 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6541 C Parallel Antiparallel C
6547 C \ j|/k\| \ |/k\|l C
6552 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6553 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6554 C AL 7/4/01 s1 would occur in the sixth-order moment,
6555 C but not in a cluster cumulant
6557 s1=dip(1,jj,i)*dip(1,kk,k)
6559 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6560 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6561 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6562 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6563 call transpose2(EUg(1,1,k),auxmat(1,1))
6564 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6565 vv(1)=pizda(1,1)-pizda(2,2)
6566 vv(2)=pizda(1,2)+pizda(2,1)
6567 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6568 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6570 eello6_graph2=-(s1+s2+s3+s4)
6572 eello6_graph2=-(s2+s3+s4)
6575 if (.not. calc_grad) return
6576 C Derivatives in gamma(i-1)
6579 s1=dipderg(1,jj,i)*dip(1,kk,k)
6581 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6582 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6583 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6584 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6586 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6588 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6590 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6592 C Derivatives in gamma(k-1)
6594 s1=dip(1,jj,i)*dipderg(1,kk,k)
6596 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6597 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6598 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6599 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6600 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6601 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6602 vv(1)=pizda(1,1)-pizda(2,2)
6603 vv(2)=pizda(1,2)+pizda(2,1)
6604 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6606 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6608 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6610 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6611 C Derivatives in gamma(j-1) or gamma(l-1)
6614 s1=dipderg(3,jj,i)*dip(1,kk,k)
6616 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6617 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6618 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6619 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6620 vv(1)=pizda(1,1)-pizda(2,2)
6621 vv(2)=pizda(1,2)+pizda(2,1)
6622 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6625 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6627 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6630 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6631 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6633 C Derivatives in gamma(l-1) or gamma(j-1)
6636 s1=dip(1,jj,i)*dipderg(3,kk,k)
6638 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6639 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6640 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6641 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6642 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6643 vv(1)=pizda(1,1)-pizda(2,2)
6644 vv(2)=pizda(1,2)+pizda(2,1)
6645 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6648 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6650 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6653 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6654 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6656 C Cartesian derivatives.
6658 write (2,*) 'In eello6_graph2'
6660 write (2,*) 'iii=',iii
6662 write (2,*) 'kkk=',kkk
6664 write (2,'(3(2f10.5),5x)')
6665 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6675 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6677 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6680 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6682 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6683 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6685 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6686 call transpose2(EUg(1,1,k),auxmat(1,1))
6687 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6689 vv(1)=pizda(1,1)-pizda(2,2)
6690 vv(2)=pizda(1,2)+pizda(2,1)
6691 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6692 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6694 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6696 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6699 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6701 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6708 c----------------------------------------------------------------------------
6709 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6710 implicit real*8 (a-h,o-z)
6711 include 'DIMENSIONS'
6712 include 'DIMENSIONS.ZSCOPT'
6713 include 'COMMON.IOUNITS'
6714 include 'COMMON.CHAIN'
6715 include 'COMMON.DERIV'
6716 include 'COMMON.INTERACT'
6717 include 'COMMON.CONTACTS'
6718 include 'COMMON.TORSION'
6719 include 'COMMON.VAR'
6720 include 'COMMON.GEO'
6721 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6725 C Parallel Antiparallel C
6731 C j|/k\| / |/k\|l / C
6736 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6738 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6739 C energy moment and not to the cluster cumulant.
6740 iti=itortyp(itype(i))
6741 if (j.lt.nres-1) then
6742 itj1=itortyp(itype(j+1))
6746 itk=itortyp(itype(k))
6747 itk1=itortyp(itype(k+1))
6748 if (l.lt.nres-1) then
6749 itl1=itortyp(itype(l+1))
6754 s1=dip(4,jj,i)*dip(4,kk,k)
6756 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6757 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6758 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6759 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6760 call transpose2(EE(1,1,itk),auxmat(1,1))
6761 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6762 vv(1)=pizda(1,1)+pizda(2,2)
6763 vv(2)=pizda(2,1)-pizda(1,2)
6764 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6765 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6767 eello6_graph3=-(s1+s2+s3+s4)
6769 eello6_graph3=-(s2+s3+s4)
6772 if (.not. calc_grad) return
6773 C Derivatives in gamma(k-1)
6774 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6775 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6776 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6777 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6778 C Derivatives in gamma(l-1)
6779 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6780 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6781 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6782 vv(1)=pizda(1,1)+pizda(2,2)
6783 vv(2)=pizda(2,1)-pizda(1,2)
6784 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6785 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6786 C Cartesian derivatives.
6792 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6794 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6797 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6799 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6800 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6802 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6803 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6805 vv(1)=pizda(1,1)+pizda(2,2)
6806 vv(2)=pizda(2,1)-pizda(1,2)
6807 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6809 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6811 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6814 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6816 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6818 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6824 c----------------------------------------------------------------------------
6825 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6826 implicit real*8 (a-h,o-z)
6827 include 'DIMENSIONS'
6828 include 'DIMENSIONS.ZSCOPT'
6829 include 'COMMON.IOUNITS'
6830 include 'COMMON.CHAIN'
6831 include 'COMMON.DERIV'
6832 include 'COMMON.INTERACT'
6833 include 'COMMON.CONTACTS'
6834 include 'COMMON.TORSION'
6835 include 'COMMON.VAR'
6836 include 'COMMON.GEO'
6837 include 'COMMON.FFIELD'
6838 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6839 & auxvec1(2),auxmat1(2,2)
6841 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6843 C Parallel Antiparallel C
6849 C \ j|/k\| \ |/k\|l C
6854 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6856 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6857 C energy moment and not to the cluster cumulant.
6858 cd write (2,*) 'eello_graph4: wturn6',wturn6
6859 iti=itortyp(itype(i))
6860 itj=itortyp(itype(j))
6861 if (j.lt.nres-1) then
6862 itj1=itortyp(itype(j+1))
6866 itk=itortyp(itype(k))
6867 if (k.lt.nres-1) then
6868 itk1=itortyp(itype(k+1))
6872 itl=itortyp(itype(l))
6873 if (l.lt.nres-1) then
6874 itl1=itortyp(itype(l+1))
6878 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6879 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6880 cd & ' itl',itl,' itl1',itl1
6883 s1=dip(3,jj,i)*dip(3,kk,k)
6885 s1=dip(2,jj,j)*dip(2,kk,l)
6888 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6889 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6891 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6892 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6894 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6895 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6897 call transpose2(EUg(1,1,k),auxmat(1,1))
6898 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6899 vv(1)=pizda(1,1)-pizda(2,2)
6900 vv(2)=pizda(2,1)+pizda(1,2)
6901 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6902 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6904 eello6_graph4=-(s1+s2+s3+s4)
6906 eello6_graph4=-(s2+s3+s4)
6908 if (.not. calc_grad) return
6909 C Derivatives in gamma(i-1)
6913 s1=dipderg(2,jj,i)*dip(3,kk,k)
6915 s1=dipderg(4,jj,j)*dip(2,kk,l)
6918 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6920 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6921 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6923 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6924 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6926 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6927 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6928 cd write (2,*) 'turn6 derivatives'
6930 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6932 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6936 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6938 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6942 C Derivatives in gamma(k-1)
6945 s1=dip(3,jj,i)*dipderg(2,kk,k)
6947 s1=dip(2,jj,j)*dipderg(4,kk,l)
6950 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6951 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6953 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6954 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6956 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6957 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6959 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6960 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6961 vv(1)=pizda(1,1)-pizda(2,2)
6962 vv(2)=pizda(2,1)+pizda(1,2)
6963 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6964 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6966 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6968 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6974 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6977 C Derivatives in gamma(j-1) or gamma(l-1)
6978 if (l.eq.j+1 .and. l.gt.1) then
6979 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6980 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6981 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6982 vv(1)=pizda(1,1)-pizda(2,2)
6983 vv(2)=pizda(2,1)+pizda(1,2)
6984 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6985 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6986 else if (j.gt.1) then
6987 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6988 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6989 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6990 vv(1)=pizda(1,1)-pizda(2,2)
6991 vv(2)=pizda(2,1)+pizda(1,2)
6992 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6993 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6994 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6996 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6999 C Cartesian derivatives.
7006 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7008 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7012 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7014 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7018 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7020 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7022 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7023 & b1(1,itj1),auxvec(1))
7024 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7026 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7027 & b1(1,itl1),auxvec(1))
7028 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7030 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7032 vv(1)=pizda(1,1)-pizda(2,2)
7033 vv(2)=pizda(2,1)+pizda(1,2)
7034 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7036 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7038 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7041 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7044 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7047 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7049 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7051 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7055 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7057 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7060 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7062 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7070 c----------------------------------------------------------------------------
7071 double precision function eello_turn6(i,jj,kk)
7072 implicit real*8 (a-h,o-z)
7073 include 'DIMENSIONS'
7074 include 'DIMENSIONS.ZSCOPT'
7075 include 'COMMON.IOUNITS'
7076 include 'COMMON.CHAIN'
7077 include 'COMMON.DERIV'
7078 include 'COMMON.INTERACT'
7079 include 'COMMON.CONTACTS'
7080 include 'COMMON.TORSION'
7081 include 'COMMON.VAR'
7082 include 'COMMON.GEO'
7083 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7084 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7086 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7087 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7088 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7089 C the respective energy moment and not to the cluster cumulant.
7094 iti=itortyp(itype(i))
7095 itk=itortyp(itype(k))
7096 itk1=itortyp(itype(k+1))
7097 itl=itortyp(itype(l))
7098 itj=itortyp(itype(j))
7099 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7100 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7101 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7106 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7108 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7112 derx_turn(lll,kkk,iii)=0.0d0
7119 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7121 cd write (2,*) 'eello6_5',eello6_5
7123 call transpose2(AEA(1,1,1),auxmat(1,1))
7124 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7125 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7126 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7130 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7131 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7132 s2 = scalar2(b1(1,itk),vtemp1(1))
7134 call transpose2(AEA(1,1,2),atemp(1,1))
7135 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7136 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7137 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7141 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7142 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7143 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7145 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7146 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7147 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7148 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7149 ss13 = scalar2(b1(1,itk),vtemp4(1))
7150 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7154 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7160 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7162 C Derivatives in gamma(i+2)
7164 call transpose2(AEA(1,1,1),auxmatd(1,1))
7165 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7166 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7167 call transpose2(AEAderg(1,1,2),atempd(1,1))
7168 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7169 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7173 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7174 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7175 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7181 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7182 C Derivatives in gamma(i+3)
7184 call transpose2(AEA(1,1,1),auxmatd(1,1))
7185 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7186 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7187 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7191 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7192 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7193 s2d = scalar2(b1(1,itk),vtemp1d(1))
7195 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7196 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7198 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7200 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7201 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7202 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7212 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7213 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7215 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7216 & -0.5d0*ekont*(s2d+s12d)
7218 C Derivatives in gamma(i+4)
7219 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7220 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7221 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7223 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7224 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7225 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7235 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7237 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7239 C Derivatives in gamma(i+5)
7241 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7242 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7243 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7247 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7248 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7249 s2d = scalar2(b1(1,itk),vtemp1d(1))
7251 call transpose2(AEA(1,1,2),atempd(1,1))
7252 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7253 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7257 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7258 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7260 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7261 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7262 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7272 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7273 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7275 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7276 & -0.5d0*ekont*(s2d+s12d)
7278 C Cartesian derivatives
7283 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7284 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7285 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7289 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7290 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7292 s2d = scalar2(b1(1,itk),vtemp1d(1))
7294 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7295 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7296 s8d = -(atempd(1,1)+atempd(2,2))*
7297 & scalar2(cc(1,1,itl),vtemp2(1))
7301 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7303 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7304 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7311 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7314 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7318 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7319 & - 0.5d0*(s8d+s12d)
7321 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7330 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7332 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7333 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7334 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7335 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7336 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7338 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7339 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7340 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7344 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7345 cd & 16*eel_turn6_num
7347 if (j.lt.nres-1) then
7354 if (l.lt.nres-1) then
7362 ggg1(ll)=eel_turn6*g_contij(ll,1)
7363 ggg2(ll)=eel_turn6*g_contij(ll,2)
7364 ghalf=0.5d0*ggg1(ll)
7366 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7367 & +ekont*derx_turn(ll,2,1)
7368 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7369 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7370 & +ekont*derx_turn(ll,4,1)
7371 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7372 ghalf=0.5d0*ggg2(ll)
7374 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7375 & +ekont*derx_turn(ll,2,2)
7376 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7377 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7378 & +ekont*derx_turn(ll,4,2)
7379 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7384 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7389 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7395 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7400 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7404 cd write (2,*) iii,g_corr6_loc(iii)
7407 eello_turn6=ekont*eel_turn6
7408 cd write (2,*) 'ekont',ekont
7409 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7412 crc-------------------------------------------------
7413 SUBROUTINE MATVEC2(A1,V1,V2)
7414 implicit real*8 (a-h,o-z)
7415 include 'DIMENSIONS'
7416 DIMENSION A1(2,2),V1(2),V2(2)
7420 c 3 VI=VI+A1(I,K)*V1(K)
7424 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7425 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7430 C---------------------------------------
7431 SUBROUTINE MATMAT2(A1,A2,A3)
7432 implicit real*8 (a-h,o-z)
7433 include 'DIMENSIONS'
7434 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7435 c DIMENSION AI3(2,2)
7439 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7445 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7446 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7447 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7448 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7456 c-------------------------------------------------------------------------
7457 double precision function scalar2(u,v)
7459 double precision u(2),v(2)
7462 scalar2=u(1)*v(1)+u(2)*v(2)
7466 C-----------------------------------------------------------------------------
7468 subroutine transpose2(a,at)
7470 double precision a(2,2),at(2,2)
7477 c--------------------------------------------------------------------------
7478 subroutine transpose(n,a,at)
7481 double precision a(n,n),at(n,n)
7489 C---------------------------------------------------------------------------
7490 subroutine prodmat3(a1,a2,kk,transp,prod)
7493 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7495 crc double precision auxmat(2,2),prod_(2,2)
7498 crc call transpose2(kk(1,1),auxmat(1,1))
7499 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7500 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7502 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7503 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7504 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7505 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7506 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7507 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7508 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7509 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7512 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7513 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7515 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7516 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7517 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7518 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7519 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7520 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7521 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7522 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7525 c call transpose2(a2(1,1),a2t(1,1))
7528 crc print *,((prod_(i,j),i=1,2),j=1,2)
7529 crc print *,((prod(i,j),i=1,2),j=1,2)
7533 C-----------------------------------------------------------------------------
7534 double precision function scalar(u,v)
7536 double precision u(3),v(3)