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)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C write(iout,*) 'po eelec'
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
63 C write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
74 C print *,'Bend energy finished.'
76 C Calculate the SC local energy.
79 C print *,'SCLOC energy finished.'
81 C Calculate the virtual-bond torsional energy.
83 cd print *,'nterm=',nterm
84 call etor(etors,edihcnstr,fact(1))
86 C 6/23/01 Calculate double-torsional energy
88 call etor_d(etors_d,fact(2))
90 C 21/5/07 Calculate local sicdechain correlation energy
92 call eback_sc_corr(esccor)
94 C 12/1/95 Multi-body terms
98 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
99 & .or. wturn6.gt.0.0d0) then
100 c print *,"calling multibody_eello"
101 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
102 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
103 c print *,ecorr,ecorr5,ecorr6,eturn6
105 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
106 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
108 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
110 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
112 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
113 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
114 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
115 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
116 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
117 & +wbond*estr+wsccor*fact(1)*esccor
119 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
120 & +welec*fact(1)*(ees+evdw1)
121 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
122 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
123 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
124 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
125 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
126 & +wbond*estr+wsccor*fact(1)*esccor
131 energia(2)=evdw2-evdw2_14
148 energia(8)=eello_turn3
149 energia(9)=eello_turn4
158 energia(20)=edihcnstr
163 if (isnan(etot).ne.0) energia(0)=1.0d+99
165 if (isnan(etot)) energia(0)=1.0d+99
170 idumm=proc_proc(etot,i)
172 call proc_proc(etot,i)
174 if(i.eq.1)energia(0)=1.0d+99
181 C Sum up the components of the Cartesian gradient.
186 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
187 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
189 & wstrain*ghpbc(j,i)+
190 & wcorr*fact(3)*gradcorr(j,i)+
191 & wel_loc*fact(2)*gel_loc(j,i)+
192 & wturn3*fact(2)*gcorr3_turn(j,i)+
193 & wturn4*fact(3)*gcorr4_turn(j,i)+
194 & wcorr5*fact(4)*gradcorr5(j,i)+
195 & wcorr6*fact(5)*gradcorr6(j,i)+
196 & wturn6*fact(5)*gcorr6_turn(j,i)+
197 & wsccor*fact(2)*gsccorc(j,i)
198 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
200 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
201 & wsccor*fact(2)*gsccorx(j,i)
206 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
207 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
209 & wcorr*fact(3)*gradcorr(j,i)+
210 & wel_loc*fact(2)*gel_loc(j,i)+
211 & wturn3*fact(2)*gcorr3_turn(j,i)+
212 & wturn4*fact(3)*gcorr4_turn(j,i)+
213 & wcorr5*fact(4)*gradcorr5(j,i)+
214 & wcorr6*fact(5)*gradcorr6(j,i)+
215 & wturn6*fact(5)*gcorr6_turn(j,i)+
216 & wsccor*fact(2)*gsccorc(j,i)
217 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
219 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
220 & wsccor*fact(1)*gsccorx(j,i)
227 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
228 & +wcorr5*fact(4)*g_corr5_loc(i)
229 & +wcorr6*fact(5)*g_corr6_loc(i)
230 & +wturn4*fact(3)*gel_loc_turn4(i)
231 & +wturn3*fact(2)*gel_loc_turn3(i)
232 & +wturn6*fact(5)*gel_loc_turn6(i)
233 & +wel_loc*fact(2)*gel_loc_loc(i)
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'DIMENSIONS.ZSCOPT'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'DIMENSIONS.ZSCOPT'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.ENEPS'
357 include 'COMMON.SBRIDGE'
358 include 'COMMON.NAMES'
359 include 'COMMON.IOUNITS'
360 include 'COMMON.CONTACTS'
364 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
367 eneps_temp(j,i)=0.0d0
374 if (itypi.eq.ntyp1) cycle
375 itypi1=iabs(itype(i+1))
382 C Calculate SC interaction energy.
385 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
386 cd & 'iend=',iend(i,iint)
387 do j=istart(i,iint),iend(i,iint)
389 if (itypj.eq.ntyp1) cycle
393 C Change 12/1/95 to calculate four-body interactions
394 rij=xj*xj+yj*yj+zj*zj
396 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
397 eps0ij=eps(itypi,itypj)
399 e1=fac*fac*aa(itypi,itypj)
400 e2=fac*bb(itypi,itypj)
402 ij=icant(itypi,itypj)
403 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
404 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
405 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
406 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
407 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
408 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
409 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
410 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
411 if (bb(itypi,itypj).gt.0.0d0) then
418 C Calculate the components of the gradient in DC and X
420 fac=-rrij*(e1+evdwij)
425 gvdwx(k,i)=gvdwx(k,i)-gg(k)
426 gvdwx(k,j)=gvdwx(k,j)+gg(k)
430 gvdwc(l,k)=gvdwc(l,k)+gg(l)
435 C 12/1/95, revised on 5/20/97
437 C Calculate the contact function. The ith column of the array JCONT will
438 C contain the numbers of atoms that make contacts with the atom I (of numbers
439 C greater than I). The arrays FACONT and GACONT will contain the values of
440 C the contact function and its derivative.
442 C Uncomment next line, if the correlation interactions include EVDW explicitly.
443 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
444 C Uncomment next line, if the correlation interactions are contact function only
445 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
447 sigij=sigma(itypi,itypj)
448 r0ij=rs0(itypi,itypj)
450 C Check whether the SC's are not too far to make a contact.
453 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
454 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
456 if (fcont.gt.0.0D0) then
457 C If the SC-SC distance if close to sigma, apply spline.
458 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
459 cAdam & fcont1,fprimcont1)
460 cAdam fcont1=1.0d0-fcont1
461 cAdam if (fcont1.gt.0.0d0) then
462 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
463 cAdam fcont=fcont*fcont1
465 C Uncomment following 4 lines to have the geometric average of the epsilon0's
466 cga eps0ij=1.0d0/dsqrt(eps0ij)
468 cga gg(k)=gg(k)*eps0ij
470 cga eps0ij=-evdwij*eps0ij
471 C Uncomment for AL's type of SC correlation interactions.
473 num_conti=num_conti+1
475 facont(num_conti,i)=fcont*eps0ij
476 fprimcont=eps0ij*fprimcont/rij
478 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
479 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
480 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
481 C Uncomment following 3 lines for Skolnick's type of SC correlation.
482 gacont(1,num_conti,i)=-fprimcont*xj
483 gacont(2,num_conti,i)=-fprimcont*yj
484 gacont(3,num_conti,i)=-fprimcont*zj
485 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
486 cd write (iout,'(2i3,3f10.5)')
487 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
493 num_cont(i)=num_conti
498 gvdwc(j,i)=expon*gvdwc(j,i)
499 gvdwx(j,i)=expon*gvdwx(j,i)
503 C******************************************************************************
507 C To save time, the factor of EXPON has been extracted from ALL components
508 C of GVDWC and GRADX. Remember to multiply them by this factor before further
511 C******************************************************************************
514 C-----------------------------------------------------------------------------
515 subroutine eljk(evdw,evdw_t)
517 C This subroutine calculates the interaction energy of nonbonded side chains
518 C assuming the LJK potential of interaction.
520 implicit real*8 (a-h,o-z)
522 include 'DIMENSIONS.ZSCOPT'
523 include "DIMENSIONS.COMPAR"
526 include 'COMMON.LOCAL'
527 include 'COMMON.CHAIN'
528 include 'COMMON.DERIV'
529 include 'COMMON.INTERACT'
530 include 'COMMON.ENEPS'
531 include 'COMMON.IOUNITS'
532 include 'COMMON.NAMES'
537 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
540 eneps_temp(j,i)=0.0d0
547 if (itypi.eq.ntyp1) cycle
548 itypi1=iabs(itype(i+1))
553 C Calculate SC interaction energy.
556 do j=istart(i,iint),iend(i,iint)
558 if (itypj.eq.ntyp1) cycle
562 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
564 e_augm=augm(itypi,itypj)*fac_augm
567 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
568 fac=r_shift_inv**expon
569 e1=fac*fac*aa(itypi,itypj)
570 e2=fac*bb(itypi,itypj)
572 ij=icant(itypi,itypj)
573 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
574 & /dabs(eps(itypi,itypj))
575 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
576 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
577 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
578 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
579 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
580 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
581 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
582 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
583 if (bb(itypi,itypj).gt.0.0d0) then
590 C Calculate the components of the gradient in DC and X
592 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
597 gvdwx(k,i)=gvdwx(k,i)-gg(k)
598 gvdwx(k,j)=gvdwx(k,j)+gg(k)
602 gvdwc(l,k)=gvdwc(l,k)+gg(l)
612 gvdwc(j,i)=expon*gvdwc(j,i)
613 gvdwx(j,i)=expon*gvdwx(j,i)
619 C-----------------------------------------------------------------------------
620 subroutine ebp(evdw,evdw_t)
622 C This subroutine calculates the interaction energy of nonbonded side chains
623 C assuming the Berne-Pechukas potential of interaction.
625 implicit real*8 (a-h,o-z)
627 include 'DIMENSIONS.ZSCOPT'
628 include "DIMENSIONS.COMPAR"
631 include 'COMMON.LOCAL'
632 include 'COMMON.CHAIN'
633 include 'COMMON.DERIV'
634 include 'COMMON.NAMES'
635 include 'COMMON.INTERACT'
636 include 'COMMON.ENEPS'
637 include 'COMMON.IOUNITS'
638 include 'COMMON.CALC'
640 c double precision rrsave(maxdim)
646 eneps_temp(j,i)=0.0d0
651 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
652 c if (icall.eq.0) then
660 if (itypi.eq.ntyp1) cycle
661 itypi1=iabs(itype(i+1))
665 dxi=dc_norm(1,nres+i)
666 dyi=dc_norm(2,nres+i)
667 dzi=dc_norm(3,nres+i)
668 dsci_inv=vbld_inv(i+nres)
670 C Calculate SC interaction energy.
673 do j=istart(i,iint),iend(i,iint)
676 if (itypj.eq.ntyp1) cycle
677 dscj_inv=vbld_inv(j+nres)
678 chi1=chi(itypi,itypj)
679 chi2=chi(itypj,itypi)
686 alf12=0.5D0*(alf1+alf2)
687 C For diagnostics only!!!
700 dxj=dc_norm(1,nres+j)
701 dyj=dc_norm(2,nres+j)
702 dzj=dc_norm(3,nres+j)
703 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
704 cd if (icall.eq.0) then
710 C Calculate the angle-dependent terms of energy & contributions to derivatives.
712 C Calculate whole angle-dependent part of epsilon and contributions
714 fac=(rrij*sigsq)**expon2
715 e1=fac*fac*aa(itypi,itypj)
716 e2=fac*bb(itypi,itypj)
717 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
718 eps2der=evdwij*eps3rt
719 eps3der=evdwij*eps2rt
720 evdwij=evdwij*eps2rt*eps3rt
721 ij=icant(itypi,itypj)
722 aux=eps1*eps2rt**2*eps3rt**2
723 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
724 & /dabs(eps(itypi,itypj))
725 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
726 if (bb(itypi,itypj).gt.0.0d0) then
733 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
734 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
735 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
736 & restyp(itypi),i,restyp(itypj),j,
737 & epsi,sigm,chi1,chi2,chip1,chip2,
738 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
739 & om1,om2,om12,1.0D0/dsqrt(rrij),
742 C Calculate gradient components.
743 e1=e1*eps1*eps2rt**2*eps3rt**2
744 fac=-expon*(e1+evdwij)
747 C Calculate radial part of the gradient
751 C Calculate the angular part of the gradient and sum add the contributions
752 C to the appropriate components of the Cartesian gradient.
761 C-----------------------------------------------------------------------------
762 subroutine egb(evdw,evdw_t)
764 C This subroutine calculates the interaction energy of nonbonded side chains
765 C assuming the Gay-Berne potential of interaction.
767 implicit real*8 (a-h,o-z)
769 include 'DIMENSIONS.ZSCOPT'
770 include "DIMENSIONS.COMPAR"
773 include 'COMMON.LOCAL'
774 include 'COMMON.CHAIN'
775 include 'COMMON.DERIV'
776 include 'COMMON.NAMES'
777 include 'COMMON.INTERACT'
778 include 'COMMON.ENEPS'
779 include 'COMMON.IOUNITS'
780 include 'COMMON.CALC'
787 eneps_temp(j,i)=0.0d0
790 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
794 c if (icall.gt.0) lprn=.true.
798 if (itypi.eq.ntyp1) cycle
799 itypi1=iabs(itype(i+1))
803 C returning the ith atom to box
805 if (xi.lt.0) xi=xi+boxxsize
807 if (yi.lt.0) yi=yi+boxysize
809 if (zi.lt.0) zi=zi+boxzsize
811 dxi=dc_norm(1,nres+i)
812 dyi=dc_norm(2,nres+i)
813 dzi=dc_norm(3,nres+i)
814 dsci_inv=vbld_inv(i+nres)
816 C Calculate SC interaction energy.
819 do j=istart(i,iint),iend(i,iint)
822 if (itypj.eq.ntyp1) cycle
823 dscj_inv=vbld_inv(j+nres)
824 sig0ij=sigma(itypi,itypj)
825 chi1=chi(itypi,itypj)
826 chi2=chi(itypj,itypi)
833 alf12=0.5D0*(alf1+alf2)
834 C For diagnostics only!!!
847 C returning jth atom to box
849 if (xj.lt.0) xj=xj+boxxsize
851 if (yj.lt.0) yj=yj+boxysize
853 if (zj.lt.0) zj=zj+boxzsize
854 C checking the distance
855 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
860 C finding the closest
864 xj=xj_safe+xshift*boxxsize
865 yj=yj_safe+yshift*boxysize
866 zj=zj_safe+zshift*boxzsize
867 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
868 if(dist_temp.lt.dist_init) then
878 if (subchap.eq.1) then
888 dxj=dc_norm(1,nres+j)
889 dyj=dc_norm(2,nres+j)
890 dzj=dc_norm(3,nres+j)
891 c write (iout,*) i,j,xj,yj,zj
892 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
894 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
895 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
896 if (sss.le.0.0) cycle
897 C Calculate angle-dependent terms of energy and contributions to their
901 sig=sig0ij*dsqrt(sigsq)
902 rij_shift=1.0D0/rij-sig+sig0ij
903 C I hate to put IF's in the loops, but here don't have another choice!!!!
904 if (rij_shift.le.0.0D0) then
909 c---------------------------------------------------------------
910 rij_shift=1.0D0/rij_shift
912 e1=fac*fac*aa(itypi,itypj)
913 e2=fac*bb(itypi,itypj)
914 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
915 eps2der=evdwij*eps3rt
916 eps3der=evdwij*eps2rt
917 evdwij=evdwij*eps2rt*eps3rt
918 if (bb(itypi,itypj).gt.0) then
921 evdw_t=evdw_t+evdwij*sss
923 ij=icant(itypi,itypj)
924 aux=eps1*eps2rt**2*eps3rt**2
925 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
926 & /dabs(eps(itypi,itypj))
927 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
928 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
929 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
930 c & aux*e2/eps(itypi,itypj)
932 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
933 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
935 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
936 & restyp(itypi),i,restyp(itypj),j,
937 & epsi,sigm,chi1,chi2,chip1,chip2,
938 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
939 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
941 write (iout,*) "partial sum", evdw, evdw_t
945 C Calculate gradient components.
946 e1=e1*eps1*eps2rt**2*eps3rt**2
947 fac=-expon*(e1+evdwij)*rij_shift
950 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
951 C Calculate the radial part of the gradient
955 C Calculate angular part of the gradient.
963 C-----------------------------------------------------------------------------
964 subroutine egbv(evdw,evdw_t)
966 C This subroutine calculates the interaction energy of nonbonded side chains
967 C assuming the Gay-Berne-Vorobjev potential of interaction.
969 implicit real*8 (a-h,o-z)
971 include 'DIMENSIONS.ZSCOPT'
972 include "DIMENSIONS.COMPAR"
975 include 'COMMON.LOCAL'
976 include 'COMMON.CHAIN'
977 include 'COMMON.DERIV'
978 include 'COMMON.NAMES'
979 include 'COMMON.INTERACT'
980 include 'COMMON.ENEPS'
981 include 'COMMON.IOUNITS'
982 include 'COMMON.CALC'
989 eneps_temp(j,i)=0.0d0
994 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
997 c if (icall.gt.0) lprn=.true.
1000 itypi=iabs(itype(i))
1001 if (itypi.eq.ntyp1) cycle
1002 itypi1=iabs(itype(i+1))
1006 dxi=dc_norm(1,nres+i)
1007 dyi=dc_norm(2,nres+i)
1008 dzi=dc_norm(3,nres+i)
1009 dsci_inv=vbld_inv(i+nres)
1011 C Calculate SC interaction energy.
1013 do iint=1,nint_gr(i)
1014 do j=istart(i,iint),iend(i,iint)
1016 itypj=iabs(itype(j))
1017 if (itypj.eq.ntyp1) cycle
1018 dscj_inv=vbld_inv(j+nres)
1019 sig0ij=sigma(itypi,itypj)
1020 r0ij=r0(itypi,itypj)
1021 chi1=chi(itypi,itypj)
1022 chi2=chi(itypj,itypi)
1029 alf12=0.5D0*(alf1+alf2)
1030 C For diagnostics only!!!
1043 dxj=dc_norm(1,nres+j)
1044 dyj=dc_norm(2,nres+j)
1045 dzj=dc_norm(3,nres+j)
1046 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1048 C Calculate angle-dependent terms of energy and contributions to their
1052 sig=sig0ij*dsqrt(sigsq)
1053 rij_shift=1.0D0/rij-sig+r0ij
1054 C I hate to put IF's in the loops, but here don't have another choice!!!!
1055 if (rij_shift.le.0.0D0) then
1060 c---------------------------------------------------------------
1061 rij_shift=1.0D0/rij_shift
1062 fac=rij_shift**expon
1063 e1=fac*fac*aa(itypi,itypj)
1064 e2=fac*bb(itypi,itypj)
1065 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1066 eps2der=evdwij*eps3rt
1067 eps3der=evdwij*eps2rt
1068 fac_augm=rrij**expon
1069 e_augm=augm(itypi,itypj)*fac_augm
1070 evdwij=evdwij*eps2rt*eps3rt
1071 if (bb(itypi,itypj).gt.0.0d0) then
1072 evdw=evdw+evdwij+e_augm
1074 evdw_t=evdw_t+evdwij+e_augm
1076 ij=icant(itypi,itypj)
1077 aux=eps1*eps2rt**2*eps3rt**2
1078 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1079 & /dabs(eps(itypi,itypj))
1080 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1081 c eneps_temp(ij)=eneps_temp(ij)
1082 c & +(evdwij+e_augm)/eps(itypi,itypj)
1084 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1085 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1086 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1087 c & restyp(itypi),i,restyp(itypj),j,
1088 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1089 c & chi1,chi2,chip1,chip2,
1090 c & eps1,eps2rt**2,eps3rt**2,
1091 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1095 C Calculate gradient components.
1096 e1=e1*eps1*eps2rt**2*eps3rt**2
1097 fac=-expon*(e1+evdwij)*rij_shift
1099 fac=rij*fac-2*expon*rrij*e_augm
1100 C Calculate the radial part of the gradient
1104 C Calculate angular part of the gradient.
1112 C-----------------------------------------------------------------------------
1113 subroutine sc_angular
1114 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1115 C om12. Called by ebp, egb, and egbv.
1117 include 'COMMON.CALC'
1121 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1122 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1123 om12=dxi*dxj+dyi*dyj+dzi*dzj
1125 C Calculate eps1(om12) and its derivative in om12
1126 faceps1=1.0D0-om12*chiom12
1127 faceps1_inv=1.0D0/faceps1
1128 eps1=dsqrt(faceps1_inv)
1129 C Following variable is eps1*deps1/dom12
1130 eps1_om12=faceps1_inv*chiom12
1131 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1136 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1137 sigsq=1.0D0-facsig*faceps1_inv
1138 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1139 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1140 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1141 C Calculate eps2 and its derivatives in om1, om2, and om12.
1144 chipom12=chip12*om12
1145 facp=1.0D0-om12*chipom12
1147 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1148 C Following variable is the square root of eps2
1149 eps2rt=1.0D0-facp1*facp_inv
1150 C Following three variables are the derivatives of the square root of eps
1151 C in om1, om2, and om12.
1152 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1153 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1154 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1155 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1156 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1157 C Calculate whole angle-dependent part of epsilon and contributions
1158 C to its derivatives
1161 C----------------------------------------------------------------------------
1163 implicit real*8 (a-h,o-z)
1164 include 'DIMENSIONS'
1165 include 'DIMENSIONS.ZSCOPT'
1166 include 'COMMON.CHAIN'
1167 include 'COMMON.DERIV'
1168 include 'COMMON.CALC'
1169 double precision dcosom1(3),dcosom2(3)
1170 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1171 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1172 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1173 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1175 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1176 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1179 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1182 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1183 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1184 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1185 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1186 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1187 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1190 C Calculate the components of the gradient in DC and X
1194 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1199 c------------------------------------------------------------------------------
1200 subroutine vec_and_deriv
1201 implicit real*8 (a-h,o-z)
1202 include 'DIMENSIONS'
1203 include 'DIMENSIONS.ZSCOPT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.GEO'
1206 include 'COMMON.VAR'
1207 include 'COMMON.LOCAL'
1208 include 'COMMON.CHAIN'
1209 include 'COMMON.VECTORS'
1210 include 'COMMON.DERIV'
1211 include 'COMMON.INTERACT'
1212 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1213 C Compute the local reference systems. For reference system (i), the
1214 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1215 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1217 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1218 if (i.eq.nres-1) then
1219 C Case of the last full residue
1220 C Compute the Z-axis
1221 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1222 costh=dcos(pi-theta(nres))
1223 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1228 C Compute the derivatives of uz
1230 uzder(2,1,1)=-dc_norm(3,i-1)
1231 uzder(3,1,1)= dc_norm(2,i-1)
1232 uzder(1,2,1)= dc_norm(3,i-1)
1234 uzder(3,2,1)=-dc_norm(1,i-1)
1235 uzder(1,3,1)=-dc_norm(2,i-1)
1236 uzder(2,3,1)= dc_norm(1,i-1)
1239 uzder(2,1,2)= dc_norm(3,i)
1240 uzder(3,1,2)=-dc_norm(2,i)
1241 uzder(1,2,2)=-dc_norm(3,i)
1243 uzder(3,2,2)= dc_norm(1,i)
1244 uzder(1,3,2)= dc_norm(2,i)
1245 uzder(2,3,2)=-dc_norm(1,i)
1248 C Compute the Y-axis
1251 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1254 C Compute the derivatives of uy
1257 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1258 & -dc_norm(k,i)*dc_norm(j,i-1)
1259 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1261 uyder(j,j,1)=uyder(j,j,1)-costh
1262 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1267 uygrad(l,k,j,i)=uyder(l,k,j)
1268 uzgrad(l,k,j,i)=uzder(l,k,j)
1272 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1273 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1274 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1275 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1279 C Compute the Z-axis
1280 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1281 costh=dcos(pi-theta(i+2))
1282 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1287 C Compute the derivatives of uz
1289 uzder(2,1,1)=-dc_norm(3,i+1)
1290 uzder(3,1,1)= dc_norm(2,i+1)
1291 uzder(1,2,1)= dc_norm(3,i+1)
1293 uzder(3,2,1)=-dc_norm(1,i+1)
1294 uzder(1,3,1)=-dc_norm(2,i+1)
1295 uzder(2,3,1)= dc_norm(1,i+1)
1298 uzder(2,1,2)= dc_norm(3,i)
1299 uzder(3,1,2)=-dc_norm(2,i)
1300 uzder(1,2,2)=-dc_norm(3,i)
1302 uzder(3,2,2)= dc_norm(1,i)
1303 uzder(1,3,2)= dc_norm(2,i)
1304 uzder(2,3,2)=-dc_norm(1,i)
1307 C Compute the Y-axis
1310 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1313 C Compute the derivatives of uy
1316 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1317 & -dc_norm(k,i)*dc_norm(j,i+1)
1318 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1320 uyder(j,j,1)=uyder(j,j,1)-costh
1321 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1326 uygrad(l,k,j,i)=uyder(l,k,j)
1327 uzgrad(l,k,j,i)=uzder(l,k,j)
1331 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1332 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1333 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1334 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1340 vbld_inv_temp(1)=vbld_inv(i+1)
1341 if (i.lt.nres-1) then
1342 vbld_inv_temp(2)=vbld_inv(i+2)
1344 vbld_inv_temp(2)=vbld_inv(i)
1349 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1350 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1358 C-----------------------------------------------------------------------------
1359 subroutine vec_and_deriv_test
1360 implicit real*8 (a-h,o-z)
1361 include 'DIMENSIONS'
1362 include 'DIMENSIONS.ZSCOPT'
1363 include 'COMMON.IOUNITS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.VECTORS'
1369 dimension uyder(3,3,2),uzder(3,3,2)
1370 C Compute the local reference systems. For reference system (i), the
1371 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1372 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1374 if (i.eq.nres-1) then
1375 C Case of the last full residue
1376 C Compute the Z-axis
1377 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1378 costh=dcos(pi-theta(nres))
1379 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1380 c write (iout,*) 'fac',fac,
1381 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1382 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1386 C Compute the derivatives of uz
1388 uzder(2,1,1)=-dc_norm(3,i-1)
1389 uzder(3,1,1)= dc_norm(2,i-1)
1390 uzder(1,2,1)= dc_norm(3,i-1)
1392 uzder(3,2,1)=-dc_norm(1,i-1)
1393 uzder(1,3,1)=-dc_norm(2,i-1)
1394 uzder(2,3,1)= dc_norm(1,i-1)
1397 uzder(2,1,2)= dc_norm(3,i)
1398 uzder(3,1,2)=-dc_norm(2,i)
1399 uzder(1,2,2)=-dc_norm(3,i)
1401 uzder(3,2,2)= dc_norm(1,i)
1402 uzder(1,3,2)= dc_norm(2,i)
1403 uzder(2,3,2)=-dc_norm(1,i)
1405 C Compute the Y-axis
1407 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1410 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1411 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1412 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1414 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1417 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1418 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1421 c write (iout,*) 'facy',facy,
1422 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1423 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1425 uy(k,i)=facy*uy(k,i)
1427 C Compute the derivatives of uy
1430 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1431 & -dc_norm(k,i)*dc_norm(j,i-1)
1432 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1434 c uyder(j,j,1)=uyder(j,j,1)-costh
1435 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1436 uyder(j,j,1)=uyder(j,j,1)
1437 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1438 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1444 uygrad(l,k,j,i)=uyder(l,k,j)
1445 uzgrad(l,k,j,i)=uzder(l,k,j)
1449 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1450 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1451 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1452 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1455 C Compute the Z-axis
1456 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1457 costh=dcos(pi-theta(i+2))
1458 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1459 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1463 C Compute the derivatives of uz
1465 uzder(2,1,1)=-dc_norm(3,i+1)
1466 uzder(3,1,1)= dc_norm(2,i+1)
1467 uzder(1,2,1)= dc_norm(3,i+1)
1469 uzder(3,2,1)=-dc_norm(1,i+1)
1470 uzder(1,3,1)=-dc_norm(2,i+1)
1471 uzder(2,3,1)= dc_norm(1,i+1)
1474 uzder(2,1,2)= dc_norm(3,i)
1475 uzder(3,1,2)=-dc_norm(2,i)
1476 uzder(1,2,2)=-dc_norm(3,i)
1478 uzder(3,2,2)= dc_norm(1,i)
1479 uzder(1,3,2)= dc_norm(2,i)
1480 uzder(2,3,2)=-dc_norm(1,i)
1482 C Compute the Y-axis
1484 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1485 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1486 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1488 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1491 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1492 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1495 c write (iout,*) 'facy',facy,
1496 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1497 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1499 uy(k,i)=facy*uy(k,i)
1501 C Compute the derivatives of uy
1504 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1505 & -dc_norm(k,i)*dc_norm(j,i+1)
1506 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1508 c uyder(j,j,1)=uyder(j,j,1)-costh
1509 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1510 uyder(j,j,1)=uyder(j,j,1)
1511 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1512 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1518 uygrad(l,k,j,i)=uyder(l,k,j)
1519 uzgrad(l,k,j,i)=uzder(l,k,j)
1523 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1524 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1525 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1526 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1533 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1534 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1541 C-----------------------------------------------------------------------------
1542 subroutine check_vecgrad
1543 implicit real*8 (a-h,o-z)
1544 include 'DIMENSIONS'
1545 include 'DIMENSIONS.ZSCOPT'
1546 include 'COMMON.IOUNITS'
1547 include 'COMMON.GEO'
1548 include 'COMMON.VAR'
1549 include 'COMMON.LOCAL'
1550 include 'COMMON.CHAIN'
1551 include 'COMMON.VECTORS'
1552 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1553 dimension uyt(3,maxres),uzt(3,maxres)
1554 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1555 double precision delta /1.0d-7/
1558 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1559 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1560 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1561 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1562 cd & (dc_norm(if90,i),if90=1,3)
1563 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1564 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1565 cd write(iout,'(a)')
1571 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1572 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1585 cd write (iout,*) 'i=',i
1587 erij(k)=dc_norm(k,i)
1591 dc_norm(k,i)=erij(k)
1593 dc_norm(j,i)=dc_norm(j,i)+delta
1594 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1596 c dc_norm(k,i)=dc_norm(k,i)/fac
1598 c write (iout,*) (dc_norm(k,i),k=1,3)
1599 c write (iout,*) (erij(k),k=1,3)
1602 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1603 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1604 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1605 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1607 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1608 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1609 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1612 dc_norm(k,i)=erij(k)
1615 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1616 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1617 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1618 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1619 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1620 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1621 cd write (iout,'(a)')
1626 C--------------------------------------------------------------------------
1627 subroutine set_matrices
1628 implicit real*8 (a-h,o-z)
1629 include 'DIMENSIONS'
1630 include 'DIMENSIONS.ZSCOPT'
1631 include 'COMMON.IOUNITS'
1632 include 'COMMON.GEO'
1633 include 'COMMON.VAR'
1634 include 'COMMON.LOCAL'
1635 include 'COMMON.CHAIN'
1636 include 'COMMON.DERIV'
1637 include 'COMMON.INTERACT'
1638 include 'COMMON.CONTACTS'
1639 include 'COMMON.TORSION'
1640 include 'COMMON.VECTORS'
1641 include 'COMMON.FFIELD'
1642 double precision auxvec(2),auxmat(2,2)
1644 C Compute the virtual-bond-torsional-angle dependent quantities needed
1645 C to calculate the el-loc multibody terms of various order.
1648 if (i .lt. nres+1) then
1685 if (i .gt. 3 .and. i .lt. nres+1) then
1686 obrot_der(1,i-2)=-sin1
1687 obrot_der(2,i-2)= cos1
1688 Ugder(1,1,i-2)= sin1
1689 Ugder(1,2,i-2)=-cos1
1690 Ugder(2,1,i-2)=-cos1
1691 Ugder(2,2,i-2)=-sin1
1694 obrot2_der(1,i-2)=-dwasin2
1695 obrot2_der(2,i-2)= dwacos2
1696 Ug2der(1,1,i-2)= dwasin2
1697 Ug2der(1,2,i-2)=-dwacos2
1698 Ug2der(2,1,i-2)=-dwacos2
1699 Ug2der(2,2,i-2)=-dwasin2
1701 obrot_der(1,i-2)=0.0d0
1702 obrot_der(2,i-2)=0.0d0
1703 Ugder(1,1,i-2)=0.0d0
1704 Ugder(1,2,i-2)=0.0d0
1705 Ugder(2,1,i-2)=0.0d0
1706 Ugder(2,2,i-2)=0.0d0
1707 obrot2_der(1,i-2)=0.0d0
1708 obrot2_der(2,i-2)=0.0d0
1709 Ug2der(1,1,i-2)=0.0d0
1710 Ug2der(1,2,i-2)=0.0d0
1711 Ug2der(2,1,i-2)=0.0d0
1712 Ug2der(2,2,i-2)=0.0d0
1714 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1715 if (itype(i-2).le.ntyp) then
1716 iti = itortyp(itype(i-2))
1723 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1724 if (itype(i-1).le.ntyp) then
1725 iti1 = itortyp(itype(i-1))
1732 cd write (iout,*) '*******i',i,' iti1',iti
1733 cd write (iout,*) 'b1',b1(:,iti)
1734 cd write (iout,*) 'b2',b2(:,iti)
1735 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1736 c print *,"itilde1 i iti iti1",i,iti,iti1
1737 if (i .gt. iatel_s+2) then
1738 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1739 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1740 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1741 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1742 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1743 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1744 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1754 DtUg2(l,k,i-2)=0.0d0
1758 c print *,"itilde2 i iti iti1",i,iti,iti1
1759 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1760 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1761 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1762 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1763 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1764 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1765 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1766 c print *,"itilde3 i iti iti1",i,iti,iti1
1768 muder(k,i-2)=Ub2der(k,i-2)
1770 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1771 if (itype(i-1).le.ntyp) then
1772 iti1 = itortyp(itype(i-1))
1780 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1782 C Vectors and matrices dependent on a single virtual-bond dihedral.
1783 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1784 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1785 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1786 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1787 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1788 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1789 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1790 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1791 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1792 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1793 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1795 C Matrices dependent on two consecutive virtual-bond dihedrals.
1796 C The order of matrices is from left to right.
1798 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1799 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1800 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1801 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1802 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1803 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1804 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1805 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1808 cd iti = itortyp(itype(i))
1811 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1812 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1817 C--------------------------------------------------------------------------
1818 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1820 C This subroutine calculates the average interaction energy and its gradient
1821 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1822 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1823 C The potential depends both on the distance of peptide-group centers and on
1824 C the orientation of the CA-CA virtual bonds.
1826 implicit real*8 (a-h,o-z)
1827 include 'DIMENSIONS'
1828 include 'DIMENSIONS.ZSCOPT'
1829 include 'COMMON.CONTROL'
1830 include 'COMMON.IOUNITS'
1831 include 'COMMON.GEO'
1832 include 'COMMON.VAR'
1833 include 'COMMON.LOCAL'
1834 include 'COMMON.CHAIN'
1835 include 'COMMON.DERIV'
1836 include 'COMMON.INTERACT'
1837 include 'COMMON.CONTACTS'
1838 include 'COMMON.TORSION'
1839 include 'COMMON.VECTORS'
1840 include 'COMMON.FFIELD'
1841 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1842 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1843 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1844 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1845 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1846 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1847 double precision scal_el /0.5d0/
1849 C 13-go grudnia roku pamietnego...
1850 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1851 & 0.0d0,1.0d0,0.0d0,
1852 & 0.0d0,0.0d0,1.0d0/
1853 cd write(iout,*) 'In EELEC'
1855 cd write(iout,*) 'Type',i
1856 cd write(iout,*) 'B1',B1(:,i)
1857 cd write(iout,*) 'B2',B2(:,i)
1858 cd write(iout,*) 'CC',CC(:,:,i)
1859 cd write(iout,*) 'DD',DD(:,:,i)
1860 cd write(iout,*) 'EE',EE(:,:,i)
1862 cd call check_vecgrad
1864 if (icheckgrad.eq.1) then
1866 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1868 dc_norm(k,i)=dc(k,i)*fac
1870 c write (iout,*) 'i',i,' fac',fac
1873 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1874 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1875 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1876 cd if (wel_loc.gt.0.0d0) then
1877 if (icheckgrad.eq.1) then
1878 call vec_and_deriv_test
1885 cd write (iout,*) 'i=',i
1887 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1890 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1891 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1904 C print '(a)','Enter EELEC'
1905 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1907 gel_loc_loc(i)=0.0d0
1910 do i=iatel_s,iatel_e
1912 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1913 & .or. itype(i+2).eq.ntyp1
1914 & .or. itype(i-1).eq.ntyp1
1916 if (itel(i).eq.0) goto 1215
1920 dx_normi=dc_norm(1,i)
1921 dy_normi=dc_norm(2,i)
1922 dz_normi=dc_norm(3,i)
1923 xmedi=c(1,i)+0.5d0*dxi
1924 ymedi=c(2,i)+0.5d0*dyi
1925 zmedi=c(3,i)+0.5d0*dzi
1926 xmedi=mod(xmedi,boxxsize)
1927 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1928 ymedi=mod(ymedi,boxysize)
1929 if (ymedi.lt.0) ymedi=ymedi+boxysize
1930 zmedi=mod(zmedi,boxzsize)
1931 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1933 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1934 do j=ielstart(i),ielend(i)
1936 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1937 & .or.itype(j+2).eq.ntyp1
1938 & .or.itype(j-1).eq.ntyp1
1942 if (itel(j).eq.0) goto 1216
1946 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1947 aaa=app(iteli,itelj)
1948 bbb=bpp(iteli,itelj)
1949 C Diagnostics only!!!
1955 ael6i=ael6(iteli,itelj)
1956 ael3i=ael3(iteli,itelj)
1960 dx_normj=dc_norm(1,j)
1961 dy_normj=dc_norm(2,j)
1962 dz_normj=dc_norm(3,j)
1967 if (xj.lt.0) xj=xj+boxxsize
1969 if (yj.lt.0) yj=yj+boxysize
1971 if (zj.lt.0) zj=zj+boxzsize
1972 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1980 xj=xj_safe+xshift*boxxsize
1981 yj=yj_safe+yshift*boxysize
1982 zj=zj_safe+zshift*boxzsize
1983 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1984 if(dist_temp.lt.dist_init) then
1994 if (isubchap.eq.1) then
2004 rij=xj*xj+yj*yj+zj*zj
2005 sss=sscale(sqrt(rij))
2006 sssgrad=sscagrad(sqrt(rij))
2012 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2013 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2014 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2015 fac=cosa-3.0D0*cosb*cosg
2017 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2018 if (j.eq.i+2) ev1=scal_el*ev1
2023 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2026 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2027 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2028 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2030 evdw1=evdw1+evdwij*sss
2031 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2032 c &'evdw1',i,j,evdwij
2033 c &,iteli,itelj,aaa,evdw1
2035 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2036 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2037 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2038 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2039 c & xmedi,ymedi,zmedi,xj,yj,zj
2041 C Calculate contributions to the Cartesian gradient.
2044 facvdw=-6*rrmij*(ev1+evdwij)*sss
2045 facel=-3*rrmij*(el1+eesij)
2052 * Radial derivatives. First process both termini of the fragment (i,j)
2059 gelc(k,i)=gelc(k,i)+ghalf
2060 gelc(k,j)=gelc(k,j)+ghalf
2063 * Loop over residues i+1 thru j-1.
2067 gelc(l,k)=gelc(l,k)+ggg(l)
2073 if (sss.gt.0.0) then
2074 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2075 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2076 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2084 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2085 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2088 * Loop over residues i+1 thru j-1.
2092 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2096 facvdw=(ev1+evdwij)*sss
2099 fac=-3*rrmij*(facvdw+facvdw+facel)
2105 * Radial derivatives. First process both termini of the fragment (i,j)
2112 gelc(k,i)=gelc(k,i)+ghalf
2113 gelc(k,j)=gelc(k,j)+ghalf
2116 * Loop over residues i+1 thru j-1.
2120 gelc(l,k)=gelc(l,k)+ggg(l)
2127 ecosa=2.0D0*fac3*fac1+fac4
2130 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2131 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2133 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2134 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2136 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2137 cd & (dcosg(k),k=1,3)
2139 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2143 gelc(k,i)=gelc(k,i)+ghalf
2144 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2145 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2146 gelc(k,j)=gelc(k,j)+ghalf
2147 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2148 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2152 gelc(l,k)=gelc(l,k)+ggg(l)
2157 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2158 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2159 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2161 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2162 C energy of a peptide unit is assumed in the form of a second-order
2163 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2164 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2165 C are computed for EVERY pair of non-contiguous peptide groups.
2167 if (j.lt.nres-1) then
2178 muij(kkk)=mu(k,i)*mu(l,j)
2181 cd write (iout,*) 'EELEC: i',i,' j',j
2182 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2183 cd write(iout,*) 'muij',muij
2184 ury=scalar(uy(1,i),erij)
2185 urz=scalar(uz(1,i),erij)
2186 vry=scalar(uy(1,j),erij)
2187 vrz=scalar(uz(1,j),erij)
2188 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2189 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2190 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2191 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2192 C For diagnostics only
2197 fac=dsqrt(-ael6i)*r3ij
2198 cd write (2,*) 'fac=',fac
2199 C For diagnostics only
2205 cd write (iout,'(4i5,4f10.5)')
2206 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2207 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2208 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2209 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2210 cd write (iout,'(4f10.5)')
2211 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2212 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2213 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2214 cd write (iout,'(2i3,9f10.5/)') i,j,
2215 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2217 C Derivatives of the elements of A in virtual-bond vectors
2218 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2225 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2226 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2227 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2228 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2229 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2230 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2231 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2232 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2233 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2234 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2235 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2236 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2246 C Compute radial contributions to the gradient
2268 C Add the contributions coming from er
2271 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2272 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2273 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2274 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2277 C Derivatives in DC(i)
2278 ghalf1=0.5d0*agg(k,1)
2279 ghalf2=0.5d0*agg(k,2)
2280 ghalf3=0.5d0*agg(k,3)
2281 ghalf4=0.5d0*agg(k,4)
2282 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2283 & -3.0d0*uryg(k,2)*vry)+ghalf1
2284 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2285 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2286 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2287 & -3.0d0*urzg(k,2)*vry)+ghalf3
2288 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2289 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2290 C Derivatives in DC(i+1)
2291 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2292 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2293 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2294 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2295 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2296 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2297 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2298 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2299 C Derivatives in DC(j)
2300 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2301 & -3.0d0*vryg(k,2)*ury)+ghalf1
2302 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2303 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2304 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2305 & -3.0d0*vryg(k,2)*urz)+ghalf3
2306 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2307 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2308 C Derivatives in DC(j+1) or DC(nres-1)
2309 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2310 & -3.0d0*vryg(k,3)*ury)
2311 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2312 & -3.0d0*vrzg(k,3)*ury)
2313 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2314 & -3.0d0*vryg(k,3)*urz)
2315 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2316 & -3.0d0*vrzg(k,3)*urz)
2321 C Derivatives in DC(i+1)
2322 cd aggi1(k,1)=agg(k,1)
2323 cd aggi1(k,2)=agg(k,2)
2324 cd aggi1(k,3)=agg(k,3)
2325 cd aggi1(k,4)=agg(k,4)
2326 C Derivatives in DC(j)
2331 C Derivatives in DC(j+1)
2336 if (j.eq.nres-1 .and. i.lt.j-2) then
2338 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2339 cd aggj1(k,l)=agg(k,l)
2345 C Check the loc-el terms by numerical integration
2355 aggi(k,l)=-aggi(k,l)
2356 aggi1(k,l)=-aggi1(k,l)
2357 aggj(k,l)=-aggj(k,l)
2358 aggj1(k,l)=-aggj1(k,l)
2361 if (j.lt.nres-1) then
2367 aggi(k,l)=-aggi(k,l)
2368 aggi1(k,l)=-aggi1(k,l)
2369 aggj(k,l)=-aggj(k,l)
2370 aggj1(k,l)=-aggj1(k,l)
2381 aggi(k,l)=-aggi(k,l)
2382 aggi1(k,l)=-aggi1(k,l)
2383 aggj(k,l)=-aggj(k,l)
2384 aggj1(k,l)=-aggj1(k,l)
2390 IF (wel_loc.gt.0.0d0) THEN
2391 C Contribution to the local-electrostatic energy coming from the i-j pair
2392 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2394 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2395 c write (iout,'(a6,2i5,0pf7.3)')
2396 c & 'eelloc',i,j,eel_loc_ij
2397 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2398 eel_loc=eel_loc+eel_loc_ij
2399 C Partial derivatives in virtual-bond dihedral angles gamma
2402 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2403 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2404 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2405 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2406 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2407 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2408 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2409 cd write(iout,*) 'agg ',agg
2410 cd write(iout,*) 'aggi ',aggi
2411 cd write(iout,*) 'aggi1',aggi1
2412 cd write(iout,*) 'aggj ',aggj
2413 cd write(iout,*) 'aggj1',aggj1
2415 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2417 ggg(l)=agg(l,1)*muij(1)+
2418 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2422 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2425 C Remaining derivatives of eello
2427 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2428 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2429 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2430 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2431 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2432 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2433 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2434 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2438 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2439 C Contributions from turns
2444 call eturn34(i,j,eello_turn3,eello_turn4)
2446 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2447 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2449 C Calculate the contact function. The ith column of the array JCONT will
2450 C contain the numbers of atoms that make contacts with the atom I (of numbers
2451 C greater than I). The arrays FACONT and GACONT will contain the values of
2452 C the contact function and its derivative.
2453 c r0ij=1.02D0*rpp(iteli,itelj)
2454 c r0ij=1.11D0*rpp(iteli,itelj)
2455 r0ij=2.20D0*rpp(iteli,itelj)
2456 c r0ij=1.55D0*rpp(iteli,itelj)
2457 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2458 if (fcont.gt.0.0D0) then
2459 num_conti=num_conti+1
2460 if (num_conti.gt.maxconts) then
2461 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2462 & ' will skip next contacts for this conf.'
2464 jcont_hb(num_conti,i)=j
2465 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2466 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2467 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2469 d_cont(num_conti,i)=rij
2470 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2471 C --- Electrostatic-interaction matrix ---
2472 a_chuj(1,1,num_conti,i)=a22
2473 a_chuj(1,2,num_conti,i)=a23
2474 a_chuj(2,1,num_conti,i)=a32
2475 a_chuj(2,2,num_conti,i)=a33
2476 C --- Gradient of rij
2478 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2481 c a_chuj(1,1,num_conti,i)=-0.61d0
2482 c a_chuj(1,2,num_conti,i)= 0.4d0
2483 c a_chuj(2,1,num_conti,i)= 0.65d0
2484 c a_chuj(2,2,num_conti,i)= 0.50d0
2485 c else if (i.eq.2) then
2486 c a_chuj(1,1,num_conti,i)= 0.0d0
2487 c a_chuj(1,2,num_conti,i)= 0.0d0
2488 c a_chuj(2,1,num_conti,i)= 0.0d0
2489 c a_chuj(2,2,num_conti,i)= 0.0d0
2491 C --- and its gradients
2492 cd write (iout,*) 'i',i,' j',j
2494 cd write (iout,*) 'iii 1 kkk',kkk
2495 cd write (iout,*) agg(kkk,:)
2498 cd write (iout,*) 'iii 2 kkk',kkk
2499 cd write (iout,*) aggi(kkk,:)
2502 cd write (iout,*) 'iii 3 kkk',kkk
2503 cd write (iout,*) aggi1(kkk,:)
2506 cd write (iout,*) 'iii 4 kkk',kkk
2507 cd write (iout,*) aggj(kkk,:)
2510 cd write (iout,*) 'iii 5 kkk',kkk
2511 cd write (iout,*) aggj1(kkk,:)
2518 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2519 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2520 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2521 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2522 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2524 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2530 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2531 C Calculate contact energies
2533 wij=cosa-3.0D0*cosb*cosg
2536 c fac3=dsqrt(-ael6i)/r0ij**3
2537 fac3=dsqrt(-ael6i)*r3ij
2538 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2539 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2541 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2542 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2543 C Diagnostics. Comment out or remove after debugging!
2544 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2545 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2546 c ees0m(num_conti,i)=0.0D0
2548 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2549 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2550 facont_hb(num_conti,i)=fcont
2552 C Angular derivatives of the contact function
2553 ees0pij1=fac3/ees0pij
2554 ees0mij1=fac3/ees0mij
2555 fac3p=-3.0D0*fac3*rrmij
2556 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2557 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2559 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2560 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2561 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2562 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2563 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2564 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2565 ecosap=ecosa1+ecosa2
2566 ecosbp=ecosb1+ecosb2
2567 ecosgp=ecosg1+ecosg2
2568 ecosam=ecosa1-ecosa2
2569 ecosbm=ecosb1-ecosb2
2570 ecosgm=ecosg1-ecosg2
2579 fprimcont=fprimcont/rij
2580 cd facont_hb(num_conti,i)=1.0D0
2581 C Following line is for diagnostics.
2584 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2585 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2588 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2589 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2591 gggp(1)=gggp(1)+ees0pijp*xj
2592 gggp(2)=gggp(2)+ees0pijp*yj
2593 gggp(3)=gggp(3)+ees0pijp*zj
2594 gggm(1)=gggm(1)+ees0mijp*xj
2595 gggm(2)=gggm(2)+ees0mijp*yj
2596 gggm(3)=gggm(3)+ees0mijp*zj
2597 C Derivatives due to the contact function
2598 gacont_hbr(1,num_conti,i)=fprimcont*xj
2599 gacont_hbr(2,num_conti,i)=fprimcont*yj
2600 gacont_hbr(3,num_conti,i)=fprimcont*zj
2602 ghalfp=0.5D0*gggp(k)
2603 ghalfm=0.5D0*gggm(k)
2604 gacontp_hb1(k,num_conti,i)=ghalfp
2605 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2606 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2607 gacontp_hb2(k,num_conti,i)=ghalfp
2608 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2609 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2610 gacontp_hb3(k,num_conti,i)=gggp(k)
2611 gacontm_hb1(k,num_conti,i)=ghalfm
2612 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2613 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2614 gacontm_hb2(k,num_conti,i)=ghalfm
2615 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2616 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2617 gacontm_hb3(k,num_conti,i)=gggm(k)
2620 C Diagnostics. Comment out or remove after debugging!
2622 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2623 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2624 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2625 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2626 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2627 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2630 endif ! num_conti.le.maxconts
2635 num_cont_hb(i)=num_conti
2639 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2640 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2642 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2643 ccc eel_loc=eel_loc+eello_turn3
2646 C-----------------------------------------------------------------------------
2647 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2648 C Third- and fourth-order contributions from turns
2649 implicit real*8 (a-h,o-z)
2650 include 'DIMENSIONS'
2651 include 'DIMENSIONS.ZSCOPT'
2652 include 'COMMON.IOUNITS'
2653 include 'COMMON.GEO'
2654 include 'COMMON.VAR'
2655 include 'COMMON.LOCAL'
2656 include 'COMMON.CHAIN'
2657 include 'COMMON.DERIV'
2658 include 'COMMON.INTERACT'
2659 include 'COMMON.CONTACTS'
2660 include 'COMMON.TORSION'
2661 include 'COMMON.VECTORS'
2662 include 'COMMON.FFIELD'
2664 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2665 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2666 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2667 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2668 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2669 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2671 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2673 C Third-order contributions
2680 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2681 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2682 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2683 call transpose2(auxmat(1,1),auxmat1(1,1))
2684 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2685 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2686 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2687 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2688 cd & ' eello_turn3_num',4*eello_turn3_num
2690 C Derivatives in gamma(i)
2691 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2692 call transpose2(auxmat2(1,1),pizda(1,1))
2693 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2694 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2695 C Derivatives in gamma(i+1)
2696 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2697 call transpose2(auxmat2(1,1),pizda(1,1))
2698 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2699 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2700 & +0.5d0*(pizda(1,1)+pizda(2,2))
2701 C Cartesian derivatives
2703 a_temp(1,1)=aggi(l,1)
2704 a_temp(1,2)=aggi(l,2)
2705 a_temp(2,1)=aggi(l,3)
2706 a_temp(2,2)=aggi(l,4)
2707 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2708 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2709 & +0.5d0*(pizda(1,1)+pizda(2,2))
2710 a_temp(1,1)=aggi1(l,1)
2711 a_temp(1,2)=aggi1(l,2)
2712 a_temp(2,1)=aggi1(l,3)
2713 a_temp(2,2)=aggi1(l,4)
2714 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2715 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2716 & +0.5d0*(pizda(1,1)+pizda(2,2))
2717 a_temp(1,1)=aggj(l,1)
2718 a_temp(1,2)=aggj(l,2)
2719 a_temp(2,1)=aggj(l,3)
2720 a_temp(2,2)=aggj(l,4)
2721 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2722 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2723 & +0.5d0*(pizda(1,1)+pizda(2,2))
2724 a_temp(1,1)=aggj1(l,1)
2725 a_temp(1,2)=aggj1(l,2)
2726 a_temp(2,1)=aggj1(l,3)
2727 a_temp(2,2)=aggj1(l,4)
2728 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2729 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2730 & +0.5d0*(pizda(1,1)+pizda(2,2))
2733 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2734 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2736 C Fourth-order contributions
2744 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2745 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2746 iti1=itortyp(itype(i+1))
2747 iti2=itortyp(itype(i+2))
2748 iti3=itortyp(itype(i+3))
2749 call transpose2(EUg(1,1,i+1),e1t(1,1))
2750 call transpose2(Eug(1,1,i+2),e2t(1,1))
2751 call transpose2(Eug(1,1,i+3),e3t(1,1))
2752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2754 s1=scalar2(b1(1,iti2),auxvec(1))
2755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2757 s2=scalar2(b1(1,iti1),auxvec(1))
2758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2761 eello_turn4=eello_turn4-(s1+s2+s3)
2762 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2763 cd & ' eello_turn4_num',8*eello_turn4_num
2764 C Derivatives in gamma(i)
2766 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2767 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2768 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2769 s1=scalar2(b1(1,iti2),auxvec(1))
2770 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2771 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2772 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2773 C Derivatives in gamma(i+1)
2774 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2775 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2776 s2=scalar2(b1(1,iti1),auxvec(1))
2777 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2778 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2780 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2781 C Derivatives in gamma(i+2)
2782 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2783 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2784 s1=scalar2(b1(1,iti2),auxvec(1))
2785 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2786 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2787 s2=scalar2(b1(1,iti1),auxvec(1))
2788 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2789 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2790 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2791 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2792 C Cartesian derivatives
2793 C Derivatives of this turn contributions in DC(i+2)
2794 if (j.lt.nres-1) then
2796 a_temp(1,1)=agg(l,1)
2797 a_temp(1,2)=agg(l,2)
2798 a_temp(2,1)=agg(l,3)
2799 a_temp(2,2)=agg(l,4)
2800 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2801 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2802 s1=scalar2(b1(1,iti2),auxvec(1))
2803 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2804 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2805 s2=scalar2(b1(1,iti1),auxvec(1))
2806 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2807 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2808 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2810 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2813 C Remaining derivatives of this turn contribution
2815 a_temp(1,1)=aggi(l,1)
2816 a_temp(1,2)=aggi(l,2)
2817 a_temp(2,1)=aggi(l,3)
2818 a_temp(2,2)=aggi(l,4)
2819 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2820 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2821 s1=scalar2(b1(1,iti2),auxvec(1))
2822 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2823 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2824 s2=scalar2(b1(1,iti1),auxvec(1))
2825 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2826 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2827 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2828 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2829 a_temp(1,1)=aggi1(l,1)
2830 a_temp(1,2)=aggi1(l,2)
2831 a_temp(2,1)=aggi1(l,3)
2832 a_temp(2,2)=aggi1(l,4)
2833 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2834 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2835 s1=scalar2(b1(1,iti2),auxvec(1))
2836 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2837 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2838 s2=scalar2(b1(1,iti1),auxvec(1))
2839 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2840 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2841 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2842 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2843 a_temp(1,1)=aggj(l,1)
2844 a_temp(1,2)=aggj(l,2)
2845 a_temp(2,1)=aggj(l,3)
2846 a_temp(2,2)=aggj(l,4)
2847 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2848 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2849 s1=scalar2(b1(1,iti2),auxvec(1))
2850 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2851 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2852 s2=scalar2(b1(1,iti1),auxvec(1))
2853 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2854 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2855 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2856 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2857 a_temp(1,1)=aggj1(l,1)
2858 a_temp(1,2)=aggj1(l,2)
2859 a_temp(2,1)=aggj1(l,3)
2860 a_temp(2,2)=aggj1(l,4)
2861 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2862 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2863 s1=scalar2(b1(1,iti2),auxvec(1))
2864 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2865 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2866 s2=scalar2(b1(1,iti1),auxvec(1))
2867 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2868 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2869 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2870 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2876 C-----------------------------------------------------------------------------
2877 subroutine vecpr(u,v,w)
2878 implicit real*8(a-h,o-z)
2879 dimension u(3),v(3),w(3)
2880 w(1)=u(2)*v(3)-u(3)*v(2)
2881 w(2)=-u(1)*v(3)+u(3)*v(1)
2882 w(3)=u(1)*v(2)-u(2)*v(1)
2885 C-----------------------------------------------------------------------------
2886 subroutine unormderiv(u,ugrad,unorm,ungrad)
2887 C This subroutine computes the derivatives of a normalized vector u, given
2888 C the derivatives computed without normalization conditions, ugrad. Returns
2891 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2892 double precision vec(3)
2893 double precision scalar
2895 c write (2,*) 'ugrad',ugrad
2898 vec(i)=scalar(ugrad(1,i),u(1))
2900 c write (2,*) 'vec',vec
2903 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2906 c write (2,*) 'ungrad',ungrad
2909 C-----------------------------------------------------------------------------
2910 subroutine escp(evdw2,evdw2_14)
2912 C This subroutine calculates the excluded-volume interaction energy between
2913 C peptide-group centers and side chains and its gradient in virtual-bond and
2914 C side-chain vectors.
2916 implicit real*8 (a-h,o-z)
2917 include 'DIMENSIONS'
2918 include 'DIMENSIONS.ZSCOPT'
2919 include 'COMMON.GEO'
2920 include 'COMMON.VAR'
2921 include 'COMMON.LOCAL'
2922 include 'COMMON.CHAIN'
2923 include 'COMMON.DERIV'
2924 include 'COMMON.INTERACT'
2925 include 'COMMON.FFIELD'
2926 include 'COMMON.IOUNITS'
2930 cd print '(a)','Enter ESCP'
2931 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2932 c & ' scal14',scal14
2933 do i=iatscp_s,iatscp_e
2934 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2936 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2937 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2938 if (iteli.eq.0) goto 1225
2939 xi=0.5D0*(c(1,i)+c(1,i+1))
2940 yi=0.5D0*(c(2,i)+c(2,i+1))
2941 zi=0.5D0*(c(3,i)+c(3,i+1))
2942 C Returning the ith atom to box
2944 if (xi.lt.0) xi=xi+boxxsize
2946 if (yi.lt.0) yi=yi+boxysize
2948 if (zi.lt.0) zi=zi+boxzsize
2949 do iint=1,nscp_gr(i)
2951 do j=iscpstart(i,iint),iscpend(i,iint)
2952 itypj=iabs(itype(j))
2953 if (itypj.eq.ntyp1) cycle
2954 C Uncomment following three lines for SC-p interactions
2958 C Uncomment following three lines for Ca-p interactions
2962 C returning the jth atom to box
2964 if (xj.lt.0) xj=xj+boxxsize
2966 if (yj.lt.0) yj=yj+boxysize
2968 if (zj.lt.0) zj=zj+boxzsize
2969 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2974 C Finding the closest jth atom
2978 xj=xj_safe+xshift*boxxsize
2979 yj=yj_safe+yshift*boxysize
2980 zj=zj_safe+zshift*boxzsize
2981 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2982 if(dist_temp.lt.dist_init) then
2992 if (subchap.eq.1) then
3001 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3002 C sss is scaling function for smoothing the cutoff gradient otherwise
3003 C the gradient would not be continuouse
3004 sss=sscale(1.0d0/(dsqrt(rrij)))
3005 if (sss.le.0.0d0) cycle
3006 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3008 e1=fac*fac*aad(itypj,iteli)
3009 e2=fac*bad(itypj,iteli)
3010 if (iabs(j-i) .le. 2) then
3013 evdw2_14=evdw2_14+(e1+e2)*sss
3016 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3017 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3018 c & bad(itypj,iteli)
3019 evdw2=evdw2+evdwij*sss
3022 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3024 fac=-(evdwij+e1)*rrij*sss
3025 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3030 cd write (iout,*) 'j<i'
3031 C Uncomment following three lines for SC-p interactions
3033 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3036 cd write (iout,*) 'j>i'
3039 C Uncomment following line for SC-p interactions
3040 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3044 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3048 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3049 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3052 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3062 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3063 gradx_scp(j,i)=expon*gradx_scp(j,i)
3066 C******************************************************************************
3070 C To save time the factor EXPON has been extracted from ALL components
3071 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3074 C******************************************************************************
3077 C--------------------------------------------------------------------------
3078 subroutine edis(ehpb)
3080 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3082 implicit real*8 (a-h,o-z)
3083 include 'DIMENSIONS'
3084 include 'DIMENSIONS.ZSCOPT'
3085 include 'COMMON.SBRIDGE'
3086 include 'COMMON.CHAIN'
3087 include 'COMMON.DERIV'
3088 include 'COMMON.VAR'
3089 include 'COMMON.INTERACT'
3092 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3093 cd print *,'link_start=',link_start,' link_end=',link_end
3094 if (link_end.eq.0) return
3095 do i=link_start,link_end
3096 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3097 C CA-CA distance used in regularization of structure.
3100 C iii and jjj point to the residues for which the distance is assigned.
3101 if (ii.gt.nres) then
3108 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3109 C distance and angle dependent SS bond potential.
3110 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3111 & iabs(itype(jjj)).eq.1) then
3112 call ssbond_ene(iii,jjj,eij)
3115 C Calculate the distance between the two points and its difference from the
3119 C Get the force constant corresponding to this distance.
3121 C Calculate the contribution to energy.
3122 ehpb=ehpb+waga*rdis*rdis
3124 C Evaluate gradient.
3127 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3128 cd & ' waga=',waga,' fac=',fac
3130 ggg(j)=fac*(c(j,jj)-c(j,ii))
3132 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3133 C If this is a SC-SC distance, we need to calculate the contributions to the
3134 C Cartesian gradient in the SC vectors (ghpbx).
3137 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3138 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3143 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3151 C--------------------------------------------------------------------------
3152 subroutine ssbond_ene(i,j,eij)
3154 C Calculate the distance and angle dependent SS-bond potential energy
3155 C using a free-energy function derived based on RHF/6-31G** ab initio
3156 C calculations of diethyl disulfide.
3158 C A. Liwo and U. Kozlowska, 11/24/03
3160 implicit real*8 (a-h,o-z)
3161 include 'DIMENSIONS'
3162 include 'DIMENSIONS.ZSCOPT'
3163 include 'COMMON.SBRIDGE'
3164 include 'COMMON.CHAIN'
3165 include 'COMMON.DERIV'
3166 include 'COMMON.LOCAL'
3167 include 'COMMON.INTERACT'
3168 include 'COMMON.VAR'
3169 include 'COMMON.IOUNITS'
3170 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3171 itypi=iabs(itype(i))
3175 dxi=dc_norm(1,nres+i)
3176 dyi=dc_norm(2,nres+i)
3177 dzi=dc_norm(3,nres+i)
3178 dsci_inv=dsc_inv(itypi)
3179 itypj=iabs(itype(j))
3180 dscj_inv=dsc_inv(itypj)
3184 dxj=dc_norm(1,nres+j)
3185 dyj=dc_norm(2,nres+j)
3186 dzj=dc_norm(3,nres+j)
3187 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3192 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3193 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3194 om12=dxi*dxj+dyi*dyj+dzi*dzj
3196 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3197 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3203 deltat12=om2-om1+2.0d0
3205 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3206 & +akct*deltad*deltat12
3207 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3208 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3209 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3210 c & " deltat12",deltat12," eij",eij
3211 ed=2*akcm*deltad+akct*deltat12
3213 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3214 eom1=-2*akth*deltat1-pom1-om2*pom2
3215 eom2= 2*akth*deltat2+pom1-om1*pom2
3218 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3221 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3222 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3223 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3224 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3227 C Calculate the components of the gradient in DC and X
3231 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3236 C--------------------------------------------------------------------------
3237 subroutine ebond(estr)
3239 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3241 implicit real*8 (a-h,o-z)
3242 include 'DIMENSIONS'
3243 include 'DIMENSIONS.ZSCOPT'
3244 include 'COMMON.LOCAL'
3245 include 'COMMON.GEO'
3246 include 'COMMON.INTERACT'
3247 include 'COMMON.DERIV'
3248 include 'COMMON.VAR'
3249 include 'COMMON.CHAIN'
3250 include 'COMMON.IOUNITS'
3251 include 'COMMON.NAMES'
3252 include 'COMMON.FFIELD'
3253 include 'COMMON.CONTROL'
3254 logical energy_dec /.false./
3255 double precision u(3),ud(3)
3258 c write (iout,*) "distchainmax",distchainmax
3260 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3261 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3263 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3264 C & *dc(j,i-1)/vbld(i)
3266 C if (energy_dec) write(iout,*)
3267 C & "estr1",i,vbld(i),distchainmax,
3268 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3270 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3271 diff = vbld(i)-vbldpDUM
3273 diff = vbld(i)-vbldp0
3274 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3277 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3280 write (iout,'(a7,i5,4f7.3)')
3281 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3283 estr=0.5d0*AKP*estr+estr1
3285 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3289 if (iti.ne.10 .and. iti.ne.ntyp1) then
3292 diff=vbld(i+nres)-vbldsc0(1,iti)
3293 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3294 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3295 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3297 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3301 diff=vbld(i+nres)-vbldsc0(j,iti)
3302 ud(j)=aksc(j,iti)*diff
3303 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3317 uprod2=uprod2*u(k)*u(k)
3321 usumsqder=usumsqder+ud(j)*uprod2
3323 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3324 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3325 estr=estr+uprod/usum
3327 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3335 C--------------------------------------------------------------------------
3336 subroutine ebend(etheta)
3338 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3339 C angles gamma and its derivatives in consecutive thetas and gammas.
3341 implicit real*8 (a-h,o-z)
3342 include 'DIMENSIONS'
3343 include 'DIMENSIONS.ZSCOPT'
3344 include 'COMMON.LOCAL'
3345 include 'COMMON.GEO'
3346 include 'COMMON.INTERACT'
3347 include 'COMMON.DERIV'
3348 include 'COMMON.VAR'
3349 include 'COMMON.CHAIN'
3350 include 'COMMON.IOUNITS'
3351 include 'COMMON.NAMES'
3352 include 'COMMON.FFIELD'
3353 common /calcthet/ term1,term2,termm,diffak,ratak,
3354 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3355 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3356 double precision y(2),z(2)
3358 time11=dexp(-2*time)
3361 c write (iout,*) "nres",nres
3362 c write (*,'(a,i2)') 'EBEND ICG=',icg
3363 c write (iout,*) ithet_start,ithet_end
3364 do i=ithet_start,ithet_end
3365 C if (itype(i-1).eq.ntyp1) cycle
3367 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3368 & .or.itype(i).eq.ntyp1) cycle
3369 C Zero the energy function and its derivative at 0 or pi.
3370 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3372 ichir1=isign(1,itype(i-2))
3373 ichir2=isign(1,itype(i))
3374 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3375 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3376 if (itype(i-1).eq.10) then
3377 itype1=isign(10,itype(i-2))
3378 ichir11=isign(1,itype(i-2))
3379 ichir12=isign(1,itype(i-2))
3380 itype2=isign(10,itype(i))
3381 ichir21=isign(1,itype(i))
3382 ichir22=isign(1,itype(i))
3389 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3393 call proc_proc(phii,icrc)
3394 if (icrc.eq.1) phii=150.0
3405 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3409 call proc_proc(phii1,icrc)
3410 if (icrc.eq.1) phii1=150.0
3422 C Calculate the "mean" value of theta from the part of the distribution
3423 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3424 C In following comments this theta will be referred to as t_c.
3425 thet_pred_mean=0.0d0
3427 athetk=athet(k,it,ichir1,ichir2)
3428 bthetk=bthet(k,it,ichir1,ichir2)
3430 athetk=athet(k,itype1,ichir11,ichir12)
3431 bthetk=bthet(k,itype2,ichir21,ichir22)
3433 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3435 c write (iout,*) "thet_pred_mean",thet_pred_mean
3436 dthett=thet_pred_mean*ssd
3437 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3438 c write (iout,*) "thet_pred_mean",thet_pred_mean
3439 C Derivatives of the "mean" values in gamma1 and gamma2.
3440 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3441 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3442 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3443 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3445 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3446 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3447 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3448 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3450 if (theta(i).gt.pi-delta) then
3451 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3453 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3454 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3455 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3457 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3459 else if (theta(i).lt.delta) then
3460 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3461 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3462 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3464 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3465 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3468 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3471 etheta=etheta+ethetai
3472 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3473 c & 'ebend',i,ethetai,theta(i),itype(i)
3474 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3475 c & rad2deg*phii,rad2deg*phii1,ethetai
3476 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3477 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3478 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3481 C Ufff.... We've done all this!!!
3484 C---------------------------------------------------------------------------
3485 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3487 implicit real*8 (a-h,o-z)
3488 include 'DIMENSIONS'
3489 include 'COMMON.LOCAL'
3490 include 'COMMON.IOUNITS'
3491 common /calcthet/ term1,term2,termm,diffak,ratak,
3492 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3493 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3494 C Calculate the contributions to both Gaussian lobes.
3495 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3496 C The "polynomial part" of the "standard deviation" of this part of
3500 sig=sig*thet_pred_mean+polthet(j,it)
3502 C Derivative of the "interior part" of the "standard deviation of the"
3503 C gamma-dependent Gaussian lobe in t_c.
3504 sigtc=3*polthet(3,it)
3506 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3509 C Set the parameters of both Gaussian lobes of the distribution.
3510 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3511 fac=sig*sig+sigc0(it)
3514 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3515 sigsqtc=-4.0D0*sigcsq*sigtc
3516 c print *,i,sig,sigtc,sigsqtc
3517 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3518 sigtc=-sigtc/(fac*fac)
3519 C Following variable is sigma(t_c)**(-2)
3520 sigcsq=sigcsq*sigcsq
3522 sig0inv=1.0D0/sig0i**2
3523 delthec=thetai-thet_pred_mean
3524 delthe0=thetai-theta0i
3525 term1=-0.5D0*sigcsq*delthec*delthec
3526 term2=-0.5D0*sig0inv*delthe0*delthe0
3527 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3528 C NaNs in taking the logarithm. We extract the largest exponent which is added
3529 C to the energy (this being the log of the distribution) at the end of energy
3530 C term evaluation for this virtual-bond angle.
3531 if (term1.gt.term2) then
3533 term2=dexp(term2-termm)
3537 term1=dexp(term1-termm)
3540 C The ratio between the gamma-independent and gamma-dependent lobes of
3541 C the distribution is a Gaussian function of thet_pred_mean too.
3542 diffak=gthet(2,it)-thet_pred_mean
3543 ratak=diffak/gthet(3,it)**2
3544 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3545 C Let's differentiate it in thet_pred_mean NOW.
3547 C Now put together the distribution terms to make complete distribution.
3548 termexp=term1+ak*term2
3549 termpre=sigc+ak*sig0i
3550 C Contribution of the bending energy from this theta is just the -log of
3551 C the sum of the contributions from the two lobes and the pre-exponential
3552 C factor. Simple enough, isn't it?
3553 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3554 C NOW the derivatives!!!
3555 C 6/6/97 Take into account the deformation.
3556 E_theta=(delthec*sigcsq*term1
3557 & +ak*delthe0*sig0inv*term2)/termexp
3558 E_tc=((sigtc+aktc*sig0i)/termpre
3559 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3560 & aktc*term2)/termexp)
3563 c-----------------------------------------------------------------------------
3564 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3565 implicit real*8 (a-h,o-z)
3566 include 'DIMENSIONS'
3567 include 'COMMON.LOCAL'
3568 include 'COMMON.IOUNITS'
3569 common /calcthet/ term1,term2,termm,diffak,ratak,
3570 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3571 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3572 delthec=thetai-thet_pred_mean
3573 delthe0=thetai-theta0i
3574 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3575 t3 = thetai-thet_pred_mean
3579 t14 = t12+t6*sigsqtc
3581 t21 = thetai-theta0i
3587 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3588 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3589 & *(-t12*t9-ak*sig0inv*t27)
3593 C--------------------------------------------------------------------------
3594 subroutine ebend(etheta)
3596 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3597 C angles gamma and its derivatives in consecutive thetas and gammas.
3598 C ab initio-derived potentials from
3599 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3601 implicit real*8 (a-h,o-z)
3602 include 'DIMENSIONS'
3603 include 'DIMENSIONS.ZSCOPT'
3604 include 'COMMON.LOCAL'
3605 include 'COMMON.GEO'
3606 include 'COMMON.INTERACT'
3607 include 'COMMON.DERIV'
3608 include 'COMMON.VAR'
3609 include 'COMMON.CHAIN'
3610 include 'COMMON.IOUNITS'
3611 include 'COMMON.NAMES'
3612 include 'COMMON.FFIELD'
3613 include 'COMMON.CONTROL'
3614 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3615 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3616 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3617 & sinph1ph2(maxdouble,maxdouble)
3618 logical lprn /.false./, lprn1 /.false./
3620 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3621 do i=ithet_start,ithet_end
3623 C if (itype(i-1).eq.ntyp1) cycle
3625 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3626 & .or.itype(i).eq.ntyp1) cycle
3627 if (iabs(itype(i+1)).eq.20) iblock=2
3628 if (iabs(itype(i+1)).ne.20) iblock=1
3632 theti2=0.5d0*theta(i)
3633 ityp2=ithetyp((itype(i-1)))
3635 coskt(k)=dcos(k*theti2)
3636 sinkt(k)=dsin(k*theti2)
3646 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3649 if (phii.ne.phii) phii=150.0
3653 ityp1=ithetyp((itype(i-2)))
3655 cosph1(k)=dcos(k*phii)
3656 sinph1(k)=dsin(k*phii)
3667 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3670 if (phii1.ne.phii1) phii1=150.0
3675 ityp3=ithetyp((itype(i)))
3677 cosph2(k)=dcos(k*phii1)
3678 sinph2(k)=dsin(k*phii1)
3688 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3689 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3691 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3694 ccl=cosph1(l)*cosph2(k-l)
3695 ssl=sinph1(l)*sinph2(k-l)
3696 scl=sinph1(l)*cosph2(k-l)
3697 csl=cosph1(l)*sinph2(k-l)
3698 cosph1ph2(l,k)=ccl-ssl
3699 cosph1ph2(k,l)=ccl+ssl
3700 sinph1ph2(l,k)=scl+csl
3701 sinph1ph2(k,l)=scl-csl
3705 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3706 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3707 write (iout,*) "coskt and sinkt"
3709 write (iout,*) k,coskt(k),sinkt(k)
3713 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3714 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3717 & write (iout,*) "k",k,"
3718 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3719 & " ethetai",ethetai
3722 write (iout,*) "cosph and sinph"
3724 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3726 write (iout,*) "cosph1ph2 and sinph2ph2"
3729 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3730 & sinph1ph2(l,k),sinph1ph2(k,l)
3733 write(iout,*) "ethetai",ethetai
3737 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3738 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3739 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3740 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3741 ethetai=ethetai+sinkt(m)*aux
3742 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3743 dephii=dephii+k*sinkt(m)*(
3744 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3745 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3746 dephii1=dephii1+k*sinkt(m)*(
3747 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3748 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3750 & write (iout,*) "m",m," k",k," bbthet",
3751 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3752 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3753 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3754 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3758 & write(iout,*) "ethetai",ethetai
3762 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3763 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3764 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3765 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3766 ethetai=ethetai+sinkt(m)*aux
3767 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3768 dephii=dephii+l*sinkt(m)*(
3769 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3770 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3771 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3772 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3773 dephii1=dephii1+(k-l)*sinkt(m)*(
3774 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3775 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3776 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3777 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3779 write (iout,*) "m",m," k",k," l",l," ffthet",
3780 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3781 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3782 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3783 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3784 & " ethetai",ethetai
3785 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3786 & cosph1ph2(k,l)*sinkt(m),
3787 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3793 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3794 & i,theta(i)*rad2deg,phii*rad2deg,
3795 & phii1*rad2deg,ethetai
3796 etheta=etheta+ethetai
3797 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3798 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3799 gloc(nphi+i-2,icg)=wang*dethetai
3805 c-----------------------------------------------------------------------------
3806 subroutine esc(escloc)
3807 C Calculate the local energy of a side chain and its derivatives in the
3808 C corresponding virtual-bond valence angles THETA and the spherical angles
3810 implicit real*8 (a-h,o-z)
3811 include 'DIMENSIONS'
3812 include 'DIMENSIONS.ZSCOPT'
3813 include 'COMMON.GEO'
3814 include 'COMMON.LOCAL'
3815 include 'COMMON.VAR'
3816 include 'COMMON.INTERACT'
3817 include 'COMMON.DERIV'
3818 include 'COMMON.CHAIN'
3819 include 'COMMON.IOUNITS'
3820 include 'COMMON.NAMES'
3821 include 'COMMON.FFIELD'
3822 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3823 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3824 common /sccalc/ time11,time12,time112,theti,it,nlobit
3827 C write (iout,*) 'ESC'
3828 do i=loc_start,loc_end
3830 if (it.eq.ntyp1) cycle
3831 if (it.eq.10) goto 1
3832 nlobit=nlob(iabs(it))
3833 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3834 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3835 theti=theta(i+1)-pipol
3839 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3841 if (x(2).gt.pi-delta) then
3845 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3847 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3848 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3850 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3851 & ddersc0(1),dersc(1))
3852 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3853 & ddersc0(3),dersc(3))
3855 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3857 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3858 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3859 & dersc0(2),esclocbi,dersc02)
3860 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3862 call splinthet(x(2),0.5d0*delta,ss,ssd)
3867 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3869 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3870 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3872 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3874 c write (iout,*) escloci
3875 else if (x(2).lt.delta) then
3879 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3881 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3882 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3884 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3885 & ddersc0(1),dersc(1))
3886 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3887 & ddersc0(3),dersc(3))
3889 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3891 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3892 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3893 & dersc0(2),esclocbi,dersc02)
3894 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3899 call splinthet(x(2),0.5d0*delta,ss,ssd)
3901 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3903 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3904 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3906 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3907 C write (iout,*) 'i=',i, escloci
3909 call enesc(x,escloci,dersc,ddummy,.false.)
3912 escloc=escloc+escloci
3913 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3914 write (iout,'(a6,i5,0pf7.3)')
3915 & 'escloc',i,escloci
3917 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3919 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3920 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3925 C---------------------------------------------------------------------------
3926 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3927 implicit real*8 (a-h,o-z)
3928 include 'DIMENSIONS'
3929 include 'COMMON.GEO'
3930 include 'COMMON.LOCAL'
3931 include 'COMMON.IOUNITS'
3932 common /sccalc/ time11,time12,time112,theti,it,nlobit
3933 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3934 double precision contr(maxlob,-1:1)
3936 c write (iout,*) 'it=',it,' nlobit=',nlobit
3940 if (mixed) ddersc(j)=0.0d0
3944 C Because of periodicity of the dependence of the SC energy in omega we have
3945 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3946 C To avoid underflows, first compute & store the exponents.
3954 z(k)=x(k)-censc(k,j,it)
3959 Axk=Axk+gaussc(l,k,j,it)*z(l)
3965 expfac=expfac+Ax(k,j,iii)*z(k)
3973 C As in the case of ebend, we want to avoid underflows in exponentiation and
3974 C subsequent NaNs and INFs in energy calculation.
3975 C Find the largest exponent
3979 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3983 cd print *,'it=',it,' emin=',emin
3985 C Compute the contribution to SC energy and derivatives
3989 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3990 cd print *,'j=',j,' expfac=',expfac
3991 escloc_i=escloc_i+expfac
3993 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3997 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3998 & +gaussc(k,2,j,it))*expfac
4005 dersc(1)=dersc(1)/cos(theti)**2
4006 ddersc(1)=ddersc(1)/cos(theti)**2
4009 escloci=-(dlog(escloc_i)-emin)
4011 dersc(j)=dersc(j)/escloc_i
4015 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4020 C------------------------------------------------------------------------------
4021 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4022 implicit real*8 (a-h,o-z)
4023 include 'DIMENSIONS'
4024 include 'COMMON.GEO'
4025 include 'COMMON.LOCAL'
4026 include 'COMMON.IOUNITS'
4027 common /sccalc/ time11,time12,time112,theti,it,nlobit
4028 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4029 double precision contr(maxlob)
4040 z(k)=x(k)-censc(k,j,it)
4046 Axk=Axk+gaussc(l,k,j,it)*z(l)
4052 expfac=expfac+Ax(k,j)*z(k)
4057 C As in the case of ebend, we want to avoid underflows in exponentiation and
4058 C subsequent NaNs and INFs in energy calculation.
4059 C Find the largest exponent
4062 if (emin.gt.contr(j)) emin=contr(j)
4066 C Compute the contribution to SC energy and derivatives
4070 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4071 escloc_i=escloc_i+expfac
4073 dersc(k)=dersc(k)+Ax(k,j)*expfac
4075 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4076 & +gaussc(1,2,j,it))*expfac
4080 dersc(1)=dersc(1)/cos(theti)**2
4081 dersc12=dersc12/cos(theti)**2
4082 escloci=-(dlog(escloc_i)-emin)
4084 dersc(j)=dersc(j)/escloc_i
4086 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4090 c----------------------------------------------------------------------------------
4091 subroutine esc(escloc)
4092 C Calculate the local energy of a side chain and its derivatives in the
4093 C corresponding virtual-bond valence angles THETA and the spherical angles
4094 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4095 C added by Urszula Kozlowska. 07/11/2007
4097 implicit real*8 (a-h,o-z)
4098 include 'DIMENSIONS'
4099 include 'DIMENSIONS.ZSCOPT'
4100 include 'COMMON.GEO'
4101 include 'COMMON.LOCAL'
4102 include 'COMMON.VAR'
4103 include 'COMMON.SCROT'
4104 include 'COMMON.INTERACT'
4105 include 'COMMON.DERIV'
4106 include 'COMMON.CHAIN'
4107 include 'COMMON.IOUNITS'
4108 include 'COMMON.NAMES'
4109 include 'COMMON.FFIELD'
4110 include 'COMMON.CONTROL'
4111 include 'COMMON.VECTORS'
4112 double precision x_prime(3),y_prime(3),z_prime(3)
4113 & , sumene,dsc_i,dp2_i,x(65),
4114 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4115 & de_dxx,de_dyy,de_dzz,de_dt
4116 double precision s1_t,s1_6_t,s2_t,s2_6_t
4118 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4119 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4120 & dt_dCi(3),dt_dCi1(3)
4121 common /sccalc/ time11,time12,time112,theti,it,nlobit
4124 do i=loc_start,loc_end
4125 if (itype(i).eq.ntyp1) cycle
4126 costtab(i+1) =dcos(theta(i+1))
4127 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4128 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4129 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4130 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4131 cosfac=dsqrt(cosfac2)
4132 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4133 sinfac=dsqrt(sinfac2)
4135 if (it.eq.10) goto 1
4137 C Compute the axes of tghe local cartesian coordinates system; store in
4138 c x_prime, y_prime and z_prime
4145 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4146 C & dc_norm(3,i+nres)
4148 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4149 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4152 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4155 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4156 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4157 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4158 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4159 c & " xy",scalar(x_prime(1),y_prime(1)),
4160 c & " xz",scalar(x_prime(1),z_prime(1)),
4161 c & " yy",scalar(y_prime(1),y_prime(1)),
4162 c & " yz",scalar(y_prime(1),z_prime(1)),
4163 c & " zz",scalar(z_prime(1),z_prime(1))
4165 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4166 C to local coordinate system. Store in xx, yy, zz.
4172 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4173 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4174 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4181 C Compute the energy of the ith side cbain
4183 c write (2,*) "xx",xx," yy",yy," zz",zz
4186 x(j) = sc_parmin(j,it)
4189 Cc diagnostics - remove later
4191 yy1 = dsin(alph(2))*dcos(omeg(2))
4192 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4193 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4194 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4196 C," --- ", xx_w,yy_w,zz_w
4199 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4200 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4202 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4203 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4205 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4206 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4207 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4208 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4209 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4211 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4212 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4213 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4214 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4215 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4217 dsc_i = 0.743d0+x(61)
4219 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4220 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4221 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4222 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4223 s1=(1+x(63))/(0.1d0 + dscp1)
4224 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4225 s2=(1+x(65))/(0.1d0 + dscp2)
4226 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4227 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4228 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4229 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4231 c & dscp1,dscp2,sumene
4232 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4233 escloc = escloc + sumene
4234 c write (2,*) "escloc",escloc
4235 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4237 if (.not. calc_grad) goto 1
4240 C This section to check the numerical derivatives of the energy of ith side
4241 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4242 C #define DEBUG in the code to turn it on.
4244 write (2,*) "sumene =",sumene
4248 write (2,*) xx,yy,zz
4249 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4250 de_dxx_num=(sumenep-sumene)/aincr
4252 write (2,*) "xx+ sumene from enesc=",sumenep
4255 write (2,*) xx,yy,zz
4256 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4257 de_dyy_num=(sumenep-sumene)/aincr
4259 write (2,*) "yy+ sumene from enesc=",sumenep
4262 write (2,*) xx,yy,zz
4263 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4264 de_dzz_num=(sumenep-sumene)/aincr
4266 write (2,*) "zz+ sumene from enesc=",sumenep
4267 costsave=cost2tab(i+1)
4268 sintsave=sint2tab(i+1)
4269 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4270 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4271 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4272 de_dt_num=(sumenep-sumene)/aincr
4273 write (2,*) " t+ sumene from enesc=",sumenep
4274 cost2tab(i+1)=costsave
4275 sint2tab(i+1)=sintsave
4276 C End of diagnostics section.
4279 C Compute the gradient of esc
4281 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4282 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4283 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4284 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4285 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4286 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4287 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4288 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4289 pom1=(sumene3*sint2tab(i+1)+sumene1)
4290 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4291 pom2=(sumene4*cost2tab(i+1)+sumene2)
4292 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4293 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4294 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4295 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4297 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4298 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4299 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4301 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4302 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4303 & +(pom1+pom2)*pom_dx
4305 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4308 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4309 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4310 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4312 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4313 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4314 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4315 & +x(59)*zz**2 +x(60)*xx*zz
4316 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4317 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4318 & +(pom1-pom2)*pom_dy
4320 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4323 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4324 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4325 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4326 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4327 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4328 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4329 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4330 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4332 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4335 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4336 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4337 & +pom1*pom_dt1+pom2*pom_dt2
4339 write(2,*), "de_dt = ", de_dt,de_dt_num
4343 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4344 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4345 cosfac2xx=cosfac2*xx
4346 sinfac2yy=sinfac2*yy
4348 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4350 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4352 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4353 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4354 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4355 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4356 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4357 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4358 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4359 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4360 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4361 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4365 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4366 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4367 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4368 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4371 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4372 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4373 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4375 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4376 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4380 dXX_Ctab(k,i)=dXX_Ci(k)
4381 dXX_C1tab(k,i)=dXX_Ci1(k)
4382 dYY_Ctab(k,i)=dYY_Ci(k)
4383 dYY_C1tab(k,i)=dYY_Ci1(k)
4384 dZZ_Ctab(k,i)=dZZ_Ci(k)
4385 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4386 dXX_XYZtab(k,i)=dXX_XYZ(k)
4387 dYY_XYZtab(k,i)=dYY_XYZ(k)
4388 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4392 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4393 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4394 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4395 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4396 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4398 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4399 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4400 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4401 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4402 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4403 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4404 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4405 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4407 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4408 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4410 C to check gradient call subroutine check_grad
4417 c------------------------------------------------------------------------------
4418 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4420 C This procedure calculates two-body contact function g(rij) and its derivative:
4423 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4426 C where x=(rij-r0ij)/delta
4428 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4431 double precision rij,r0ij,eps0ij,fcont,fprimcont
4432 double precision x,x2,x4,delta
4436 if (x.lt.-1.0D0) then
4439 else if (x.le.1.0D0) then
4442 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4443 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4450 c------------------------------------------------------------------------------
4451 subroutine splinthet(theti,delta,ss,ssder)
4452 implicit real*8 (a-h,o-z)
4453 include 'DIMENSIONS'
4454 include 'DIMENSIONS.ZSCOPT'
4455 include 'COMMON.VAR'
4456 include 'COMMON.GEO'
4459 if (theti.gt.pipol) then
4460 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4462 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4467 c------------------------------------------------------------------------------
4468 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4470 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4471 double precision ksi,ksi2,ksi3,a1,a2,a3
4472 a1=fprim0*delta/(f1-f0)
4478 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4479 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4482 c------------------------------------------------------------------------------
4483 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4485 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4486 double precision ksi,ksi2,ksi3,a1,a2,a3
4491 a2=3*(f1x-f0x)-2*fprim0x*delta
4492 a3=fprim0x*delta-2*(f1x-f0x)
4493 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4496 C-----------------------------------------------------------------------------
4498 C-----------------------------------------------------------------------------
4499 subroutine etor(etors,edihcnstr,fact)
4500 implicit real*8 (a-h,o-z)
4501 include 'DIMENSIONS'
4502 include 'DIMENSIONS.ZSCOPT'
4503 include 'COMMON.VAR'
4504 include 'COMMON.GEO'
4505 include 'COMMON.LOCAL'
4506 include 'COMMON.TORSION'
4507 include 'COMMON.INTERACT'
4508 include 'COMMON.DERIV'
4509 include 'COMMON.CHAIN'
4510 include 'COMMON.NAMES'
4511 include 'COMMON.IOUNITS'
4512 include 'COMMON.FFIELD'
4513 include 'COMMON.TORCNSTR'
4515 C Set lprn=.true. for debugging
4519 do i=iphi_start,iphi_end
4520 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4521 & .or. itype(i).eq.ntyp1) cycle
4522 itori=itortyp(itype(i-2))
4523 itori1=itortyp(itype(i-1))
4526 C Proline-Proline pair is a special case...
4527 if (itori.eq.3 .and. itori1.eq.3) then
4528 if (phii.gt.-dwapi3) then
4530 fac=1.0D0/(1.0D0-cosphi)
4531 etorsi=v1(1,3,3)*fac
4532 etorsi=etorsi+etorsi
4533 etors=etors+etorsi-v1(1,3,3)
4534 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4537 v1ij=v1(j+1,itori,itori1)
4538 v2ij=v2(j+1,itori,itori1)
4541 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4542 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4546 v1ij=v1(j,itori,itori1)
4547 v2ij=v2(j,itori,itori1)
4550 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4551 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4555 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4556 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4557 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4558 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4559 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4561 ! 6/20/98 - dihedral angle constraints
4564 itori=idih_constr(i)
4567 if (difi.gt.drange(i)) then
4569 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4570 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4571 else if (difi.lt.-drange(i)) then
4573 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4574 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4576 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4577 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4579 ! write (iout,*) 'edihcnstr',edihcnstr
4582 c------------------------------------------------------------------------------
4584 subroutine etor(etors,edihcnstr,fact)
4585 implicit real*8 (a-h,o-z)
4586 include 'DIMENSIONS'
4587 include 'DIMENSIONS.ZSCOPT'
4588 include 'COMMON.VAR'
4589 include 'COMMON.GEO'
4590 include 'COMMON.LOCAL'
4591 include 'COMMON.TORSION'
4592 include 'COMMON.INTERACT'
4593 include 'COMMON.DERIV'
4594 include 'COMMON.CHAIN'
4595 include 'COMMON.NAMES'
4596 include 'COMMON.IOUNITS'
4597 include 'COMMON.FFIELD'
4598 include 'COMMON.TORCNSTR'
4600 C Set lprn=.true. for debugging
4604 do i=iphi_start,iphi_end
4606 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4607 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4608 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4609 C & .or. itype(i).eq.ntyp1) cycle
4610 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4611 if (iabs(itype(i)).eq.20) then
4616 itori=itortyp(itype(i-2))
4617 itori1=itortyp(itype(i-1))
4620 C Regular cosine and sine terms
4621 do j=1,nterm(itori,itori1,iblock)
4622 v1ij=v1(j,itori,itori1,iblock)
4623 v2ij=v2(j,itori,itori1,iblock)
4626 etors=etors+v1ij*cosphi+v2ij*sinphi
4627 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4631 C E = SUM ----------------------------------- - v1
4632 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4634 cosphi=dcos(0.5d0*phii)
4635 sinphi=dsin(0.5d0*phii)
4636 do j=1,nlor(itori,itori1,iblock)
4637 vl1ij=vlor1(j,itori,itori1)
4638 vl2ij=vlor2(j,itori,itori1)
4639 vl3ij=vlor3(j,itori,itori1)
4640 pom=vl2ij*cosphi+vl3ij*sinphi
4641 pom1=1.0d0/(pom*pom+1.0d0)
4642 etors=etors+vl1ij*pom1
4643 c if (energy_dec) etors_ii=etors_ii+
4646 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4648 C Subtract the constant term
4649 etors=etors-v0(itori,itori1,iblock)
4651 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4652 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4653 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4654 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4655 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4658 ! 6/20/98 - dihedral angle constraints
4661 itori=idih_constr(i)
4663 difi=pinorm(phii-phi0(i))
4665 if (difi.gt.drange(i)) then
4667 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4668 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4669 edihi=0.25d0*ftors*difi**4
4670 else if (difi.lt.-drange(i)) then
4672 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4673 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4674 edihi=0.25d0*ftors*difi**4
4678 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4680 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4681 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4683 ! write (iout,*) 'edihcnstr',edihcnstr
4686 c----------------------------------------------------------------------------
4687 subroutine etor_d(etors_d,fact2)
4688 C 6/23/01 Compute double torsional energy
4689 implicit real*8 (a-h,o-z)
4690 include 'DIMENSIONS'
4691 include 'DIMENSIONS.ZSCOPT'
4692 include 'COMMON.VAR'
4693 include 'COMMON.GEO'
4694 include 'COMMON.LOCAL'
4695 include 'COMMON.TORSION'
4696 include 'COMMON.INTERACT'
4697 include 'COMMON.DERIV'
4698 include 'COMMON.CHAIN'
4699 include 'COMMON.NAMES'
4700 include 'COMMON.IOUNITS'
4701 include 'COMMON.FFIELD'
4702 include 'COMMON.TORCNSTR'
4704 C Set lprn=.true. for debugging
4708 do i=iphi_start,iphi_end-1
4710 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4711 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4712 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4713 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4714 & (itype(i+1).eq.ntyp1)) cycle
4715 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4717 itori=itortyp(itype(i-2))
4718 itori1=itortyp(itype(i-1))
4719 itori2=itortyp(itype(i))
4725 if (iabs(itype(i+1)).eq.20) iblock=2
4726 C Regular cosine and sine terms
4727 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4728 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4729 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4730 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4731 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4732 cosphi1=dcos(j*phii)
4733 sinphi1=dsin(j*phii)
4734 cosphi2=dcos(j*phii1)
4735 sinphi2=dsin(j*phii1)
4736 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4737 & v2cij*cosphi2+v2sij*sinphi2
4738 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4739 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4741 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4743 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4744 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4745 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4746 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4747 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4748 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4749 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4750 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4751 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4752 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4753 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4754 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4755 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4756 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4759 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4760 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4766 c------------------------------------------------------------------------------
4767 subroutine eback_sc_corr(esccor)
4768 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4769 c conformational states; temporarily implemented as differences
4770 c between UNRES torsional potentials (dependent on three types of
4771 c residues) and the torsional potentials dependent on all 20 types
4772 c of residues computed from AM1 energy surfaces of terminally-blocked
4773 c amino-acid residues.
4774 implicit real*8 (a-h,o-z)
4775 include 'DIMENSIONS'
4776 include 'DIMENSIONS.ZSCOPT'
4777 include 'COMMON.VAR'
4778 include 'COMMON.GEO'
4779 include 'COMMON.LOCAL'
4780 include 'COMMON.TORSION'
4781 include 'COMMON.SCCOR'
4782 include 'COMMON.INTERACT'
4783 include 'COMMON.DERIV'
4784 include 'COMMON.CHAIN'
4785 include 'COMMON.NAMES'
4786 include 'COMMON.IOUNITS'
4787 include 'COMMON.FFIELD'
4788 include 'COMMON.CONTROL'
4790 C Set lprn=.true. for debugging
4793 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4795 do i=itau_start,itau_end
4796 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4798 isccori=isccortyp(itype(i-2))
4799 isccori1=isccortyp(itype(i-1))
4801 do intertyp=1,3 !intertyp
4802 cc Added 09 May 2012 (Adasko)
4803 cc Intertyp means interaction type of backbone mainchain correlation:
4804 c 1 = SC...Ca...Ca...Ca
4805 c 2 = Ca...Ca...Ca...SC
4806 c 3 = SC...Ca...Ca...SCi
4808 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4809 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4810 & (itype(i-1).eq.ntyp1)))
4811 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4812 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4813 & .or.(itype(i).eq.ntyp1)))
4814 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4815 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4816 & (itype(i-3).eq.ntyp1)))) cycle
4817 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4818 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4820 do j=1,nterm_sccor(isccori,isccori1)
4821 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4822 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4823 cosphi=dcos(j*tauangle(intertyp,i))
4824 sinphi=dsin(j*tauangle(intertyp,i))
4825 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4826 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4828 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4829 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4830 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4832 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4833 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4834 & (v1sccor(j,1,itori,itori1),j=1,6)
4835 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4836 c gsccor_loc(i-3)=gloci
4841 c------------------------------------------------------------------------------
4842 subroutine multibody(ecorr)
4843 C This subroutine calculates multi-body contributions to energy following
4844 C the idea of Skolnick et al. If side chains I and J make a contact and
4845 C at the same time side chains I+1 and J+1 make a contact, an extra
4846 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'COMMON.IOUNITS'
4850 include 'COMMON.DERIV'
4851 include 'COMMON.INTERACT'
4852 include 'COMMON.CONTACTS'
4853 double precision gx(3),gx1(3)
4856 C Set lprn=.true. for debugging
4860 write (iout,'(a)') 'Contact function values:'
4862 write (iout,'(i2,20(1x,i2,f10.5))')
4863 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4878 num_conti=num_cont(i)
4879 num_conti1=num_cont(i1)
4884 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4885 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4886 cd & ' ishift=',ishift
4887 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4888 C The system gains extra energy.
4889 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4890 endif ! j1==j+-ishift
4899 c------------------------------------------------------------------------------
4900 double precision function esccorr(i,j,k,l,jj,kk)
4901 implicit real*8 (a-h,o-z)
4902 include 'DIMENSIONS'
4903 include 'COMMON.IOUNITS'
4904 include 'COMMON.DERIV'
4905 include 'COMMON.INTERACT'
4906 include 'COMMON.CONTACTS'
4907 double precision gx(3),gx1(3)
4912 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4913 C Calculate the multi-body contribution to energy.
4914 C Calculate multi-body contributions to the gradient.
4915 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4916 cd & k,l,(gacont(m,kk,k),m=1,3)
4918 gx(m) =ekl*gacont(m,jj,i)
4919 gx1(m)=eij*gacont(m,kk,k)
4920 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4921 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4922 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4923 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4927 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4932 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4938 c------------------------------------------------------------------------------
4940 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4941 implicit real*8 (a-h,o-z)
4942 include 'DIMENSIONS'
4943 integer dimen1,dimen2,atom,indx
4944 double precision buffer(dimen1,dimen2)
4945 double precision zapas
4946 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4947 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4948 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4949 num_kont=num_cont_hb(atom)
4953 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4956 buffer(i,indx+22)=facont_hb(i,atom)
4957 buffer(i,indx+23)=ees0p(i,atom)
4958 buffer(i,indx+24)=ees0m(i,atom)
4959 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4961 buffer(1,indx+26)=dfloat(num_kont)
4964 c------------------------------------------------------------------------------
4965 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4966 implicit real*8 (a-h,o-z)
4967 include 'DIMENSIONS'
4968 integer dimen1,dimen2,atom,indx
4969 double precision buffer(dimen1,dimen2)
4970 double precision zapas
4971 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4972 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4973 & ees0m(ntyp,maxres),
4974 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4975 num_kont=buffer(1,indx+26)
4976 num_kont_old=num_cont_hb(atom)
4977 num_cont_hb(atom)=num_kont+num_kont_old
4982 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4985 facont_hb(ii,atom)=buffer(i,indx+22)
4986 ees0p(ii,atom)=buffer(i,indx+23)
4987 ees0m(ii,atom)=buffer(i,indx+24)
4988 jcont_hb(ii,atom)=buffer(i,indx+25)
4992 c------------------------------------------------------------------------------
4994 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4995 C This subroutine calculates multi-body contributions to hydrogen-bonding
4996 implicit real*8 (a-h,o-z)
4997 include 'DIMENSIONS'
4998 include 'DIMENSIONS.ZSCOPT'
4999 include 'COMMON.IOUNITS'
5001 include 'COMMON.INFO'
5003 include 'COMMON.FFIELD'
5004 include 'COMMON.DERIV'
5005 include 'COMMON.INTERACT'
5006 include 'COMMON.CONTACTS'
5008 parameter (max_cont=maxconts)
5009 parameter (max_dim=2*(8*3+2))
5010 parameter (msglen1=max_cont*max_dim*4)
5011 parameter (msglen2=2*msglen1)
5012 integer source,CorrelType,CorrelID,Error
5013 double precision buffer(max_cont,max_dim)
5015 double precision gx(3),gx1(3)
5018 C Set lprn=.true. for debugging
5023 if (fgProcs.le.1) goto 30
5025 write (iout,'(a)') 'Contact function values:'
5027 write (iout,'(2i3,50(1x,i2,f5.2))')
5028 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5029 & j=1,num_cont_hb(i))
5032 C Caution! Following code assumes that electrostatic interactions concerning
5033 C a given atom are split among at most two processors!
5043 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5046 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5047 if (MyRank.gt.0) then
5048 C Send correlation contributions to the preceding processor
5050 nn=num_cont_hb(iatel_s)
5051 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5052 cd write (iout,*) 'The BUFFER array:'
5054 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5056 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5058 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5059 C Clear the contacts of the atom passed to the neighboring processor
5060 nn=num_cont_hb(iatel_s+1)
5062 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5064 num_cont_hb(iatel_s)=0
5066 cd write (iout,*) 'Processor ',MyID,MyRank,
5067 cd & ' is sending correlation contribution to processor',MyID-1,
5068 cd & ' msglen=',msglen
5069 cd write (*,*) 'Processor ',MyID,MyRank,
5070 cd & ' is sending correlation contribution to processor',MyID-1,
5071 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5072 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5073 cd write (iout,*) 'Processor ',MyID,
5074 cd & ' has sent correlation contribution to processor',MyID-1,
5075 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5076 cd write (*,*) 'Processor ',MyID,
5077 cd & ' has sent correlation contribution to processor',MyID-1,
5078 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5080 endif ! (MyRank.gt.0)
5084 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5085 if (MyRank.lt.fgProcs-1) then
5086 C Receive correlation contributions from the next processor
5088 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5089 cd write (iout,*) 'Processor',MyID,
5090 cd & ' is receiving correlation contribution from processor',MyID+1,
5091 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5092 cd write (*,*) 'Processor',MyID,
5093 cd & ' is receiving correlation contribution from processor',MyID+1,
5094 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5096 do while (nbytes.le.0)
5097 call mp_probe(MyID+1,CorrelType,nbytes)
5099 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5100 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5101 cd write (iout,*) 'Processor',MyID,
5102 cd & ' has received correlation contribution from processor',MyID+1,
5103 cd & ' msglen=',msglen,' nbytes=',nbytes
5104 cd write (iout,*) 'The received BUFFER array:'
5106 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5108 if (msglen.eq.msglen1) then
5109 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5110 else if (msglen.eq.msglen2) then
5111 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5112 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5115 & 'ERROR!!!! message length changed while processing correlations.'
5117 & 'ERROR!!!! message length changed while processing correlations.'
5118 call mp_stopall(Error)
5119 endif ! msglen.eq.msglen1
5120 endif ! MyRank.lt.fgProcs-1
5127 write (iout,'(a)') 'Contact function values:'
5129 write (iout,'(2i3,50(1x,i2,f5.2))')
5130 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5131 & j=1,num_cont_hb(i))
5135 C Remove the loop below after debugging !!!
5142 C Calculate the local-electrostatic correlation terms
5143 do i=iatel_s,iatel_e+1
5145 num_conti=num_cont_hb(i)
5146 num_conti1=num_cont_hb(i+1)
5151 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5152 c & ' jj=',jj,' kk=',kk
5153 if (j1.eq.j+1 .or. j1.eq.j-1) then
5154 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5155 C The system gains extra energy.
5156 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5158 else if (j1.eq.j) then
5159 C Contacts I-J and I-(J+1) occur simultaneously.
5160 C The system loses extra energy.
5161 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5166 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5167 c & ' jj=',jj,' kk=',kk
5169 C Contacts I-J and (I+1)-J occur simultaneously.
5170 C The system loses extra energy.
5171 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5178 c------------------------------------------------------------------------------
5179 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5181 C This subroutine calculates multi-body contributions to hydrogen-bonding
5182 implicit real*8 (a-h,o-z)
5183 include 'DIMENSIONS'
5184 include 'DIMENSIONS.ZSCOPT'
5185 include 'COMMON.IOUNITS'
5187 include 'COMMON.INFO'
5189 include 'COMMON.FFIELD'
5190 include 'COMMON.DERIV'
5191 include 'COMMON.INTERACT'
5192 include 'COMMON.CONTACTS'
5194 parameter (max_cont=maxconts)
5195 parameter (max_dim=2*(8*3+2))
5196 parameter (msglen1=max_cont*max_dim*4)
5197 parameter (msglen2=2*msglen1)
5198 integer source,CorrelType,CorrelID,Error
5199 double precision buffer(max_cont,max_dim)
5201 double precision gx(3),gx1(3)
5204 C Set lprn=.true. for debugging
5210 if (fgProcs.le.1) goto 30
5212 write (iout,'(a)') 'Contact function values:'
5214 write (iout,'(2i3,50(1x,i2,f5.2))')
5215 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5216 & j=1,num_cont_hb(i))
5219 C Caution! Following code assumes that electrostatic interactions concerning
5220 C a given atom are split among at most two processors!
5230 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5233 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5234 if (MyRank.gt.0) then
5235 C Send correlation contributions to the preceding processor
5237 nn=num_cont_hb(iatel_s)
5238 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5239 cd write (iout,*) 'The BUFFER array:'
5241 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5243 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5245 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5246 C Clear the contacts of the atom passed to the neighboring processor
5247 nn=num_cont_hb(iatel_s+1)
5249 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5251 num_cont_hb(iatel_s)=0
5253 cd write (iout,*) 'Processor ',MyID,MyRank,
5254 cd & ' is sending correlation contribution to processor',MyID-1,
5255 cd & ' msglen=',msglen
5256 cd write (*,*) 'Processor ',MyID,MyRank,
5257 cd & ' is sending correlation contribution to processor',MyID-1,
5258 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5259 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5260 cd write (iout,*) 'Processor ',MyID,
5261 cd & ' has sent correlation contribution to processor',MyID-1,
5262 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5263 cd write (*,*) 'Processor ',MyID,
5264 cd & ' has sent correlation contribution to processor',MyID-1,
5265 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5267 endif ! (MyRank.gt.0)
5271 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5272 if (MyRank.lt.fgProcs-1) then
5273 C Receive correlation contributions from the next processor
5275 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5276 cd write (iout,*) 'Processor',MyID,
5277 cd & ' is receiving correlation contribution from processor',MyID+1,
5278 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5279 cd write (*,*) 'Processor',MyID,
5280 cd & ' is receiving correlation contribution from processor',MyID+1,
5281 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5283 do while (nbytes.le.0)
5284 call mp_probe(MyID+1,CorrelType,nbytes)
5286 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5287 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5288 cd write (iout,*) 'Processor',MyID,
5289 cd & ' has received correlation contribution from processor',MyID+1,
5290 cd & ' msglen=',msglen,' nbytes=',nbytes
5291 cd write (iout,*) 'The received BUFFER array:'
5293 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5295 if (msglen.eq.msglen1) then
5296 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5297 else if (msglen.eq.msglen2) then
5298 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5299 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5302 & 'ERROR!!!! message length changed while processing correlations.'
5304 & 'ERROR!!!! message length changed while processing correlations.'
5305 call mp_stopall(Error)
5306 endif ! msglen.eq.msglen1
5307 endif ! MyRank.lt.fgProcs-1
5314 write (iout,'(a)') 'Contact function values:'
5316 write (iout,'(2i3,50(1x,i2,f5.2))')
5317 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5318 & j=1,num_cont_hb(i))
5324 C Remove the loop below after debugging !!!
5331 C Calculate the dipole-dipole interaction energies
5332 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5333 do i=iatel_s,iatel_e+1
5334 num_conti=num_cont_hb(i)
5341 C Calculate the local-electrostatic correlation terms
5342 do i=iatel_s,iatel_e+1
5344 num_conti=num_cont_hb(i)
5345 num_conti1=num_cont_hb(i+1)
5350 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5351 c & ' jj=',jj,' kk=',kk
5352 if (j1.eq.j+1 .or. j1.eq.j-1) then
5353 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5354 C The system gains extra energy.
5356 sqd1=dsqrt(d_cont(jj,i))
5357 sqd2=dsqrt(d_cont(kk,i1))
5358 sred_geom = sqd1*sqd2
5359 IF (sred_geom.lt.cutoff_corr) THEN
5360 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5362 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5363 c & ' jj=',jj,' kk=',kk
5364 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5365 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5367 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5368 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5371 cd write (iout,*) 'sred_geom=',sred_geom,
5372 cd & ' ekont=',ekont,' fprim=',fprimcont
5373 call calc_eello(i,j,i+1,j1,jj,kk)
5374 if (wcorr4.gt.0.0d0)
5375 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5376 if (wcorr5.gt.0.0d0)
5377 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5378 c print *,"wcorr5",ecorr5
5379 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5380 cd write(2,*)'ijkl',i,j,i+1,j1
5381 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5382 & .or. wturn6.eq.0.0d0))then
5383 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5384 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5385 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5386 cd & 'ecorr6=',ecorr6
5387 cd write (iout,'(4e15.5)') sred_geom,
5388 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5389 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5390 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5391 else if (wturn6.gt.0.0d0
5392 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5393 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5394 eturn6=eturn6+eello_turn6(i,jj,kk)
5395 cd write (2,*) 'multibody_eello:eturn6',eturn6
5399 else if (j1.eq.j) then
5400 C Contacts I-J and I-(J+1) occur simultaneously.
5401 C The system loses extra energy.
5402 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5407 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5408 c & ' jj=',jj,' kk=',kk
5410 C Contacts I-J and (I+1)-J occur simultaneously.
5411 C The system loses extra energy.
5412 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5419 c------------------------------------------------------------------------------
5420 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5421 implicit real*8 (a-h,o-z)
5422 include 'DIMENSIONS'
5423 include 'COMMON.IOUNITS'
5424 include 'COMMON.DERIV'
5425 include 'COMMON.INTERACT'
5426 include 'COMMON.CONTACTS'
5427 double precision gx(3),gx1(3)
5437 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5438 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5439 C Following 4 lines for diagnostics.
5444 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5446 c write (iout,*)'Contacts have occurred for peptide groups',
5447 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5448 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5449 C Calculate the multi-body contribution to energy.
5450 ecorr=ecorr+ekont*ees
5452 C Calculate multi-body contributions to the gradient.
5454 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5455 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5456 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5457 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5458 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5459 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5460 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5461 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5462 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5463 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5464 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5465 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5466 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5467 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5471 gradcorr(ll,m)=gradcorr(ll,m)+
5472 & ees*ekl*gacont_hbr(ll,jj,i)-
5473 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5474 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5479 gradcorr(ll,m)=gradcorr(ll,m)+
5480 & ees*eij*gacont_hbr(ll,kk,k)-
5481 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5482 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5489 C---------------------------------------------------------------------------
5490 subroutine dipole(i,j,jj)
5491 implicit real*8 (a-h,o-z)
5492 include 'DIMENSIONS'
5493 include 'DIMENSIONS.ZSCOPT'
5494 include 'COMMON.IOUNITS'
5495 include 'COMMON.CHAIN'
5496 include 'COMMON.FFIELD'
5497 include 'COMMON.DERIV'
5498 include 'COMMON.INTERACT'
5499 include 'COMMON.CONTACTS'
5500 include 'COMMON.TORSION'
5501 include 'COMMON.VAR'
5502 include 'COMMON.GEO'
5503 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5505 iti1 = itortyp(itype(i+1))
5506 if (j.lt.nres-1) then
5507 if (itype(j).le.ntyp) then
5508 itj1 = itortyp(itype(j+1))
5516 dipi(iii,1)=Ub2(iii,i)
5517 dipderi(iii)=Ub2der(iii,i)
5518 dipi(iii,2)=b1(iii,iti1)
5519 dipj(iii,1)=Ub2(iii,j)
5520 dipderj(iii)=Ub2der(iii,j)
5521 dipj(iii,2)=b1(iii,itj1)
5525 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5528 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5531 if (.not.calc_grad) return
5536 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5540 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5545 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5546 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5548 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5550 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5552 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5556 C---------------------------------------------------------------------------
5557 subroutine calc_eello(i,j,k,l,jj,kk)
5559 C This subroutine computes matrices and vectors needed to calculate
5560 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5562 implicit real*8 (a-h,o-z)
5563 include 'DIMENSIONS'
5564 include 'DIMENSIONS.ZSCOPT'
5565 include 'COMMON.IOUNITS'
5566 include 'COMMON.CHAIN'
5567 include 'COMMON.DERIV'
5568 include 'COMMON.INTERACT'
5569 include 'COMMON.CONTACTS'
5570 include 'COMMON.TORSION'
5571 include 'COMMON.VAR'
5572 include 'COMMON.GEO'
5573 include 'COMMON.FFIELD'
5574 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5575 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5578 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5579 cd & ' jj=',jj,' kk=',kk
5580 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5583 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5584 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5587 call transpose2(aa1(1,1),aa1t(1,1))
5588 call transpose2(aa2(1,1),aa2t(1,1))
5591 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5592 & aa1tder(1,1,lll,kkk))
5593 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5594 & aa2tder(1,1,lll,kkk))
5598 C parallel orientation of the two CA-CA-CA frames.
5599 if (i.gt.1 .and. itype(i).le.ntyp) then
5600 iti=itortyp(itype(i))
5604 itk1=itortyp(itype(k+1))
5605 itj=itortyp(itype(j))
5606 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5607 itl1=itortyp(itype(l+1))
5611 C A1 kernel(j+1) A2T
5613 cd write (iout,'(3f10.5,5x,3f10.5)')
5614 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5616 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5617 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5618 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5619 C Following matrices are needed only for 6-th order cumulants
5620 IF (wcorr6.gt.0.0d0) THEN
5621 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5622 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5623 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5624 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5625 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5626 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5627 & ADtEAderx(1,1,1,1,1,1))
5629 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5630 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5631 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5632 & ADtEA1derx(1,1,1,1,1,1))
5634 C End 6-th order cumulants
5637 cd write (2,*) 'In calc_eello6'
5639 cd write (2,*) 'iii=',iii
5641 cd write (2,*) 'kkk=',kkk
5643 cd write (2,'(3(2f10.5),5x)')
5644 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5649 call transpose2(EUgder(1,1,k),auxmat(1,1))
5650 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5651 call transpose2(EUg(1,1,k),auxmat(1,1))
5652 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5653 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5657 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5658 & EAEAderx(1,1,lll,kkk,iii,1))
5662 C A1T kernel(i+1) A2
5663 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5664 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5665 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5666 C Following matrices are needed only for 6-th order cumulants
5667 IF (wcorr6.gt.0.0d0) THEN
5668 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5669 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5670 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5671 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5672 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5673 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5674 & ADtEAderx(1,1,1,1,1,2))
5675 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5676 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5677 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5678 & ADtEA1derx(1,1,1,1,1,2))
5680 C End 6-th order cumulants
5681 call transpose2(EUgder(1,1,l),auxmat(1,1))
5682 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5683 call transpose2(EUg(1,1,l),auxmat(1,1))
5684 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5685 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5689 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5690 & EAEAderx(1,1,lll,kkk,iii,2))
5695 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5696 C They are needed only when the fifth- or the sixth-order cumulants are
5698 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5699 call transpose2(AEA(1,1,1),auxmat(1,1))
5700 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5701 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5702 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5703 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5704 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5705 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5706 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5707 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5708 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5709 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5710 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5711 call transpose2(AEA(1,1,2),auxmat(1,1))
5712 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5713 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5714 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5715 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5716 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5717 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5718 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5719 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5720 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5721 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5722 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5723 C Calculate the Cartesian derivatives of the vectors.
5727 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5728 call matvec2(auxmat(1,1),b1(1,iti),
5729 & AEAb1derx(1,lll,kkk,iii,1,1))
5730 call matvec2(auxmat(1,1),Ub2(1,i),
5731 & AEAb2derx(1,lll,kkk,iii,1,1))
5732 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5733 & AEAb1derx(1,lll,kkk,iii,2,1))
5734 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5735 & AEAb2derx(1,lll,kkk,iii,2,1))
5736 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5737 call matvec2(auxmat(1,1),b1(1,itj),
5738 & AEAb1derx(1,lll,kkk,iii,1,2))
5739 call matvec2(auxmat(1,1),Ub2(1,j),
5740 & AEAb2derx(1,lll,kkk,iii,1,2))
5741 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5742 & AEAb1derx(1,lll,kkk,iii,2,2))
5743 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5744 & AEAb2derx(1,lll,kkk,iii,2,2))
5751 C Antiparallel orientation of the two CA-CA-CA frames.
5752 if (i.gt.1 .and. itype(i).le.ntyp) then
5753 iti=itortyp(itype(i))
5757 itk1=itortyp(itype(k+1))
5758 itl=itortyp(itype(l))
5759 itj=itortyp(itype(j))
5760 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5761 itj1=itortyp(itype(j+1))
5765 C A2 kernel(j-1)T A1T
5766 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5767 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5768 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5769 C Following matrices are needed only for 6-th order cumulants
5770 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5771 & j.eq.i+4 .and. l.eq.i+3)) THEN
5772 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5773 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5774 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5775 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5776 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5777 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5778 & ADtEAderx(1,1,1,1,1,1))
5779 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5780 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5781 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5782 & ADtEA1derx(1,1,1,1,1,1))
5784 C End 6-th order cumulants
5785 call transpose2(EUgder(1,1,k),auxmat(1,1))
5786 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5787 call transpose2(EUg(1,1,k),auxmat(1,1))
5788 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5789 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5793 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5794 & EAEAderx(1,1,lll,kkk,iii,1))
5798 C A2T kernel(i+1)T A1
5799 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5800 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5801 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5802 C Following matrices are needed only for 6-th order cumulants
5803 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5804 & j.eq.i+4 .and. l.eq.i+3)) THEN
5805 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5806 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5807 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5808 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5809 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5810 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5811 & ADtEAderx(1,1,1,1,1,2))
5812 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5813 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5814 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5815 & ADtEA1derx(1,1,1,1,1,2))
5817 C End 6-th order cumulants
5818 call transpose2(EUgder(1,1,j),auxmat(1,1))
5819 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5820 call transpose2(EUg(1,1,j),auxmat(1,1))
5821 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5822 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5826 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5827 & EAEAderx(1,1,lll,kkk,iii,2))
5832 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5833 C They are needed only when the fifth- or the sixth-order cumulants are
5835 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5836 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5837 call transpose2(AEA(1,1,1),auxmat(1,1))
5838 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5839 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5840 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5841 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5842 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5843 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5844 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5845 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5846 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5847 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5848 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5849 call transpose2(AEA(1,1,2),auxmat(1,1))
5850 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5851 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5852 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5853 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5854 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5855 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5856 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5857 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5858 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5859 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5860 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5861 C Calculate the Cartesian derivatives of the vectors.
5865 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5866 call matvec2(auxmat(1,1),b1(1,iti),
5867 & AEAb1derx(1,lll,kkk,iii,1,1))
5868 call matvec2(auxmat(1,1),Ub2(1,i),
5869 & AEAb2derx(1,lll,kkk,iii,1,1))
5870 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5871 & AEAb1derx(1,lll,kkk,iii,2,1))
5872 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5873 & AEAb2derx(1,lll,kkk,iii,2,1))
5874 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5875 call matvec2(auxmat(1,1),b1(1,itl),
5876 & AEAb1derx(1,lll,kkk,iii,1,2))
5877 call matvec2(auxmat(1,1),Ub2(1,l),
5878 & AEAb2derx(1,lll,kkk,iii,1,2))
5879 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5880 & AEAb1derx(1,lll,kkk,iii,2,2))
5881 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5882 & AEAb2derx(1,lll,kkk,iii,2,2))
5891 C---------------------------------------------------------------------------
5892 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5893 & KK,KKderg,AKA,AKAderg,AKAderx)
5897 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5898 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5899 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5904 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5906 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5909 cd if (lprn) write (2,*) 'In kernel'
5911 cd if (lprn) write (2,*) 'kkk=',kkk
5913 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5914 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5916 cd write (2,*) 'lll=',lll
5917 cd write (2,*) 'iii=1'
5919 cd write (2,'(3(2f10.5),5x)')
5920 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5923 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5924 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5926 cd write (2,*) 'lll=',lll
5927 cd write (2,*) 'iii=2'
5929 cd write (2,'(3(2f10.5),5x)')
5930 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5937 C---------------------------------------------------------------------------
5938 double precision function eello4(i,j,k,l,jj,kk)
5939 implicit real*8 (a-h,o-z)
5940 include 'DIMENSIONS'
5941 include 'DIMENSIONS.ZSCOPT'
5942 include 'COMMON.IOUNITS'
5943 include 'COMMON.CHAIN'
5944 include 'COMMON.DERIV'
5945 include 'COMMON.INTERACT'
5946 include 'COMMON.CONTACTS'
5947 include 'COMMON.TORSION'
5948 include 'COMMON.VAR'
5949 include 'COMMON.GEO'
5950 double precision pizda(2,2),ggg1(3),ggg2(3)
5951 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5955 cd print *,'eello4:',i,j,k,l,jj,kk
5956 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5957 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5958 cold eij=facont_hb(jj,i)
5959 cold ekl=facont_hb(kk,k)
5961 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5963 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5964 gcorr_loc(k-1)=gcorr_loc(k-1)
5965 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5967 gcorr_loc(l-1)=gcorr_loc(l-1)
5968 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5970 gcorr_loc(j-1)=gcorr_loc(j-1)
5971 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5976 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5977 & -EAEAderx(2,2,lll,kkk,iii,1)
5978 cd derx(lll,kkk,iii)=0.0d0
5982 cd gcorr_loc(l-1)=0.0d0
5983 cd gcorr_loc(j-1)=0.0d0
5984 cd gcorr_loc(k-1)=0.0d0
5986 cd write (iout,*)'Contacts have occurred for peptide groups',
5987 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5988 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5989 if (j.lt.nres-1) then
5996 if (l.lt.nres-1) then
6004 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6005 ggg1(ll)=eel4*g_contij(ll,1)
6006 ggg2(ll)=eel4*g_contij(ll,2)
6007 ghalf=0.5d0*ggg1(ll)
6009 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6010 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6011 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6012 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6013 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6014 ghalf=0.5d0*ggg2(ll)
6016 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6017 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6018 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6019 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6024 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6025 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6030 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6031 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6037 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6042 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6046 cd write (2,*) iii,gcorr_loc(iii)
6050 cd write (2,*) 'ekont',ekont
6051 cd write (iout,*) 'eello4',ekont*eel4
6054 C---------------------------------------------------------------------------
6055 double precision function eello5(i,j,k,l,jj,kk)
6056 implicit real*8 (a-h,o-z)
6057 include 'DIMENSIONS'
6058 include 'DIMENSIONS.ZSCOPT'
6059 include 'COMMON.IOUNITS'
6060 include 'COMMON.CHAIN'
6061 include 'COMMON.DERIV'
6062 include 'COMMON.INTERACT'
6063 include 'COMMON.CONTACTS'
6064 include 'COMMON.TORSION'
6065 include 'COMMON.VAR'
6066 include 'COMMON.GEO'
6067 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6068 double precision ggg1(3),ggg2(3)
6069 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6074 C /l\ / \ \ / \ / \ / C
6075 C / \ / \ \ / \ / \ / C
6076 C j| o |l1 | o | o| o | | o |o C
6077 C \ |/k\| |/ \| / |/ \| |/ \| C
6078 C \i/ \ / \ / / \ / \ C
6080 C (I) (II) (III) (IV) C
6082 C eello5_1 eello5_2 eello5_3 eello5_4 C
6084 C Antiparallel chains C
6087 C /j\ / \ \ / \ / \ / C
6088 C / \ / \ \ / \ / \ / C
6089 C j1| o |l | o | o| o | | o |o C
6090 C \ |/k\| |/ \| / |/ \| |/ \| C
6091 C \i/ \ / \ / / \ / \ C
6093 C (I) (II) (III) (IV) C
6095 C eello5_1 eello5_2 eello5_3 eello5_4 C
6097 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6099 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6100 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6105 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6107 itk=itortyp(itype(k))
6108 itl=itortyp(itype(l))
6109 itj=itortyp(itype(j))
6114 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6115 cd & eel5_3_num,eel5_4_num)
6119 derx(lll,kkk,iii)=0.0d0
6123 cd eij=facont_hb(jj,i)
6124 cd ekl=facont_hb(kk,k)
6126 cd write (iout,*)'Contacts have occurred for peptide groups',
6127 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6129 C Contribution from the graph I.
6130 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6131 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6132 call transpose2(EUg(1,1,k),auxmat(1,1))
6133 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6134 vv(1)=pizda(1,1)-pizda(2,2)
6135 vv(2)=pizda(1,2)+pizda(2,1)
6136 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6137 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6139 C Explicit gradient in virtual-dihedral angles.
6140 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6141 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6142 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6143 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6144 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6145 vv(1)=pizda(1,1)-pizda(2,2)
6146 vv(2)=pizda(1,2)+pizda(2,1)
6147 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6148 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6149 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6150 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6151 vv(1)=pizda(1,1)-pizda(2,2)
6152 vv(2)=pizda(1,2)+pizda(2,1)
6154 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6155 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6156 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6158 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6159 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6160 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6162 C Cartesian gradient
6166 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6168 vv(1)=pizda(1,1)-pizda(2,2)
6169 vv(2)=pizda(1,2)+pizda(2,1)
6170 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6171 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6172 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6179 C Contribution from graph II
6180 call transpose2(EE(1,1,itk),auxmat(1,1))
6181 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6182 vv(1)=pizda(1,1)+pizda(2,2)
6183 vv(2)=pizda(2,1)-pizda(1,2)
6184 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6185 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6187 C Explicit gradient in virtual-dihedral angles.
6188 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6189 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6190 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6191 vv(1)=pizda(1,1)+pizda(2,2)
6192 vv(2)=pizda(2,1)-pizda(1,2)
6194 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6195 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6196 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6198 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6199 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6200 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6202 C Cartesian gradient
6206 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6208 vv(1)=pizda(1,1)+pizda(2,2)
6209 vv(2)=pizda(2,1)-pizda(1,2)
6210 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6211 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6212 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6221 C Parallel orientation
6222 C Contribution from graph III
6223 call transpose2(EUg(1,1,l),auxmat(1,1))
6224 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6225 vv(1)=pizda(1,1)-pizda(2,2)
6226 vv(2)=pizda(1,2)+pizda(2,1)
6227 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6228 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6230 C Explicit gradient in virtual-dihedral angles.
6231 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6232 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6233 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6234 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6235 vv(1)=pizda(1,1)-pizda(2,2)
6236 vv(2)=pizda(1,2)+pizda(2,1)
6237 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6238 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6239 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6240 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6241 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6242 vv(1)=pizda(1,1)-pizda(2,2)
6243 vv(2)=pizda(1,2)+pizda(2,1)
6244 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6245 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6246 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6247 C Cartesian gradient
6251 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6253 vv(1)=pizda(1,1)-pizda(2,2)
6254 vv(2)=pizda(1,2)+pizda(2,1)
6255 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6256 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6257 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6263 C Contribution from graph IV
6265 call transpose2(EE(1,1,itl),auxmat(1,1))
6266 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6267 vv(1)=pizda(1,1)+pizda(2,2)
6268 vv(2)=pizda(2,1)-pizda(1,2)
6269 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6270 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6272 C Explicit gradient in virtual-dihedral angles.
6273 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6274 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6275 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6276 vv(1)=pizda(1,1)+pizda(2,2)
6277 vv(2)=pizda(2,1)-pizda(1,2)
6278 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6279 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6280 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6281 C Cartesian gradient
6285 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6287 vv(1)=pizda(1,1)+pizda(2,2)
6288 vv(2)=pizda(2,1)-pizda(1,2)
6289 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6290 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6291 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6297 C Antiparallel orientation
6298 C Contribution from graph III
6300 call transpose2(EUg(1,1,j),auxmat(1,1))
6301 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6302 vv(1)=pizda(1,1)-pizda(2,2)
6303 vv(2)=pizda(1,2)+pizda(2,1)
6304 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6305 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6307 C Explicit gradient in virtual-dihedral angles.
6308 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6309 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6310 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6311 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6312 vv(1)=pizda(1,1)-pizda(2,2)
6313 vv(2)=pizda(1,2)+pizda(2,1)
6314 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6315 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6316 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6317 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6318 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6319 vv(1)=pizda(1,1)-pizda(2,2)
6320 vv(2)=pizda(1,2)+pizda(2,1)
6321 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6322 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6323 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6324 C Cartesian gradient
6328 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6330 vv(1)=pizda(1,1)-pizda(2,2)
6331 vv(2)=pizda(1,2)+pizda(2,1)
6332 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6333 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6334 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6340 C Contribution from graph IV
6342 call transpose2(EE(1,1,itj),auxmat(1,1))
6343 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6344 vv(1)=pizda(1,1)+pizda(2,2)
6345 vv(2)=pizda(2,1)-pizda(1,2)
6346 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6347 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6349 C Explicit gradient in virtual-dihedral angles.
6350 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6351 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6352 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6353 vv(1)=pizda(1,1)+pizda(2,2)
6354 vv(2)=pizda(2,1)-pizda(1,2)
6355 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6356 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6357 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6358 C Cartesian gradient
6362 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6364 vv(1)=pizda(1,1)+pizda(2,2)
6365 vv(2)=pizda(2,1)-pizda(1,2)
6366 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6367 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6368 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6375 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6376 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6377 cd write (2,*) 'ijkl',i,j,k,l
6378 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6379 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6381 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6382 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6383 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6384 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6386 if (j.lt.nres-1) then
6393 if (l.lt.nres-1) then
6403 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6405 ggg1(ll)=eel5*g_contij(ll,1)
6406 ggg2(ll)=eel5*g_contij(ll,2)
6407 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6408 ghalf=0.5d0*ggg1(ll)
6410 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6411 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6412 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6413 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6414 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6415 ghalf=0.5d0*ggg2(ll)
6417 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6418 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6419 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6420 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6425 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6426 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6431 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6432 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6438 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6443 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6447 cd write (2,*) iii,g_corr5_loc(iii)
6451 cd write (2,*) 'ekont',ekont
6452 cd write (iout,*) 'eello5',ekont*eel5
6455 c--------------------------------------------------------------------------
6456 double precision function eello6(i,j,k,l,jj,kk)
6457 implicit real*8 (a-h,o-z)
6458 include 'DIMENSIONS'
6459 include 'DIMENSIONS.ZSCOPT'
6460 include 'COMMON.IOUNITS'
6461 include 'COMMON.CHAIN'
6462 include 'COMMON.DERIV'
6463 include 'COMMON.INTERACT'
6464 include 'COMMON.CONTACTS'
6465 include 'COMMON.TORSION'
6466 include 'COMMON.VAR'
6467 include 'COMMON.GEO'
6468 include 'COMMON.FFIELD'
6469 double precision ggg1(3),ggg2(3)
6470 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6475 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6483 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6484 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6488 derx(lll,kkk,iii)=0.0d0
6492 cd eij=facont_hb(jj,i)
6493 cd ekl=facont_hb(kk,k)
6499 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6500 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6501 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6502 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6503 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6504 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6506 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6507 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6508 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6509 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6510 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6511 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6515 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6517 C If turn contributions are considered, they will be handled separately.
6518 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6519 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6520 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6521 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6522 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6523 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6524 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6527 if (j.lt.nres-1) then
6534 if (l.lt.nres-1) then
6542 ggg1(ll)=eel6*g_contij(ll,1)
6543 ggg2(ll)=eel6*g_contij(ll,2)
6544 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6545 ghalf=0.5d0*ggg1(ll)
6547 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6548 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6549 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6550 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6551 ghalf=0.5d0*ggg2(ll)
6552 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6554 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6555 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6556 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6557 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6562 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6563 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6568 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6569 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6575 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6580 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6584 cd write (2,*) iii,g_corr6_loc(iii)
6588 cd write (2,*) 'ekont',ekont
6589 cd write (iout,*) 'eello6',ekont*eel6
6592 c--------------------------------------------------------------------------
6593 double precision function eello6_graph1(i,j,k,l,imat,swap)
6594 implicit real*8 (a-h,o-z)
6595 include 'DIMENSIONS'
6596 include 'DIMENSIONS.ZSCOPT'
6597 include 'COMMON.IOUNITS'
6598 include 'COMMON.CHAIN'
6599 include 'COMMON.DERIV'
6600 include 'COMMON.INTERACT'
6601 include 'COMMON.CONTACTS'
6602 include 'COMMON.TORSION'
6603 include 'COMMON.VAR'
6604 include 'COMMON.GEO'
6605 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6611 C Parallel Antiparallel C
6617 C \ j|/k\| / \ |/k\|l / C
6622 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6623 itk=itortyp(itype(k))
6624 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6625 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6626 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6627 call transpose2(EUgC(1,1,k),auxmat(1,1))
6628 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6629 vv1(1)=pizda1(1,1)-pizda1(2,2)
6630 vv1(2)=pizda1(1,2)+pizda1(2,1)
6631 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6632 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6633 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6634 s5=scalar2(vv(1),Dtobr2(1,i))
6635 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6636 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6637 if (.not. calc_grad) return
6638 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6639 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6640 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6641 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6642 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6643 & +scalar2(vv(1),Dtobr2der(1,i)))
6644 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6645 vv1(1)=pizda1(1,1)-pizda1(2,2)
6646 vv1(2)=pizda1(1,2)+pizda1(2,1)
6647 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6648 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6650 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6651 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6652 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6653 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6654 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6656 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6657 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6658 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6659 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6660 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6662 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6663 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6664 vv1(1)=pizda1(1,1)-pizda1(2,2)
6665 vv1(2)=pizda1(1,2)+pizda1(2,1)
6666 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6667 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6668 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6669 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6678 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6679 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6680 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6681 call transpose2(EUgC(1,1,k),auxmat(1,1))
6682 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6684 vv1(1)=pizda1(1,1)-pizda1(2,2)
6685 vv1(2)=pizda1(1,2)+pizda1(2,1)
6686 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6687 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6688 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6689 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6690 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6691 s5=scalar2(vv(1),Dtobr2(1,i))
6692 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6698 c----------------------------------------------------------------------------
6699 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6700 implicit real*8 (a-h,o-z)
6701 include 'DIMENSIONS'
6702 include 'DIMENSIONS.ZSCOPT'
6703 include 'COMMON.IOUNITS'
6704 include 'COMMON.CHAIN'
6705 include 'COMMON.DERIV'
6706 include 'COMMON.INTERACT'
6707 include 'COMMON.CONTACTS'
6708 include 'COMMON.TORSION'
6709 include 'COMMON.VAR'
6710 include 'COMMON.GEO'
6712 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6713 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6718 C Parallel Antiparallel C
6724 C \ j|/k\| \ |/k\|l C
6729 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6730 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6731 C AL 7/4/01 s1 would occur in the sixth-order moment,
6732 C but not in a cluster cumulant
6734 s1=dip(1,jj,i)*dip(1,kk,k)
6736 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6737 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6738 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6739 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6740 call transpose2(EUg(1,1,k),auxmat(1,1))
6741 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6742 vv(1)=pizda(1,1)-pizda(2,2)
6743 vv(2)=pizda(1,2)+pizda(2,1)
6744 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6745 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6747 eello6_graph2=-(s1+s2+s3+s4)
6749 eello6_graph2=-(s2+s3+s4)
6752 if (.not. calc_grad) return
6753 C Derivatives in gamma(i-1)
6756 s1=dipderg(1,jj,i)*dip(1,kk,k)
6758 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6759 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6760 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6761 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6763 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6765 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6767 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6769 C Derivatives in gamma(k-1)
6771 s1=dip(1,jj,i)*dipderg(1,kk,k)
6773 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6774 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6775 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6776 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6777 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6778 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6779 vv(1)=pizda(1,1)-pizda(2,2)
6780 vv(2)=pizda(1,2)+pizda(2,1)
6781 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6783 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6785 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6787 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6788 C Derivatives in gamma(j-1) or gamma(l-1)
6791 s1=dipderg(3,jj,i)*dip(1,kk,k)
6793 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6794 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6795 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6796 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6797 vv(1)=pizda(1,1)-pizda(2,2)
6798 vv(2)=pizda(1,2)+pizda(2,1)
6799 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6802 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6804 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6807 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6808 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6810 C Derivatives in gamma(l-1) or gamma(j-1)
6813 s1=dip(1,jj,i)*dipderg(3,kk,k)
6815 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6816 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6817 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6818 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6819 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6820 vv(1)=pizda(1,1)-pizda(2,2)
6821 vv(2)=pizda(1,2)+pizda(2,1)
6822 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6825 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6827 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6830 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6831 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6833 C Cartesian derivatives.
6835 write (2,*) 'In eello6_graph2'
6837 write (2,*) 'iii=',iii
6839 write (2,*) 'kkk=',kkk
6841 write (2,'(3(2f10.5),5x)')
6842 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6852 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6854 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6857 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6859 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6860 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6862 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6863 call transpose2(EUg(1,1,k),auxmat(1,1))
6864 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6866 vv(1)=pizda(1,1)-pizda(2,2)
6867 vv(2)=pizda(1,2)+pizda(2,1)
6868 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6869 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6871 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6873 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6876 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6878 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6885 c----------------------------------------------------------------------------
6886 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6887 implicit real*8 (a-h,o-z)
6888 include 'DIMENSIONS'
6889 include 'DIMENSIONS.ZSCOPT'
6890 include 'COMMON.IOUNITS'
6891 include 'COMMON.CHAIN'
6892 include 'COMMON.DERIV'
6893 include 'COMMON.INTERACT'
6894 include 'COMMON.CONTACTS'
6895 include 'COMMON.TORSION'
6896 include 'COMMON.VAR'
6897 include 'COMMON.GEO'
6898 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6900 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6902 C Parallel Antiparallel C
6908 C j|/k\| / |/k\|l / C
6913 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6915 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6916 C energy moment and not to the cluster cumulant.
6917 iti=itortyp(itype(i))
6918 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6919 itj1=itortyp(itype(j+1))
6923 itk=itortyp(itype(k))
6924 itk1=itortyp(itype(k+1))
6925 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6926 itl1=itortyp(itype(l+1))
6931 s1=dip(4,jj,i)*dip(4,kk,k)
6933 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6934 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6935 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6936 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6937 call transpose2(EE(1,1,itk),auxmat(1,1))
6938 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6939 vv(1)=pizda(1,1)+pizda(2,2)
6940 vv(2)=pizda(2,1)-pizda(1,2)
6941 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6942 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6944 eello6_graph3=-(s1+s2+s3+s4)
6946 eello6_graph3=-(s2+s3+s4)
6949 if (.not. calc_grad) return
6950 C Derivatives in gamma(k-1)
6951 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6952 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6953 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6954 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6955 C Derivatives in gamma(l-1)
6956 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6957 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6958 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6959 vv(1)=pizda(1,1)+pizda(2,2)
6960 vv(2)=pizda(2,1)-pizda(1,2)
6961 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6962 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6963 C Cartesian derivatives.
6969 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6971 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6974 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6976 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6977 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6979 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6980 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,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),Ctobr(1,k))
6986 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6988 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6991 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6993 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6995 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7001 c----------------------------------------------------------------------------
7002 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7003 implicit real*8 (a-h,o-z)
7004 include 'DIMENSIONS'
7005 include 'DIMENSIONS.ZSCOPT'
7006 include 'COMMON.IOUNITS'
7007 include 'COMMON.CHAIN'
7008 include 'COMMON.DERIV'
7009 include 'COMMON.INTERACT'
7010 include 'COMMON.CONTACTS'
7011 include 'COMMON.TORSION'
7012 include 'COMMON.VAR'
7013 include 'COMMON.GEO'
7014 include 'COMMON.FFIELD'
7015 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7016 & auxvec1(2),auxmat1(2,2)
7018 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7020 C Parallel Antiparallel C
7026 C \ j|/k\| \ |/k\|l C
7031 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7033 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7034 C energy moment and not to the cluster cumulant.
7035 cd write (2,*) 'eello_graph4: wturn6',wturn6
7036 iti=itortyp(itype(i))
7037 itj=itortyp(itype(j))
7038 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7039 itj1=itortyp(itype(j+1))
7043 itk=itortyp(itype(k))
7044 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7045 itk1=itortyp(itype(k+1))
7049 itl=itortyp(itype(l))
7050 if (l.lt.nres-1) then
7051 itl1=itortyp(itype(l+1))
7055 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7056 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7057 cd & ' itl',itl,' itl1',itl1
7060 s1=dip(3,jj,i)*dip(3,kk,k)
7062 s1=dip(2,jj,j)*dip(2,kk,l)
7065 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7066 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7068 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7069 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7071 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7072 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7074 call transpose2(EUg(1,1,k),auxmat(1,1))
7075 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7076 vv(1)=pizda(1,1)-pizda(2,2)
7077 vv(2)=pizda(2,1)+pizda(1,2)
7078 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7079 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7081 eello6_graph4=-(s1+s2+s3+s4)
7083 eello6_graph4=-(s2+s3+s4)
7085 if (.not. calc_grad) return
7086 C Derivatives in gamma(i-1)
7090 s1=dipderg(2,jj,i)*dip(3,kk,k)
7092 s1=dipderg(4,jj,j)*dip(2,kk,l)
7095 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7097 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7098 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7100 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7101 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7103 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7104 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7105 cd write (2,*) 'turn6 derivatives'
7107 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7109 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7113 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7115 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7119 C Derivatives in gamma(k-1)
7122 s1=dip(3,jj,i)*dipderg(2,kk,k)
7124 s1=dip(2,jj,j)*dipderg(4,kk,l)
7127 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7128 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7130 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7131 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7133 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7134 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7136 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7137 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7138 vv(1)=pizda(1,1)-pizda(2,2)
7139 vv(2)=pizda(2,1)+pizda(1,2)
7140 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7141 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7143 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7145 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7149 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7151 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7154 C Derivatives in gamma(j-1) or gamma(l-1)
7155 if (l.eq.j+1 .and. l.gt.1) then
7156 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7157 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7158 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7159 vv(1)=pizda(1,1)-pizda(2,2)
7160 vv(2)=pizda(2,1)+pizda(1,2)
7161 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7162 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7163 else if (j.gt.1) then
7164 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7165 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7166 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7167 vv(1)=pizda(1,1)-pizda(2,2)
7168 vv(2)=pizda(2,1)+pizda(1,2)
7169 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7170 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7171 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7173 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7176 C Cartesian derivatives.
7183 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7185 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7189 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7191 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7195 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7197 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7199 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7200 & b1(1,itj1),auxvec(1))
7201 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7203 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7204 & b1(1,itl1),auxvec(1))
7205 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7207 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7209 vv(1)=pizda(1,1)-pizda(2,2)
7210 vv(2)=pizda(2,1)+pizda(1,2)
7211 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7213 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7215 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7218 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7221 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7224 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7226 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7228 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7232 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7234 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7237 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7239 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7247 c----------------------------------------------------------------------------
7248 double precision function eello_turn6(i,jj,kk)
7249 implicit real*8 (a-h,o-z)
7250 include 'DIMENSIONS'
7251 include 'DIMENSIONS.ZSCOPT'
7252 include 'COMMON.IOUNITS'
7253 include 'COMMON.CHAIN'
7254 include 'COMMON.DERIV'
7255 include 'COMMON.INTERACT'
7256 include 'COMMON.CONTACTS'
7257 include 'COMMON.TORSION'
7258 include 'COMMON.VAR'
7259 include 'COMMON.GEO'
7260 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7261 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7263 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7264 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7265 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7266 C the respective energy moment and not to the cluster cumulant.
7271 iti=itortyp(itype(i))
7272 itk=itortyp(itype(k))
7273 itk1=itortyp(itype(k+1))
7274 itl=itortyp(itype(l))
7275 itj=itortyp(itype(j))
7276 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7277 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7278 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7283 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7285 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7289 derx_turn(lll,kkk,iii)=0.0d0
7296 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7298 cd write (2,*) 'eello6_5',eello6_5
7300 call transpose2(AEA(1,1,1),auxmat(1,1))
7301 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7302 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7303 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7307 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7308 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7309 s2 = scalar2(b1(1,itk),vtemp1(1))
7311 call transpose2(AEA(1,1,2),atemp(1,1))
7312 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7313 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7314 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7318 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7319 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7320 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7322 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7323 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7324 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7325 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7326 ss13 = scalar2(b1(1,itk),vtemp4(1))
7327 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7331 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7337 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7339 C Derivatives in gamma(i+2)
7341 call transpose2(AEA(1,1,1),auxmatd(1,1))
7342 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7343 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7344 call transpose2(AEAderg(1,1,2),atempd(1,1))
7345 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7346 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7350 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7351 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7352 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7358 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7359 C Derivatives in gamma(i+3)
7361 call transpose2(AEA(1,1,1),auxmatd(1,1))
7362 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7363 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7364 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7368 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7369 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7370 s2d = scalar2(b1(1,itk),vtemp1d(1))
7372 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7373 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7375 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7377 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7378 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7379 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7389 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7390 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7392 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7393 & -0.5d0*ekont*(s2d+s12d)
7395 C Derivatives in gamma(i+4)
7396 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7397 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7398 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7400 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7401 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7402 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7412 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7414 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7416 C Derivatives in gamma(i+5)
7418 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7419 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7420 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7424 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7425 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7426 s2d = scalar2(b1(1,itk),vtemp1d(1))
7428 call transpose2(AEA(1,1,2),atempd(1,1))
7429 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7430 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7434 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7435 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7437 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7438 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7439 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7449 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7450 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7452 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7453 & -0.5d0*ekont*(s2d+s12d)
7455 C Cartesian derivatives
7460 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7461 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7462 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7466 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7467 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7469 s2d = scalar2(b1(1,itk),vtemp1d(1))
7471 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7472 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7473 s8d = -(atempd(1,1)+atempd(2,2))*
7474 & scalar2(cc(1,1,itl),vtemp2(1))
7478 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7480 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7481 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7488 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7491 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7495 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7496 & - 0.5d0*(s8d+s12d)
7498 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7507 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7509 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7510 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7511 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7512 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7513 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7515 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7516 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7517 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7521 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7522 cd & 16*eel_turn6_num
7524 if (j.lt.nres-1) then
7531 if (l.lt.nres-1) then
7539 ggg1(ll)=eel_turn6*g_contij(ll,1)
7540 ggg2(ll)=eel_turn6*g_contij(ll,2)
7541 ghalf=0.5d0*ggg1(ll)
7543 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7544 & +ekont*derx_turn(ll,2,1)
7545 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7546 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7547 & +ekont*derx_turn(ll,4,1)
7548 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7549 ghalf=0.5d0*ggg2(ll)
7551 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7552 & +ekont*derx_turn(ll,2,2)
7553 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7554 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7555 & +ekont*derx_turn(ll,4,2)
7556 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7561 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7566 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7572 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7577 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7581 cd write (2,*) iii,g_corr6_loc(iii)
7584 eello_turn6=ekont*eel_turn6
7585 cd write (2,*) 'ekont',ekont
7586 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7589 crc-------------------------------------------------
7590 SUBROUTINE MATVEC2(A1,V1,V2)
7591 implicit real*8 (a-h,o-z)
7592 include 'DIMENSIONS'
7593 DIMENSION A1(2,2),V1(2),V2(2)
7597 c 3 VI=VI+A1(I,K)*V1(K)
7601 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7602 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7607 C---------------------------------------
7608 SUBROUTINE MATMAT2(A1,A2,A3)
7609 implicit real*8 (a-h,o-z)
7610 include 'DIMENSIONS'
7611 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7612 c DIMENSION AI3(2,2)
7616 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7622 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7623 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7624 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7625 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7633 c-------------------------------------------------------------------------
7634 double precision function scalar2(u,v)
7636 double precision u(2),v(2)
7639 scalar2=u(1)*v(1)+u(2)*v(2)
7643 C-----------------------------------------------------------------------------
7645 subroutine transpose2(a,at)
7647 double precision a(2,2),at(2,2)
7654 c--------------------------------------------------------------------------
7655 subroutine transpose(n,a,at)
7658 double precision a(n,n),at(n,n)
7666 C---------------------------------------------------------------------------
7667 subroutine prodmat3(a1,a2,kk,transp,prod)
7670 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7672 crc double precision auxmat(2,2),prod_(2,2)
7675 crc call transpose2(kk(1,1),auxmat(1,1))
7676 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7677 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7679 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7680 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7681 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7682 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7683 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7684 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7685 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7686 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7689 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7690 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7692 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7693 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7694 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7695 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7696 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7697 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7698 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7699 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7702 c call transpose2(a2(1,1),a2t(1,1))
7705 crc print *,((prod_(i,j),i=1,2),j=1,2)
7706 crc print *,((prod(i,j),i=1,2),j=1,2)
7710 C-----------------------------------------------------------------------------
7711 double precision function scalar(u,v)
7713 double precision u(3),v(3)
7723 C-----------------------------------------------------------------------
7724 double precision function sscale(r)
7725 double precision r,gamm
7726 include "COMMON.SPLITELE"
7727 if(r.lt.r_cut-rlamb) then
7729 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7730 gamm=(r-(r_cut-rlamb))/rlamb
7731 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7737 C-----------------------------------------------------------------------
7738 C-----------------------------------------------------------------------
7739 double precision function sscagrad(r)
7740 double precision r,gamm
7741 include "COMMON.SPLITELE"
7742 if(r.lt.r_cut-rlamb) then
7744 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7745 gamm=(r-(r_cut-rlamb))/rlamb
7746 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7752 C-----------------------------------------------------------------------