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) cycle
1915 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1916 & .or. itype(i+2).eq.ntyp1
1917 & .or. itype(i-1).eq.ntyp1
1920 if (itel(i).eq.0) goto 1215
1924 dx_normi=dc_norm(1,i)
1925 dy_normi=dc_norm(2,i)
1926 dz_normi=dc_norm(3,i)
1927 xmedi=c(1,i)+0.5d0*dxi
1928 ymedi=c(2,i)+0.5d0*dyi
1929 zmedi=c(3,i)+0.5d0*dzi
1930 xmedi=mod(xmedi,boxxsize)
1931 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1932 ymedi=mod(ymedi,boxysize)
1933 if (ymedi.lt.0) ymedi=ymedi+boxysize
1934 zmedi=mod(zmedi,boxzsize)
1935 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1937 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1938 do j=ielstart(i),ielend(i)
1940 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1941 & .or.itype(j+2).eq.ntyp1
1944 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1945 & .or.itype(j+2).eq.ntyp1
1946 & .or.itype(j-1).eq.ntyp1
1951 if (itel(j).eq.0) goto 1216
1955 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1956 aaa=app(iteli,itelj)
1957 bbb=bpp(iteli,itelj)
1958 C Diagnostics only!!!
1964 ael6i=ael6(iteli,itelj)
1965 ael3i=ael3(iteli,itelj)
1969 dx_normj=dc_norm(1,j)
1970 dy_normj=dc_norm(2,j)
1971 dz_normj=dc_norm(3,j)
1976 if (xj.lt.0) xj=xj+boxxsize
1978 if (yj.lt.0) yj=yj+boxysize
1980 if (zj.lt.0) zj=zj+boxzsize
1981 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
1989 xj=xj_safe+xshift*boxxsize
1990 yj=yj_safe+yshift*boxysize
1991 zj=zj_safe+zshift*boxzsize
1992 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
1993 if(dist_temp.lt.dist_init) then
2003 if (isubchap.eq.1) then
2012 rij=xj*xj+yj*yj+zj*zj
2013 sss=sscale(sqrt(rij))
2014 sssgrad=sscagrad(sqrt(rij))
2020 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2021 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2022 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2023 fac=cosa-3.0D0*cosb*cosg
2025 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2026 if (j.eq.i+2) ev1=scal_el*ev1
2031 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2034 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2035 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2036 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2038 evdw1=evdw1+evdwij*sss
2039 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2040 c &'evdw1',i,j,evdwij
2041 c &,iteli,itelj,aaa,evdw1
2043 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2044 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2045 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2046 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2047 c & xmedi,ymedi,zmedi,xj,yj,zj
2049 C Calculate contributions to the Cartesian gradient.
2052 facvdw=-6*rrmij*(ev1+evdwij)*sss
2053 facel=-3*rrmij*(el1+eesij)
2060 * Radial derivatives. First process both termini of the fragment (i,j)
2067 gelc(k,i)=gelc(k,i)+ghalf
2068 gelc(k,j)=gelc(k,j)+ghalf
2071 * Loop over residues i+1 thru j-1.
2075 gelc(l,k)=gelc(l,k)+ggg(l)
2081 if (sss.gt.0.0) then
2082 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2083 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2084 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2092 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2093 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2096 * Loop over residues i+1 thru j-1.
2100 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2104 facvdw=(ev1+evdwij)*sss
2107 fac=-3*rrmij*(facvdw+facvdw+facel)
2113 * Radial derivatives. First process both termini of the fragment (i,j)
2120 gelc(k,i)=gelc(k,i)+ghalf
2121 gelc(k,j)=gelc(k,j)+ghalf
2124 * Loop over residues i+1 thru j-1.
2128 gelc(l,k)=gelc(l,k)+ggg(l)
2135 ecosa=2.0D0*fac3*fac1+fac4
2138 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2139 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2141 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2142 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2144 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2145 cd & (dcosg(k),k=1,3)
2147 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2151 gelc(k,i)=gelc(k,i)+ghalf
2152 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2153 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2154 gelc(k,j)=gelc(k,j)+ghalf
2155 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2156 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2160 gelc(l,k)=gelc(l,k)+ggg(l)
2165 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2166 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2167 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2169 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2170 C energy of a peptide unit is assumed in the form of a second-order
2171 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2172 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2173 C are computed for EVERY pair of non-contiguous peptide groups.
2175 if (j.lt.nres-1) then
2186 muij(kkk)=mu(k,i)*mu(l,j)
2189 cd write (iout,*) 'EELEC: i',i,' j',j
2190 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2191 cd write(iout,*) 'muij',muij
2192 ury=scalar(uy(1,i),erij)
2193 urz=scalar(uz(1,i),erij)
2194 vry=scalar(uy(1,j),erij)
2195 vrz=scalar(uz(1,j),erij)
2196 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2197 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2198 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2199 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2200 C For diagnostics only
2205 fac=dsqrt(-ael6i)*r3ij
2206 cd write (2,*) 'fac=',fac
2207 C For diagnostics only
2213 cd write (iout,'(4i5,4f10.5)')
2214 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2215 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2216 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2217 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2218 cd write (iout,'(4f10.5)')
2219 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2220 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2221 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2222 cd write (iout,'(2i3,9f10.5/)') i,j,
2223 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2225 C Derivatives of the elements of A in virtual-bond vectors
2226 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2233 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2234 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2235 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2236 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2237 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2238 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2239 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2240 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2241 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2242 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2243 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2244 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2254 C Compute radial contributions to the gradient
2276 C Add the contributions coming from er
2279 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2280 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2281 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2282 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2285 C Derivatives in DC(i)
2286 ghalf1=0.5d0*agg(k,1)
2287 ghalf2=0.5d0*agg(k,2)
2288 ghalf3=0.5d0*agg(k,3)
2289 ghalf4=0.5d0*agg(k,4)
2290 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2291 & -3.0d0*uryg(k,2)*vry)+ghalf1
2292 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2293 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2294 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2295 & -3.0d0*urzg(k,2)*vry)+ghalf3
2296 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2297 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2298 C Derivatives in DC(i+1)
2299 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2300 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2301 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2302 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2303 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2304 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2305 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2306 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2307 C Derivatives in DC(j)
2308 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2309 & -3.0d0*vryg(k,2)*ury)+ghalf1
2310 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2311 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2312 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2313 & -3.0d0*vryg(k,2)*urz)+ghalf3
2314 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2315 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2316 C Derivatives in DC(j+1) or DC(nres-1)
2317 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2318 & -3.0d0*vryg(k,3)*ury)
2319 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2320 & -3.0d0*vrzg(k,3)*ury)
2321 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2322 & -3.0d0*vryg(k,3)*urz)
2323 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2324 & -3.0d0*vrzg(k,3)*urz)
2329 C Derivatives in DC(i+1)
2330 cd aggi1(k,1)=agg(k,1)
2331 cd aggi1(k,2)=agg(k,2)
2332 cd aggi1(k,3)=agg(k,3)
2333 cd aggi1(k,4)=agg(k,4)
2334 C Derivatives in DC(j)
2339 C Derivatives in DC(j+1)
2344 if (j.eq.nres-1 .and. i.lt.j-2) then
2346 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2347 cd aggj1(k,l)=agg(k,l)
2353 C Check the loc-el terms by numerical integration
2363 aggi(k,l)=-aggi(k,l)
2364 aggi1(k,l)=-aggi1(k,l)
2365 aggj(k,l)=-aggj(k,l)
2366 aggj1(k,l)=-aggj1(k,l)
2369 if (j.lt.nres-1) then
2375 aggi(k,l)=-aggi(k,l)
2376 aggi1(k,l)=-aggi1(k,l)
2377 aggj(k,l)=-aggj(k,l)
2378 aggj1(k,l)=-aggj1(k,l)
2389 aggi(k,l)=-aggi(k,l)
2390 aggi1(k,l)=-aggi1(k,l)
2391 aggj(k,l)=-aggj(k,l)
2392 aggj1(k,l)=-aggj1(k,l)
2398 IF (wel_loc.gt.0.0d0) THEN
2399 C Contribution to the local-electrostatic energy coming from the i-j pair
2400 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2402 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2403 c write (iout,'(a6,2i5,0pf7.3)')
2404 c & 'eelloc',i,j,eel_loc_ij
2405 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2406 eel_loc=eel_loc+eel_loc_ij
2407 C Partial derivatives in virtual-bond dihedral angles gamma
2410 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2411 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2412 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2413 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2414 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2415 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2416 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2417 cd write(iout,*) 'agg ',agg
2418 cd write(iout,*) 'aggi ',aggi
2419 cd write(iout,*) 'aggi1',aggi1
2420 cd write(iout,*) 'aggj ',aggj
2421 cd write(iout,*) 'aggj1',aggj1
2423 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2425 ggg(l)=agg(l,1)*muij(1)+
2426 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2430 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2433 C Remaining derivatives of eello
2435 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2436 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2437 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2438 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2439 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2440 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2441 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2442 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2446 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2447 C Contributions from turns
2452 call eturn34(i,j,eello_turn3,eello_turn4)
2454 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2455 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2457 C Calculate the contact function. The ith column of the array JCONT will
2458 C contain the numbers of atoms that make contacts with the atom I (of numbers
2459 C greater than I). The arrays FACONT and GACONT will contain the values of
2460 C the contact function and its derivative.
2461 c r0ij=1.02D0*rpp(iteli,itelj)
2462 c r0ij=1.11D0*rpp(iteli,itelj)
2463 r0ij=2.20D0*rpp(iteli,itelj)
2464 c r0ij=1.55D0*rpp(iteli,itelj)
2465 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2466 if (fcont.gt.0.0D0) then
2467 num_conti=num_conti+1
2468 if (num_conti.gt.maxconts) then
2469 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2470 & ' will skip next contacts for this conf.'
2472 jcont_hb(num_conti,i)=j
2473 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2474 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2475 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2477 d_cont(num_conti,i)=rij
2478 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2479 C --- Electrostatic-interaction matrix ---
2480 a_chuj(1,1,num_conti,i)=a22
2481 a_chuj(1,2,num_conti,i)=a23
2482 a_chuj(2,1,num_conti,i)=a32
2483 a_chuj(2,2,num_conti,i)=a33
2484 C --- Gradient of rij
2486 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2489 c a_chuj(1,1,num_conti,i)=-0.61d0
2490 c a_chuj(1,2,num_conti,i)= 0.4d0
2491 c a_chuj(2,1,num_conti,i)= 0.65d0
2492 c a_chuj(2,2,num_conti,i)= 0.50d0
2493 c else if (i.eq.2) then
2494 c a_chuj(1,1,num_conti,i)= 0.0d0
2495 c a_chuj(1,2,num_conti,i)= 0.0d0
2496 c a_chuj(2,1,num_conti,i)= 0.0d0
2497 c a_chuj(2,2,num_conti,i)= 0.0d0
2499 C --- and its gradients
2500 cd write (iout,*) 'i',i,' j',j
2502 cd write (iout,*) 'iii 1 kkk',kkk
2503 cd write (iout,*) agg(kkk,:)
2506 cd write (iout,*) 'iii 2 kkk',kkk
2507 cd write (iout,*) aggi(kkk,:)
2510 cd write (iout,*) 'iii 3 kkk',kkk
2511 cd write (iout,*) aggi1(kkk,:)
2514 cd write (iout,*) 'iii 4 kkk',kkk
2515 cd write (iout,*) aggj(kkk,:)
2518 cd write (iout,*) 'iii 5 kkk',kkk
2519 cd write (iout,*) aggj1(kkk,:)
2526 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2527 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2528 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2529 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2530 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2532 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2538 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2539 C Calculate contact energies
2541 wij=cosa-3.0D0*cosb*cosg
2544 c fac3=dsqrt(-ael6i)/r0ij**3
2545 fac3=dsqrt(-ael6i)*r3ij
2546 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2547 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2549 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2550 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2551 C Diagnostics. Comment out or remove after debugging!
2552 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2553 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2554 c ees0m(num_conti,i)=0.0D0
2556 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2557 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2558 facont_hb(num_conti,i)=fcont
2560 C Angular derivatives of the contact function
2561 ees0pij1=fac3/ees0pij
2562 ees0mij1=fac3/ees0mij
2563 fac3p=-3.0D0*fac3*rrmij
2564 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2565 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2567 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2568 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2569 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2570 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2571 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2572 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2573 ecosap=ecosa1+ecosa2
2574 ecosbp=ecosb1+ecosb2
2575 ecosgp=ecosg1+ecosg2
2576 ecosam=ecosa1-ecosa2
2577 ecosbm=ecosb1-ecosb2
2578 ecosgm=ecosg1-ecosg2
2587 fprimcont=fprimcont/rij
2588 cd facont_hb(num_conti,i)=1.0D0
2589 C Following line is for diagnostics.
2592 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2593 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2596 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2597 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2599 gggp(1)=gggp(1)+ees0pijp*xj
2600 gggp(2)=gggp(2)+ees0pijp*yj
2601 gggp(3)=gggp(3)+ees0pijp*zj
2602 gggm(1)=gggm(1)+ees0mijp*xj
2603 gggm(2)=gggm(2)+ees0mijp*yj
2604 gggm(3)=gggm(3)+ees0mijp*zj
2605 C Derivatives due to the contact function
2606 gacont_hbr(1,num_conti,i)=fprimcont*xj
2607 gacont_hbr(2,num_conti,i)=fprimcont*yj
2608 gacont_hbr(3,num_conti,i)=fprimcont*zj
2610 ghalfp=0.5D0*gggp(k)
2611 ghalfm=0.5D0*gggm(k)
2612 gacontp_hb1(k,num_conti,i)=ghalfp
2613 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2614 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2615 gacontp_hb2(k,num_conti,i)=ghalfp
2616 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2617 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2618 gacontp_hb3(k,num_conti,i)=gggp(k)
2619 gacontm_hb1(k,num_conti,i)=ghalfm
2620 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2621 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2622 gacontm_hb2(k,num_conti,i)=ghalfm
2623 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2624 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2625 gacontm_hb3(k,num_conti,i)=gggm(k)
2628 C Diagnostics. Comment out or remove after debugging!
2630 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2631 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2632 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2633 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2634 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2635 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2638 endif ! num_conti.le.maxconts
2643 num_cont_hb(i)=num_conti
2647 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2648 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2650 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2651 ccc eel_loc=eel_loc+eello_turn3
2654 C-----------------------------------------------------------------------------
2655 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2656 C Third- and fourth-order contributions from turns
2657 implicit real*8 (a-h,o-z)
2658 include 'DIMENSIONS'
2659 include 'DIMENSIONS.ZSCOPT'
2660 include 'COMMON.IOUNITS'
2661 include 'COMMON.GEO'
2662 include 'COMMON.VAR'
2663 include 'COMMON.LOCAL'
2664 include 'COMMON.CHAIN'
2665 include 'COMMON.DERIV'
2666 include 'COMMON.INTERACT'
2667 include 'COMMON.CONTACTS'
2668 include 'COMMON.TORSION'
2669 include 'COMMON.VECTORS'
2670 include 'COMMON.FFIELD'
2672 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2673 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2674 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2675 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2676 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2677 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2681 C Third-order contributions
2688 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2689 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2690 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2691 call transpose2(auxmat(1,1),auxmat1(1,1))
2692 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2693 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2694 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2695 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2696 cd & ' eello_turn3_num',4*eello_turn3_num
2698 C Derivatives in gamma(i)
2699 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2700 call transpose2(auxmat2(1,1),pizda(1,1))
2701 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2702 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2703 C Derivatives in gamma(i+1)
2704 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2705 call transpose2(auxmat2(1,1),pizda(1,1))
2706 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2707 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2708 & +0.5d0*(pizda(1,1)+pizda(2,2))
2709 C Cartesian derivatives
2711 a_temp(1,1)=aggi(l,1)
2712 a_temp(1,2)=aggi(l,2)
2713 a_temp(2,1)=aggi(l,3)
2714 a_temp(2,2)=aggi(l,4)
2715 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2716 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2717 & +0.5d0*(pizda(1,1)+pizda(2,2))
2718 a_temp(1,1)=aggi1(l,1)
2719 a_temp(1,2)=aggi1(l,2)
2720 a_temp(2,1)=aggi1(l,3)
2721 a_temp(2,2)=aggi1(l,4)
2722 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2723 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2724 & +0.5d0*(pizda(1,1)+pizda(2,2))
2725 a_temp(1,1)=aggj(l,1)
2726 a_temp(1,2)=aggj(l,2)
2727 a_temp(2,1)=aggj(l,3)
2728 a_temp(2,2)=aggj(l,4)
2729 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2730 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2731 & +0.5d0*(pizda(1,1)+pizda(2,2))
2732 a_temp(1,1)=aggj1(l,1)
2733 a_temp(1,2)=aggj1(l,2)
2734 a_temp(2,1)=aggj1(l,3)
2735 a_temp(2,2)=aggj1(l,4)
2736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2737 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2738 & +0.5d0*(pizda(1,1)+pizda(2,2))
2741 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2744 C Fourth-order contributions
2752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2753 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2754 iti1=itortyp(itype(i+1))
2755 iti2=itortyp(itype(i+2))
2756 iti3=itortyp(itype(i+3))
2757 call transpose2(EUg(1,1,i+1),e1t(1,1))
2758 call transpose2(Eug(1,1,i+2),e2t(1,1))
2759 call transpose2(Eug(1,1,i+3),e3t(1,1))
2760 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2761 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2762 s1=scalar2(b1(1,iti2),auxvec(1))
2763 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2764 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2765 s2=scalar2(b1(1,iti1),auxvec(1))
2766 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2767 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2768 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2769 eello_turn4=eello_turn4-(s1+s2+s3)
2770 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2771 cd & ' eello_turn4_num',8*eello_turn4_num
2772 C Derivatives in gamma(i)
2774 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2775 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2776 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2777 s1=scalar2(b1(1,iti2),auxvec(1))
2778 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2780 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2781 C Derivatives in gamma(i+1)
2782 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2783 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2784 s2=scalar2(b1(1,iti1),auxvec(1))
2785 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2786 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2787 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2788 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2789 C Derivatives in gamma(i+2)
2790 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2791 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2792 s1=scalar2(b1(1,iti2),auxvec(1))
2793 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2794 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2795 s2=scalar2(b1(1,iti1),auxvec(1))
2796 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2797 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2798 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2799 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2800 C Cartesian derivatives
2801 C Derivatives of this turn contributions in DC(i+2)
2802 if (j.lt.nres-1) then
2804 a_temp(1,1)=agg(l,1)
2805 a_temp(1,2)=agg(l,2)
2806 a_temp(2,1)=agg(l,3)
2807 a_temp(2,2)=agg(l,4)
2808 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2809 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2810 s1=scalar2(b1(1,iti2),auxvec(1))
2811 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2812 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2813 s2=scalar2(b1(1,iti1),auxvec(1))
2814 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2815 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2816 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2818 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2821 C Remaining derivatives of this turn contribution
2823 a_temp(1,1)=aggi(l,1)
2824 a_temp(1,2)=aggi(l,2)
2825 a_temp(2,1)=aggi(l,3)
2826 a_temp(2,2)=aggi(l,4)
2827 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2828 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2829 s1=scalar2(b1(1,iti2),auxvec(1))
2830 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2831 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2832 s2=scalar2(b1(1,iti1),auxvec(1))
2833 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2834 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2835 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2836 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2837 a_temp(1,1)=aggi1(l,1)
2838 a_temp(1,2)=aggi1(l,2)
2839 a_temp(2,1)=aggi1(l,3)
2840 a_temp(2,2)=aggi1(l,4)
2841 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2842 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2843 s1=scalar2(b1(1,iti2),auxvec(1))
2844 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2845 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2846 s2=scalar2(b1(1,iti1),auxvec(1))
2847 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2848 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2849 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2850 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2851 a_temp(1,1)=aggj(l,1)
2852 a_temp(1,2)=aggj(l,2)
2853 a_temp(2,1)=aggj(l,3)
2854 a_temp(2,2)=aggj(l,4)
2855 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2856 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2857 s1=scalar2(b1(1,iti2),auxvec(1))
2858 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2859 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2860 s2=scalar2(b1(1,iti1),auxvec(1))
2861 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2862 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2863 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2864 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2865 a_temp(1,1)=aggj1(l,1)
2866 a_temp(1,2)=aggj1(l,2)
2867 a_temp(2,1)=aggj1(l,3)
2868 a_temp(2,2)=aggj1(l,4)
2869 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2870 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2871 s1=scalar2(b1(1,iti2),auxvec(1))
2872 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2873 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2874 s2=scalar2(b1(1,iti1),auxvec(1))
2875 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2876 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2877 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2878 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2884 C-----------------------------------------------------------------------------
2885 subroutine vecpr(u,v,w)
2886 implicit real*8(a-h,o-z)
2887 dimension u(3),v(3),w(3)
2888 w(1)=u(2)*v(3)-u(3)*v(2)
2889 w(2)=-u(1)*v(3)+u(3)*v(1)
2890 w(3)=u(1)*v(2)-u(2)*v(1)
2893 C-----------------------------------------------------------------------------
2894 subroutine unormderiv(u,ugrad,unorm,ungrad)
2895 C This subroutine computes the derivatives of a normalized vector u, given
2896 C the derivatives computed without normalization conditions, ugrad. Returns
2899 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2900 double precision vec(3)
2901 double precision scalar
2903 c write (2,*) 'ugrad',ugrad
2906 vec(i)=scalar(ugrad(1,i),u(1))
2908 c write (2,*) 'vec',vec
2911 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2914 c write (2,*) 'ungrad',ungrad
2917 C-----------------------------------------------------------------------------
2918 subroutine escp(evdw2,evdw2_14)
2920 C This subroutine calculates the excluded-volume interaction energy between
2921 C peptide-group centers and side chains and its gradient in virtual-bond and
2922 C side-chain vectors.
2924 implicit real*8 (a-h,o-z)
2925 include 'DIMENSIONS'
2926 include 'DIMENSIONS.ZSCOPT'
2927 include 'COMMON.GEO'
2928 include 'COMMON.VAR'
2929 include 'COMMON.LOCAL'
2930 include 'COMMON.CHAIN'
2931 include 'COMMON.DERIV'
2932 include 'COMMON.INTERACT'
2933 include 'COMMON.FFIELD'
2934 include 'COMMON.IOUNITS'
2938 cd print '(a)','Enter ESCP'
2939 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2940 c & ' scal14',scal14
2941 do i=iatscp_s,iatscp_e
2942 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2944 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2945 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2946 if (iteli.eq.0) goto 1225
2947 xi=0.5D0*(c(1,i)+c(1,i+1))
2948 yi=0.5D0*(c(2,i)+c(2,i+1))
2949 zi=0.5D0*(c(3,i)+c(3,i+1))
2950 C Returning the ith atom to box
2952 if (xi.lt.0) xi=xi+boxxsize
2954 if (yi.lt.0) yi=yi+boxysize
2956 if (zi.lt.0) zi=zi+boxzsize
2957 do iint=1,nscp_gr(i)
2959 do j=iscpstart(i,iint),iscpend(i,iint)
2960 itypj=iabs(itype(j))
2961 if (itypj.eq.ntyp1) cycle
2962 C Uncomment following three lines for SC-p interactions
2966 C Uncomment following three lines for Ca-p interactions
2970 C returning the jth atom to box
2972 if (xj.lt.0) xj=xj+boxxsize
2974 if (yj.lt.0) yj=yj+boxysize
2976 if (zj.lt.0) zj=zj+boxzsize
2977 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2982 C Finding the closest jth atom
2986 xj=xj_safe+xshift*boxxsize
2987 yj=yj_safe+yshift*boxysize
2988 zj=zj_safe+zshift*boxzsize
2989 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2990 if(dist_temp.lt.dist_init) then
3000 if (subchap.eq.1) then
3009 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3010 C sss is scaling function for smoothing the cutoff gradient otherwise
3011 C the gradient would not be continuouse
3012 sss=sscale(1.0d0/(dsqrt(rrij)))
3013 if (sss.le.0.0d0) cycle
3014 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3016 e1=fac*fac*aad(itypj,iteli)
3017 e2=fac*bad(itypj,iteli)
3018 if (iabs(j-i) .le. 2) then
3021 evdw2_14=evdw2_14+(e1+e2)*sss
3024 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3025 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3026 c & bad(itypj,iteli)
3027 evdw2=evdw2+evdwij*sss
3030 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3032 fac=-(evdwij+e1)*rrij*sss
3033 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3038 cd write (iout,*) 'j<i'
3039 C Uncomment following three lines for SC-p interactions
3041 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3044 cd write (iout,*) 'j>i'
3047 C Uncomment following line for SC-p interactions
3048 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3052 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3056 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3057 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3060 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3070 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3071 gradx_scp(j,i)=expon*gradx_scp(j,i)
3074 C******************************************************************************
3078 C To save time the factor EXPON has been extracted from ALL components
3079 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3082 C******************************************************************************
3085 C--------------------------------------------------------------------------
3086 subroutine edis(ehpb)
3088 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3090 implicit real*8 (a-h,o-z)
3091 include 'DIMENSIONS'
3092 include 'DIMENSIONS.ZSCOPT'
3093 include 'COMMON.SBRIDGE'
3094 include 'COMMON.CHAIN'
3095 include 'COMMON.DERIV'
3096 include 'COMMON.VAR'
3097 include 'COMMON.INTERACT'
3100 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3101 cd print *,'link_start=',link_start,' link_end=',link_end
3102 if (link_end.eq.0) return
3103 do i=link_start,link_end
3104 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3105 C CA-CA distance used in regularization of structure.
3108 C iii and jjj point to the residues for which the distance is assigned.
3109 if (ii.gt.nres) then
3116 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3117 C distance and angle dependent SS bond potential.
3118 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3119 & iabs(itype(jjj)).eq.1) then
3120 call ssbond_ene(iii,jjj,eij)
3123 C Calculate the distance between the two points and its difference from the
3127 C Get the force constant corresponding to this distance.
3129 C Calculate the contribution to energy.
3130 ehpb=ehpb+waga*rdis*rdis
3132 C Evaluate gradient.
3135 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3136 cd & ' waga=',waga,' fac=',fac
3138 ggg(j)=fac*(c(j,jj)-c(j,ii))
3140 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3141 C If this is a SC-SC distance, we need to calculate the contributions to the
3142 C Cartesian gradient in the SC vectors (ghpbx).
3145 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3146 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3151 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3159 C--------------------------------------------------------------------------
3160 subroutine ssbond_ene(i,j,eij)
3162 C Calculate the distance and angle dependent SS-bond potential energy
3163 C using a free-energy function derived based on RHF/6-31G** ab initio
3164 C calculations of diethyl disulfide.
3166 C A. Liwo and U. Kozlowska, 11/24/03
3168 implicit real*8 (a-h,o-z)
3169 include 'DIMENSIONS'
3170 include 'DIMENSIONS.ZSCOPT'
3171 include 'COMMON.SBRIDGE'
3172 include 'COMMON.CHAIN'
3173 include 'COMMON.DERIV'
3174 include 'COMMON.LOCAL'
3175 include 'COMMON.INTERACT'
3176 include 'COMMON.VAR'
3177 include 'COMMON.IOUNITS'
3178 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3179 itypi=iabs(itype(i))
3183 dxi=dc_norm(1,nres+i)
3184 dyi=dc_norm(2,nres+i)
3185 dzi=dc_norm(3,nres+i)
3186 dsci_inv=dsc_inv(itypi)
3187 itypj=iabs(itype(j))
3188 dscj_inv=dsc_inv(itypj)
3192 dxj=dc_norm(1,nres+j)
3193 dyj=dc_norm(2,nres+j)
3194 dzj=dc_norm(3,nres+j)
3195 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3200 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3201 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3202 om12=dxi*dxj+dyi*dyj+dzi*dzj
3204 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3205 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3211 deltat12=om2-om1+2.0d0
3213 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3214 & +akct*deltad*deltat12
3215 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3216 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3217 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3218 c & " deltat12",deltat12," eij",eij
3219 ed=2*akcm*deltad+akct*deltat12
3221 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3222 eom1=-2*akth*deltat1-pom1-om2*pom2
3223 eom2= 2*akth*deltat2+pom1-om1*pom2
3226 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3229 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3230 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3231 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3232 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3235 C Calculate the components of the gradient in DC and X
3239 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3244 C--------------------------------------------------------------------------
3245 subroutine ebond(estr)
3247 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3249 implicit real*8 (a-h,o-z)
3250 include 'DIMENSIONS'
3251 include 'DIMENSIONS.ZSCOPT'
3252 include 'COMMON.LOCAL'
3253 include 'COMMON.GEO'
3254 include 'COMMON.INTERACT'
3255 include 'COMMON.DERIV'
3256 include 'COMMON.VAR'
3257 include 'COMMON.CHAIN'
3258 include 'COMMON.IOUNITS'
3259 include 'COMMON.NAMES'
3260 include 'COMMON.FFIELD'
3261 include 'COMMON.CONTROL'
3262 logical energy_dec /.false./
3263 double precision u(3),ud(3)
3266 c write (iout,*) "distchainmax",distchainmax
3268 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3269 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3271 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3272 C & *dc(j,i-1)/vbld(i)
3274 C if (energy_dec) write(iout,*)
3275 C & "estr1",i,vbld(i),distchainmax,
3276 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3278 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3279 diff = vbld(i)-vbldpDUM
3281 diff = vbld(i)-vbldp0
3282 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3286 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3289 C write (iout,'(a7,i5,4f7.3)')
3290 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3292 estr=0.5d0*AKP*estr+estr1
3294 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3298 if (iti.ne.10 .and. iti.ne.ntyp1) then
3301 diff=vbld(i+nres)-vbldsc0(1,iti)
3302 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3303 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3304 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3306 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3310 diff=vbld(i+nres)-vbldsc0(j,iti)
3311 ud(j)=aksc(j,iti)*diff
3312 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3326 uprod2=uprod2*u(k)*u(k)
3330 usumsqder=usumsqder+ud(j)*uprod2
3332 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3333 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3334 estr=estr+uprod/usum
3336 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3344 C--------------------------------------------------------------------------
3345 subroutine ebend(etheta)
3347 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3348 C angles gamma and its derivatives in consecutive thetas and gammas.
3350 implicit real*8 (a-h,o-z)
3351 include 'DIMENSIONS'
3352 include 'DIMENSIONS.ZSCOPT'
3353 include 'COMMON.LOCAL'
3354 include 'COMMON.GEO'
3355 include 'COMMON.INTERACT'
3356 include 'COMMON.DERIV'
3357 include 'COMMON.VAR'
3358 include 'COMMON.CHAIN'
3359 include 'COMMON.IOUNITS'
3360 include 'COMMON.NAMES'
3361 include 'COMMON.FFIELD'
3362 common /calcthet/ term1,term2,termm,diffak,ratak,
3363 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3364 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3365 double precision y(2),z(2)
3367 time11=dexp(-2*time)
3370 c write (iout,*) "nres",nres
3371 c write (*,'(a,i2)') 'EBEND ICG=',icg
3372 c write (iout,*) ithet_start,ithet_end
3373 do i=ithet_start,ithet_end
3374 C if (itype(i-1).eq.ntyp1) cycle
3376 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3377 & .or.itype(i).eq.ntyp1) cycle
3378 C Zero the energy function and its derivative at 0 or pi.
3379 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3381 ichir1=isign(1,itype(i-2))
3382 ichir2=isign(1,itype(i))
3383 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3384 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3385 if (itype(i-1).eq.10) then
3386 itype1=isign(10,itype(i-2))
3387 ichir11=isign(1,itype(i-2))
3388 ichir12=isign(1,itype(i-2))
3389 itype2=isign(10,itype(i))
3390 ichir21=isign(1,itype(i))
3391 ichir22=isign(1,itype(i))
3398 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3402 call proc_proc(phii,icrc)
3403 if (icrc.eq.1) phii=150.0
3414 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3418 call proc_proc(phii1,icrc)
3419 if (icrc.eq.1) phii1=150.0
3431 C Calculate the "mean" value of theta from the part of the distribution
3432 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3433 C In following comments this theta will be referred to as t_c.
3434 thet_pred_mean=0.0d0
3436 athetk=athet(k,it,ichir1,ichir2)
3437 bthetk=bthet(k,it,ichir1,ichir2)
3439 athetk=athet(k,itype1,ichir11,ichir12)
3440 bthetk=bthet(k,itype2,ichir21,ichir22)
3442 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3444 c write (iout,*) "thet_pred_mean",thet_pred_mean
3445 dthett=thet_pred_mean*ssd
3446 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3447 c write (iout,*) "thet_pred_mean",thet_pred_mean
3448 C Derivatives of the "mean" values in gamma1 and gamma2.
3449 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3450 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3451 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3452 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3454 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3455 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3456 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3457 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3459 if (theta(i).gt.pi-delta) then
3460 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3462 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3463 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3464 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3466 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3468 else if (theta(i).lt.delta) then
3469 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3470 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3471 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3473 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3474 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3477 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3480 etheta=etheta+ethetai
3481 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3482 c & 'ebend',i,ethetai,theta(i),itype(i)
3483 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3484 c & rad2deg*phii,rad2deg*phii1,ethetai
3485 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3486 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3487 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3490 C Ufff.... We've done all this!!!
3493 C---------------------------------------------------------------------------
3494 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3496 implicit real*8 (a-h,o-z)
3497 include 'DIMENSIONS'
3498 include 'COMMON.LOCAL'
3499 include 'COMMON.IOUNITS'
3500 common /calcthet/ term1,term2,termm,diffak,ratak,
3501 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3502 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3503 C Calculate the contributions to both Gaussian lobes.
3504 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3505 C The "polynomial part" of the "standard deviation" of this part of
3509 sig=sig*thet_pred_mean+polthet(j,it)
3511 C Derivative of the "interior part" of the "standard deviation of the"
3512 C gamma-dependent Gaussian lobe in t_c.
3513 sigtc=3*polthet(3,it)
3515 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3518 C Set the parameters of both Gaussian lobes of the distribution.
3519 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3520 fac=sig*sig+sigc0(it)
3523 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3524 sigsqtc=-4.0D0*sigcsq*sigtc
3525 c print *,i,sig,sigtc,sigsqtc
3526 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3527 sigtc=-sigtc/(fac*fac)
3528 C Following variable is sigma(t_c)**(-2)
3529 sigcsq=sigcsq*sigcsq
3531 sig0inv=1.0D0/sig0i**2
3532 delthec=thetai-thet_pred_mean
3533 delthe0=thetai-theta0i
3534 term1=-0.5D0*sigcsq*delthec*delthec
3535 term2=-0.5D0*sig0inv*delthe0*delthe0
3536 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3537 C NaNs in taking the logarithm. We extract the largest exponent which is added
3538 C to the energy (this being the log of the distribution) at the end of energy
3539 C term evaluation for this virtual-bond angle.
3540 if (term1.gt.term2) then
3542 term2=dexp(term2-termm)
3546 term1=dexp(term1-termm)
3549 C The ratio between the gamma-independent and gamma-dependent lobes of
3550 C the distribution is a Gaussian function of thet_pred_mean too.
3551 diffak=gthet(2,it)-thet_pred_mean
3552 ratak=diffak/gthet(3,it)**2
3553 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3554 C Let's differentiate it in thet_pred_mean NOW.
3556 C Now put together the distribution terms to make complete distribution.
3557 termexp=term1+ak*term2
3558 termpre=sigc+ak*sig0i
3559 C Contribution of the bending energy from this theta is just the -log of
3560 C the sum of the contributions from the two lobes and the pre-exponential
3561 C factor. Simple enough, isn't it?
3562 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3563 C NOW the derivatives!!!
3564 C 6/6/97 Take into account the deformation.
3565 E_theta=(delthec*sigcsq*term1
3566 & +ak*delthe0*sig0inv*term2)/termexp
3567 E_tc=((sigtc+aktc*sig0i)/termpre
3568 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3569 & aktc*term2)/termexp)
3572 c-----------------------------------------------------------------------------
3573 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3574 implicit real*8 (a-h,o-z)
3575 include 'DIMENSIONS'
3576 include 'COMMON.LOCAL'
3577 include 'COMMON.IOUNITS'
3578 common /calcthet/ term1,term2,termm,diffak,ratak,
3579 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3580 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3581 delthec=thetai-thet_pred_mean
3582 delthe0=thetai-theta0i
3583 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3584 t3 = thetai-thet_pred_mean
3588 t14 = t12+t6*sigsqtc
3590 t21 = thetai-theta0i
3596 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3597 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3598 & *(-t12*t9-ak*sig0inv*t27)
3602 C--------------------------------------------------------------------------
3603 subroutine ebend(etheta)
3605 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3606 C angles gamma and its derivatives in consecutive thetas and gammas.
3607 C ab initio-derived potentials from
3608 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3610 implicit real*8 (a-h,o-z)
3611 include 'DIMENSIONS'
3612 include 'DIMENSIONS.ZSCOPT'
3613 include 'COMMON.LOCAL'
3614 include 'COMMON.GEO'
3615 include 'COMMON.INTERACT'
3616 include 'COMMON.DERIV'
3617 include 'COMMON.VAR'
3618 include 'COMMON.CHAIN'
3619 include 'COMMON.IOUNITS'
3620 include 'COMMON.NAMES'
3621 include 'COMMON.FFIELD'
3622 include 'COMMON.CONTROL'
3623 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3624 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3625 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3626 & sinph1ph2(maxdouble,maxdouble)
3627 logical lprn /.false./, lprn1 /.false./
3629 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3630 do i=ithet_start,ithet_end
3632 C if (itype(i-1).eq.ntyp1) cycle
3634 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3635 & .or.itype(i).eq.ntyp1) cycle
3636 if (iabs(itype(i+1)).eq.20) iblock=2
3637 if (iabs(itype(i+1)).ne.20) iblock=1
3641 theti2=0.5d0*theta(i)
3642 ityp2=ithetyp((itype(i-1)))
3644 coskt(k)=dcos(k*theti2)
3645 sinkt(k)=dsin(k*theti2)
3655 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3658 if (phii.ne.phii) phii=150.0
3662 ityp1=ithetyp((itype(i-2)))
3664 cosph1(k)=dcos(k*phii)
3665 sinph1(k)=dsin(k*phii)
3676 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3679 if (phii1.ne.phii1) phii1=150.0
3684 ityp3=ithetyp((itype(i)))
3686 cosph2(k)=dcos(k*phii1)
3687 sinph2(k)=dsin(k*phii1)
3697 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3698 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3700 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3703 ccl=cosph1(l)*cosph2(k-l)
3704 ssl=sinph1(l)*sinph2(k-l)
3705 scl=sinph1(l)*cosph2(k-l)
3706 csl=cosph1(l)*sinph2(k-l)
3707 cosph1ph2(l,k)=ccl-ssl
3708 cosph1ph2(k,l)=ccl+ssl
3709 sinph1ph2(l,k)=scl+csl
3710 sinph1ph2(k,l)=scl-csl
3714 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3715 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3716 write (iout,*) "coskt and sinkt"
3718 write (iout,*) k,coskt(k),sinkt(k)
3722 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3723 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3726 & write (iout,*) "k",k,"
3727 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3728 & " ethetai",ethetai
3731 write (iout,*) "cosph and sinph"
3733 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3735 write (iout,*) "cosph1ph2 and sinph2ph2"
3738 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3739 & sinph1ph2(l,k),sinph1ph2(k,l)
3742 write(iout,*) "ethetai",ethetai
3746 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3747 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3748 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3749 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3750 ethetai=ethetai+sinkt(m)*aux
3751 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3752 dephii=dephii+k*sinkt(m)*(
3753 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3754 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3755 dephii1=dephii1+k*sinkt(m)*(
3756 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3757 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3759 & write (iout,*) "m",m," k",k," bbthet",
3760 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3761 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3762 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3763 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3767 & write(iout,*) "ethetai",ethetai
3771 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3772 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3773 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3774 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3775 ethetai=ethetai+sinkt(m)*aux
3776 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3777 dephii=dephii+l*sinkt(m)*(
3778 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3779 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3780 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3781 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3782 dephii1=dephii1+(k-l)*sinkt(m)*(
3783 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3784 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3785 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3786 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3788 write (iout,*) "m",m," k",k," l",l," ffthet",
3789 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3790 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3791 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3792 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3793 & " ethetai",ethetai
3794 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3795 & cosph1ph2(k,l)*sinkt(m),
3796 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3802 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3803 & i,theta(i)*rad2deg,phii*rad2deg,
3804 & phii1*rad2deg,ethetai
3805 etheta=etheta+ethetai
3806 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3807 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3808 gloc(nphi+i-2,icg)=wang*dethetai
3814 c-----------------------------------------------------------------------------
3815 subroutine esc(escloc)
3816 C Calculate the local energy of a side chain and its derivatives in the
3817 C corresponding virtual-bond valence angles THETA and the spherical angles
3819 implicit real*8 (a-h,o-z)
3820 include 'DIMENSIONS'
3821 include 'DIMENSIONS.ZSCOPT'
3822 include 'COMMON.GEO'
3823 include 'COMMON.LOCAL'
3824 include 'COMMON.VAR'
3825 include 'COMMON.INTERACT'
3826 include 'COMMON.DERIV'
3827 include 'COMMON.CHAIN'
3828 include 'COMMON.IOUNITS'
3829 include 'COMMON.NAMES'
3830 include 'COMMON.FFIELD'
3831 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3832 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3833 common /sccalc/ time11,time12,time112,theti,it,nlobit
3836 C write (iout,*) 'ESC'
3837 do i=loc_start,loc_end
3839 if (it.eq.ntyp1) cycle
3840 if (it.eq.10) goto 1
3841 nlobit=nlob(iabs(it))
3842 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3843 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3844 theti=theta(i+1)-pipol
3848 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3850 if (x(2).gt.pi-delta) then
3854 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3856 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3857 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3859 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3860 & ddersc0(1),dersc(1))
3861 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3862 & ddersc0(3),dersc(3))
3864 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3866 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3867 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3868 & dersc0(2),esclocbi,dersc02)
3869 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3871 call splinthet(x(2),0.5d0*delta,ss,ssd)
3876 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3878 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3879 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3881 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3883 c write (iout,*) escloci
3884 else if (x(2).lt.delta) then
3888 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3890 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3891 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3893 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3894 & ddersc0(1),dersc(1))
3895 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3896 & ddersc0(3),dersc(3))
3898 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3900 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3901 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3902 & dersc0(2),esclocbi,dersc02)
3903 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3908 call splinthet(x(2),0.5d0*delta,ss,ssd)
3910 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3912 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3913 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3915 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3916 C write (iout,*) 'i=',i, escloci
3918 call enesc(x,escloci,dersc,ddummy,.false.)
3921 escloc=escloc+escloci
3922 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3923 write (iout,'(a6,i5,0pf7.3)')
3924 & 'escloc',i,escloci
3926 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3928 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3929 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3934 C---------------------------------------------------------------------------
3935 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3936 implicit real*8 (a-h,o-z)
3937 include 'DIMENSIONS'
3938 include 'COMMON.GEO'
3939 include 'COMMON.LOCAL'
3940 include 'COMMON.IOUNITS'
3941 common /sccalc/ time11,time12,time112,theti,it,nlobit
3942 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3943 double precision contr(maxlob,-1:1)
3945 c write (iout,*) 'it=',it,' nlobit=',nlobit
3949 if (mixed) ddersc(j)=0.0d0
3953 C Because of periodicity of the dependence of the SC energy in omega we have
3954 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3955 C To avoid underflows, first compute & store the exponents.
3963 z(k)=x(k)-censc(k,j,it)
3968 Axk=Axk+gaussc(l,k,j,it)*z(l)
3974 expfac=expfac+Ax(k,j,iii)*z(k)
3982 C As in the case of ebend, we want to avoid underflows in exponentiation and
3983 C subsequent NaNs and INFs in energy calculation.
3984 C Find the largest exponent
3988 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3992 cd print *,'it=',it,' emin=',emin
3994 C Compute the contribution to SC energy and derivatives
3998 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3999 cd print *,'j=',j,' expfac=',expfac
4000 escloc_i=escloc_i+expfac
4002 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4006 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4007 & +gaussc(k,2,j,it))*expfac
4014 dersc(1)=dersc(1)/cos(theti)**2
4015 ddersc(1)=ddersc(1)/cos(theti)**2
4018 escloci=-(dlog(escloc_i)-emin)
4020 dersc(j)=dersc(j)/escloc_i
4024 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4029 C------------------------------------------------------------------------------
4030 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4031 implicit real*8 (a-h,o-z)
4032 include 'DIMENSIONS'
4033 include 'COMMON.GEO'
4034 include 'COMMON.LOCAL'
4035 include 'COMMON.IOUNITS'
4036 common /sccalc/ time11,time12,time112,theti,it,nlobit
4037 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4038 double precision contr(maxlob)
4049 z(k)=x(k)-censc(k,j,it)
4055 Axk=Axk+gaussc(l,k,j,it)*z(l)
4061 expfac=expfac+Ax(k,j)*z(k)
4066 C As in the case of ebend, we want to avoid underflows in exponentiation and
4067 C subsequent NaNs and INFs in energy calculation.
4068 C Find the largest exponent
4071 if (emin.gt.contr(j)) emin=contr(j)
4075 C Compute the contribution to SC energy and derivatives
4079 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4080 escloc_i=escloc_i+expfac
4082 dersc(k)=dersc(k)+Ax(k,j)*expfac
4084 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4085 & +gaussc(1,2,j,it))*expfac
4089 dersc(1)=dersc(1)/cos(theti)**2
4090 dersc12=dersc12/cos(theti)**2
4091 escloci=-(dlog(escloc_i)-emin)
4093 dersc(j)=dersc(j)/escloc_i
4095 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4099 c----------------------------------------------------------------------------------
4100 subroutine esc(escloc)
4101 C Calculate the local energy of a side chain and its derivatives in the
4102 C corresponding virtual-bond valence angles THETA and the spherical angles
4103 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4104 C added by Urszula Kozlowska. 07/11/2007
4106 implicit real*8 (a-h,o-z)
4107 include 'DIMENSIONS'
4108 include 'DIMENSIONS.ZSCOPT'
4109 include 'COMMON.GEO'
4110 include 'COMMON.LOCAL'
4111 include 'COMMON.VAR'
4112 include 'COMMON.SCROT'
4113 include 'COMMON.INTERACT'
4114 include 'COMMON.DERIV'
4115 include 'COMMON.CHAIN'
4116 include 'COMMON.IOUNITS'
4117 include 'COMMON.NAMES'
4118 include 'COMMON.FFIELD'
4119 include 'COMMON.CONTROL'
4120 include 'COMMON.VECTORS'
4121 double precision x_prime(3),y_prime(3),z_prime(3)
4122 & , sumene,dsc_i,dp2_i,x(65),
4123 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4124 & de_dxx,de_dyy,de_dzz,de_dt
4125 double precision s1_t,s1_6_t,s2_t,s2_6_t
4127 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4128 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4129 & dt_dCi(3),dt_dCi1(3)
4130 common /sccalc/ time11,time12,time112,theti,it,nlobit
4133 do i=loc_start,loc_end
4134 if (itype(i).eq.ntyp1) cycle
4135 costtab(i+1) =dcos(theta(i+1))
4136 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4137 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4138 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4139 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4140 cosfac=dsqrt(cosfac2)
4141 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4142 sinfac=dsqrt(sinfac2)
4144 if (it.eq.10) goto 1
4146 C Compute the axes of tghe local cartesian coordinates system; store in
4147 c x_prime, y_prime and z_prime
4154 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4155 C & dc_norm(3,i+nres)
4157 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4158 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4161 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4164 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4165 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4166 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4167 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4168 c & " xy",scalar(x_prime(1),y_prime(1)),
4169 c & " xz",scalar(x_prime(1),z_prime(1)),
4170 c & " yy",scalar(y_prime(1),y_prime(1)),
4171 c & " yz",scalar(y_prime(1),z_prime(1)),
4172 c & " zz",scalar(z_prime(1),z_prime(1))
4174 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4175 C to local coordinate system. Store in xx, yy, zz.
4181 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4182 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4183 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4190 C Compute the energy of the ith side cbain
4192 c write (2,*) "xx",xx," yy",yy," zz",zz
4195 x(j) = sc_parmin(j,it)
4198 Cc diagnostics - remove later
4200 yy1 = dsin(alph(2))*dcos(omeg(2))
4201 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4202 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4203 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4205 C," --- ", xx_w,yy_w,zz_w
4208 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4209 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4211 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4212 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4214 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4215 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4216 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4217 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4218 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4220 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4221 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4222 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4223 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4224 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4226 dsc_i = 0.743d0+x(61)
4228 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4229 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4230 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4231 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4232 s1=(1+x(63))/(0.1d0 + dscp1)
4233 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4234 s2=(1+x(65))/(0.1d0 + dscp2)
4235 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4236 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4237 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4238 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4240 c & dscp1,dscp2,sumene
4241 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4242 escloc = escloc + sumene
4243 c write (2,*) "escloc",escloc
4244 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4246 if (.not. calc_grad) goto 1
4249 C This section to check the numerical derivatives of the energy of ith side
4250 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4251 C #define DEBUG in the code to turn it on.
4253 write (2,*) "sumene =",sumene
4257 write (2,*) xx,yy,zz
4258 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4259 de_dxx_num=(sumenep-sumene)/aincr
4261 write (2,*) "xx+ sumene from enesc=",sumenep
4264 write (2,*) xx,yy,zz
4265 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4266 de_dyy_num=(sumenep-sumene)/aincr
4268 write (2,*) "yy+ sumene from enesc=",sumenep
4271 write (2,*) xx,yy,zz
4272 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4273 de_dzz_num=(sumenep-sumene)/aincr
4275 write (2,*) "zz+ sumene from enesc=",sumenep
4276 costsave=cost2tab(i+1)
4277 sintsave=sint2tab(i+1)
4278 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4279 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4280 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4281 de_dt_num=(sumenep-sumene)/aincr
4282 write (2,*) " t+ sumene from enesc=",sumenep
4283 cost2tab(i+1)=costsave
4284 sint2tab(i+1)=sintsave
4285 C End of diagnostics section.
4288 C Compute the gradient of esc
4290 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4291 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4292 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4293 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4294 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4295 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4296 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4297 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4298 pom1=(sumene3*sint2tab(i+1)+sumene1)
4299 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4300 pom2=(sumene4*cost2tab(i+1)+sumene2)
4301 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4302 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4303 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4304 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4306 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4307 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4308 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4310 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4311 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4312 & +(pom1+pom2)*pom_dx
4314 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4317 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4318 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4319 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4321 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4322 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4323 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4324 & +x(59)*zz**2 +x(60)*xx*zz
4325 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4326 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4327 & +(pom1-pom2)*pom_dy
4329 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4332 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4333 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4334 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4335 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4336 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4337 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4338 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4339 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4341 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4344 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4345 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4346 & +pom1*pom_dt1+pom2*pom_dt2
4348 write(2,*), "de_dt = ", de_dt,de_dt_num
4352 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4353 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4354 cosfac2xx=cosfac2*xx
4355 sinfac2yy=sinfac2*yy
4357 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4359 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4361 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4362 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4363 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4364 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4365 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4366 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4367 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4368 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4369 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4370 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4374 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4375 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4376 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4377 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4380 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4381 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4382 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4384 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4385 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4389 dXX_Ctab(k,i)=dXX_Ci(k)
4390 dXX_C1tab(k,i)=dXX_Ci1(k)
4391 dYY_Ctab(k,i)=dYY_Ci(k)
4392 dYY_C1tab(k,i)=dYY_Ci1(k)
4393 dZZ_Ctab(k,i)=dZZ_Ci(k)
4394 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4395 dXX_XYZtab(k,i)=dXX_XYZ(k)
4396 dYY_XYZtab(k,i)=dYY_XYZ(k)
4397 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4401 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4402 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4403 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4404 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4405 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4407 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4408 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4409 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4410 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4411 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4412 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4413 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4414 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4416 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4417 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4419 C to check gradient call subroutine check_grad
4426 c------------------------------------------------------------------------------
4427 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4429 C This procedure calculates two-body contact function g(rij) and its derivative:
4432 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4435 C where x=(rij-r0ij)/delta
4437 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4440 double precision rij,r0ij,eps0ij,fcont,fprimcont
4441 double precision x,x2,x4,delta
4445 if (x.lt.-1.0D0) then
4448 else if (x.le.1.0D0) then
4451 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4452 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4459 c------------------------------------------------------------------------------
4460 subroutine splinthet(theti,delta,ss,ssder)
4461 implicit real*8 (a-h,o-z)
4462 include 'DIMENSIONS'
4463 include 'DIMENSIONS.ZSCOPT'
4464 include 'COMMON.VAR'
4465 include 'COMMON.GEO'
4468 if (theti.gt.pipol) then
4469 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4471 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4476 c------------------------------------------------------------------------------
4477 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4479 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4480 double precision ksi,ksi2,ksi3,a1,a2,a3
4481 a1=fprim0*delta/(f1-f0)
4487 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4488 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4491 c------------------------------------------------------------------------------
4492 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4494 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4495 double precision ksi,ksi2,ksi3,a1,a2,a3
4500 a2=3*(f1x-f0x)-2*fprim0x*delta
4501 a3=fprim0x*delta-2*(f1x-f0x)
4502 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4505 C-----------------------------------------------------------------------------
4507 C-----------------------------------------------------------------------------
4508 subroutine etor(etors,edihcnstr,fact)
4509 implicit real*8 (a-h,o-z)
4510 include 'DIMENSIONS'
4511 include 'DIMENSIONS.ZSCOPT'
4512 include 'COMMON.VAR'
4513 include 'COMMON.GEO'
4514 include 'COMMON.LOCAL'
4515 include 'COMMON.TORSION'
4516 include 'COMMON.INTERACT'
4517 include 'COMMON.DERIV'
4518 include 'COMMON.CHAIN'
4519 include 'COMMON.NAMES'
4520 include 'COMMON.IOUNITS'
4521 include 'COMMON.FFIELD'
4522 include 'COMMON.TORCNSTR'
4524 C Set lprn=.true. for debugging
4528 do i=iphi_start,iphi_end
4529 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4530 & .or. itype(i).eq.ntyp1) cycle
4531 itori=itortyp(itype(i-2))
4532 itori1=itortyp(itype(i-1))
4535 C Proline-Proline pair is a special case...
4536 if (itori.eq.3 .and. itori1.eq.3) then
4537 if (phii.gt.-dwapi3) then
4539 fac=1.0D0/(1.0D0-cosphi)
4540 etorsi=v1(1,3,3)*fac
4541 etorsi=etorsi+etorsi
4542 etors=etors+etorsi-v1(1,3,3)
4543 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4546 v1ij=v1(j+1,itori,itori1)
4547 v2ij=v2(j+1,itori,itori1)
4550 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4551 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4555 v1ij=v1(j,itori,itori1)
4556 v2ij=v2(j,itori,itori1)
4559 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4560 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4564 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4565 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4566 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4567 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4568 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4570 ! 6/20/98 - dihedral angle constraints
4573 itori=idih_constr(i)
4576 if (difi.gt.drange(i)) then
4578 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4579 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4580 else if (difi.lt.-drange(i)) then
4582 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4583 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4585 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4586 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4588 ! write (iout,*) 'edihcnstr',edihcnstr
4591 c------------------------------------------------------------------------------
4593 subroutine etor(etors,edihcnstr,fact)
4594 implicit real*8 (a-h,o-z)
4595 include 'DIMENSIONS'
4596 include 'DIMENSIONS.ZSCOPT'
4597 include 'COMMON.VAR'
4598 include 'COMMON.GEO'
4599 include 'COMMON.LOCAL'
4600 include 'COMMON.TORSION'
4601 include 'COMMON.INTERACT'
4602 include 'COMMON.DERIV'
4603 include 'COMMON.CHAIN'
4604 include 'COMMON.NAMES'
4605 include 'COMMON.IOUNITS'
4606 include 'COMMON.FFIELD'
4607 include 'COMMON.TORCNSTR'
4609 C Set lprn=.true. for debugging
4613 do i=iphi_start,iphi_end
4615 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4616 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4617 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4618 C & .or. itype(i).eq.ntyp1) cycle
4619 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4620 if (iabs(itype(i)).eq.20) then
4625 itori=itortyp(itype(i-2))
4626 itori1=itortyp(itype(i-1))
4629 C Regular cosine and sine terms
4630 do j=1,nterm(itori,itori1,iblock)
4631 v1ij=v1(j,itori,itori1,iblock)
4632 v2ij=v2(j,itori,itori1,iblock)
4635 etors=etors+v1ij*cosphi+v2ij*sinphi
4636 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4640 C E = SUM ----------------------------------- - v1
4641 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4643 cosphi=dcos(0.5d0*phii)
4644 sinphi=dsin(0.5d0*phii)
4645 do j=1,nlor(itori,itori1,iblock)
4646 vl1ij=vlor1(j,itori,itori1)
4647 vl2ij=vlor2(j,itori,itori1)
4648 vl3ij=vlor3(j,itori,itori1)
4649 pom=vl2ij*cosphi+vl3ij*sinphi
4650 pom1=1.0d0/(pom*pom+1.0d0)
4651 etors=etors+vl1ij*pom1
4652 c if (energy_dec) etors_ii=etors_ii+
4655 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4657 C Subtract the constant term
4658 etors=etors-v0(itori,itori1,iblock)
4660 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4661 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4662 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4663 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4664 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4667 ! 6/20/98 - dihedral angle constraints
4670 itori=idih_constr(i)
4672 difi=pinorm(phii-phi0(i))
4674 if (difi.gt.drange(i)) then
4676 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4677 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4678 edihi=0.25d0*ftors*difi**4
4679 else if (difi.lt.-drange(i)) then
4681 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4682 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4683 edihi=0.25d0*ftors*difi**4
4687 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4689 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4690 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4692 ! write (iout,*) 'edihcnstr',edihcnstr
4695 c----------------------------------------------------------------------------
4696 subroutine etor_d(etors_d,fact2)
4697 C 6/23/01 Compute double torsional energy
4698 implicit real*8 (a-h,o-z)
4699 include 'DIMENSIONS'
4700 include 'DIMENSIONS.ZSCOPT'
4701 include 'COMMON.VAR'
4702 include 'COMMON.GEO'
4703 include 'COMMON.LOCAL'
4704 include 'COMMON.TORSION'
4705 include 'COMMON.INTERACT'
4706 include 'COMMON.DERIV'
4707 include 'COMMON.CHAIN'
4708 include 'COMMON.NAMES'
4709 include 'COMMON.IOUNITS'
4710 include 'COMMON.FFIELD'
4711 include 'COMMON.TORCNSTR'
4713 C Set lprn=.true. for debugging
4717 do i=iphi_start,iphi_end-1
4719 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4720 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4721 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4722 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4723 & (itype(i+1).eq.ntyp1)) cycle
4724 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4726 itori=itortyp(itype(i-2))
4727 itori1=itortyp(itype(i-1))
4728 itori2=itortyp(itype(i))
4734 if (iabs(itype(i+1)).eq.20) iblock=2
4735 C Regular cosine and sine terms
4736 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4737 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4738 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4739 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4740 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4741 cosphi1=dcos(j*phii)
4742 sinphi1=dsin(j*phii)
4743 cosphi2=dcos(j*phii1)
4744 sinphi2=dsin(j*phii1)
4745 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4746 & v2cij*cosphi2+v2sij*sinphi2
4747 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4748 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4750 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4752 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4753 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4754 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4755 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4756 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4757 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4758 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4759 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4760 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4761 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4762 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4763 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4764 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4765 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4768 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4769 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4775 c------------------------------------------------------------------------------
4776 subroutine eback_sc_corr(esccor)
4777 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4778 c conformational states; temporarily implemented as differences
4779 c between UNRES torsional potentials (dependent on three types of
4780 c residues) and the torsional potentials dependent on all 20 types
4781 c of residues computed from AM1 energy surfaces of terminally-blocked
4782 c amino-acid residues.
4783 implicit real*8 (a-h,o-z)
4784 include 'DIMENSIONS'
4785 include 'DIMENSIONS.ZSCOPT'
4786 include 'COMMON.VAR'
4787 include 'COMMON.GEO'
4788 include 'COMMON.LOCAL'
4789 include 'COMMON.TORSION'
4790 include 'COMMON.SCCOR'
4791 include 'COMMON.INTERACT'
4792 include 'COMMON.DERIV'
4793 include 'COMMON.CHAIN'
4794 include 'COMMON.NAMES'
4795 include 'COMMON.IOUNITS'
4796 include 'COMMON.FFIELD'
4797 include 'COMMON.CONTROL'
4799 C Set lprn=.true. for debugging
4802 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4804 do i=itau_start,itau_end
4805 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4807 isccori=isccortyp(itype(i-2))
4808 isccori1=isccortyp(itype(i-1))
4810 do intertyp=1,3 !intertyp
4811 cc Added 09 May 2012 (Adasko)
4812 cc Intertyp means interaction type of backbone mainchain correlation:
4813 c 1 = SC...Ca...Ca...Ca
4814 c 2 = Ca...Ca...Ca...SC
4815 c 3 = SC...Ca...Ca...SCi
4817 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4818 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4819 & (itype(i-1).eq.ntyp1)))
4820 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4821 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4822 & .or.(itype(i).eq.ntyp1)))
4823 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4824 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4825 & (itype(i-3).eq.ntyp1)))) cycle
4826 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4827 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4829 do j=1,nterm_sccor(isccori,isccori1)
4830 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4831 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4832 cosphi=dcos(j*tauangle(intertyp,i))
4833 sinphi=dsin(j*tauangle(intertyp,i))
4834 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4835 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4837 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4838 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4839 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4841 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4842 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4843 & (v1sccor(j,1,itori,itori1),j=1,6)
4844 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4845 c gsccor_loc(i-3)=gloci
4850 c------------------------------------------------------------------------------
4851 subroutine multibody(ecorr)
4852 C This subroutine calculates multi-body contributions to energy following
4853 C the idea of Skolnick et al. If side chains I and J make a contact and
4854 C at the same time side chains I+1 and J+1 make a contact, an extra
4855 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4856 implicit real*8 (a-h,o-z)
4857 include 'DIMENSIONS'
4858 include 'COMMON.IOUNITS'
4859 include 'COMMON.DERIV'
4860 include 'COMMON.INTERACT'
4861 include 'COMMON.CONTACTS'
4862 double precision gx(3),gx1(3)
4865 C Set lprn=.true. for debugging
4869 write (iout,'(a)') 'Contact function values:'
4871 write (iout,'(i2,20(1x,i2,f10.5))')
4872 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4887 num_conti=num_cont(i)
4888 num_conti1=num_cont(i1)
4893 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4894 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4895 cd & ' ishift=',ishift
4896 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4897 C The system gains extra energy.
4898 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4899 endif ! j1==j+-ishift
4908 c------------------------------------------------------------------------------
4909 double precision function esccorr(i,j,k,l,jj,kk)
4910 implicit real*8 (a-h,o-z)
4911 include 'DIMENSIONS'
4912 include 'COMMON.IOUNITS'
4913 include 'COMMON.DERIV'
4914 include 'COMMON.INTERACT'
4915 include 'COMMON.CONTACTS'
4916 double precision gx(3),gx1(3)
4921 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4922 C Calculate the multi-body contribution to energy.
4923 C Calculate multi-body contributions to the gradient.
4924 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4925 cd & k,l,(gacont(m,kk,k),m=1,3)
4927 gx(m) =ekl*gacont(m,jj,i)
4928 gx1(m)=eij*gacont(m,kk,k)
4929 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4930 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4931 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4932 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4936 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4941 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4947 c------------------------------------------------------------------------------
4949 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4950 implicit real*8 (a-h,o-z)
4951 include 'DIMENSIONS'
4952 integer dimen1,dimen2,atom,indx
4953 double precision buffer(dimen1,dimen2)
4954 double precision zapas
4955 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4956 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4957 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4958 num_kont=num_cont_hb(atom)
4962 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4965 buffer(i,indx+22)=facont_hb(i,atom)
4966 buffer(i,indx+23)=ees0p(i,atom)
4967 buffer(i,indx+24)=ees0m(i,atom)
4968 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4970 buffer(1,indx+26)=dfloat(num_kont)
4973 c------------------------------------------------------------------------------
4974 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4975 implicit real*8 (a-h,o-z)
4976 include 'DIMENSIONS'
4977 integer dimen1,dimen2,atom,indx
4978 double precision buffer(dimen1,dimen2)
4979 double precision zapas
4980 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4981 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4982 & ees0m(ntyp,maxres),
4983 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4984 num_kont=buffer(1,indx+26)
4985 num_kont_old=num_cont_hb(atom)
4986 num_cont_hb(atom)=num_kont+num_kont_old
4991 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4994 facont_hb(ii,atom)=buffer(i,indx+22)
4995 ees0p(ii,atom)=buffer(i,indx+23)
4996 ees0m(ii,atom)=buffer(i,indx+24)
4997 jcont_hb(ii,atom)=buffer(i,indx+25)
5001 c------------------------------------------------------------------------------
5003 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5004 C This subroutine calculates multi-body contributions to hydrogen-bonding
5005 implicit real*8 (a-h,o-z)
5006 include 'DIMENSIONS'
5007 include 'DIMENSIONS.ZSCOPT'
5008 include 'COMMON.IOUNITS'
5010 include 'COMMON.INFO'
5012 include 'COMMON.FFIELD'
5013 include 'COMMON.DERIV'
5014 include 'COMMON.INTERACT'
5015 include 'COMMON.CONTACTS'
5017 parameter (max_cont=maxconts)
5018 parameter (max_dim=2*(8*3+2))
5019 parameter (msglen1=max_cont*max_dim*4)
5020 parameter (msglen2=2*msglen1)
5021 integer source,CorrelType,CorrelID,Error
5022 double precision buffer(max_cont,max_dim)
5024 double precision gx(3),gx1(3)
5027 C Set lprn=.true. for debugging
5032 if (fgProcs.le.1) goto 30
5034 write (iout,'(a)') 'Contact function values:'
5036 write (iout,'(2i3,50(1x,i2,f5.2))')
5037 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5038 & j=1,num_cont_hb(i))
5041 C Caution! Following code assumes that electrostatic interactions concerning
5042 C a given atom are split among at most two processors!
5052 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5055 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5056 if (MyRank.gt.0) then
5057 C Send correlation contributions to the preceding processor
5059 nn=num_cont_hb(iatel_s)
5060 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5061 cd write (iout,*) 'The BUFFER array:'
5063 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5065 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5067 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5068 C Clear the contacts of the atom passed to the neighboring processor
5069 nn=num_cont_hb(iatel_s+1)
5071 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5073 num_cont_hb(iatel_s)=0
5075 cd write (iout,*) 'Processor ',MyID,MyRank,
5076 cd & ' is sending correlation contribution to processor',MyID-1,
5077 cd & ' msglen=',msglen
5078 cd write (*,*) 'Processor ',MyID,MyRank,
5079 cd & ' is sending correlation contribution to processor',MyID-1,
5080 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5081 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5082 cd write (iout,*) 'Processor ',MyID,
5083 cd & ' has sent correlation contribution to processor',MyID-1,
5084 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5085 cd write (*,*) 'Processor ',MyID,
5086 cd & ' has sent correlation contribution to processor',MyID-1,
5087 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5089 endif ! (MyRank.gt.0)
5093 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5094 if (MyRank.lt.fgProcs-1) then
5095 C Receive correlation contributions from the next processor
5097 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5098 cd write (iout,*) 'Processor',MyID,
5099 cd & ' is receiving correlation contribution from processor',MyID+1,
5100 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5101 cd write (*,*) 'Processor',MyID,
5102 cd & ' is receiving correlation contribution from processor',MyID+1,
5103 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5105 do while (nbytes.le.0)
5106 call mp_probe(MyID+1,CorrelType,nbytes)
5108 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5109 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5110 cd write (iout,*) 'Processor',MyID,
5111 cd & ' has received correlation contribution from processor',MyID+1,
5112 cd & ' msglen=',msglen,' nbytes=',nbytes
5113 cd write (iout,*) 'The received BUFFER array:'
5115 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5117 if (msglen.eq.msglen1) then
5118 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5119 else if (msglen.eq.msglen2) then
5120 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5121 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5124 & 'ERROR!!!! message length changed while processing correlations.'
5126 & 'ERROR!!!! message length changed while processing correlations.'
5127 call mp_stopall(Error)
5128 endif ! msglen.eq.msglen1
5129 endif ! MyRank.lt.fgProcs-1
5136 write (iout,'(a)') 'Contact function values:'
5138 write (iout,'(2i3,50(1x,i2,f5.2))')
5139 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5140 & j=1,num_cont_hb(i))
5144 C Remove the loop below after debugging !!!
5151 C Calculate the local-electrostatic correlation terms
5152 do i=iatel_s,iatel_e+1
5154 num_conti=num_cont_hb(i)
5155 num_conti1=num_cont_hb(i+1)
5160 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5161 c & ' jj=',jj,' kk=',kk
5162 if (j1.eq.j+1 .or. j1.eq.j-1) then
5163 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5164 C The system gains extra energy.
5165 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5167 else if (j1.eq.j) then
5168 C Contacts I-J and I-(J+1) occur simultaneously.
5169 C The system loses extra energy.
5170 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5175 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5176 c & ' jj=',jj,' kk=',kk
5178 C Contacts I-J and (I+1)-J occur simultaneously.
5179 C The system loses extra energy.
5180 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5187 c------------------------------------------------------------------------------
5188 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5190 C This subroutine calculates multi-body contributions to hydrogen-bonding
5191 implicit real*8 (a-h,o-z)
5192 include 'DIMENSIONS'
5193 include 'DIMENSIONS.ZSCOPT'
5194 include 'COMMON.IOUNITS'
5196 include 'COMMON.INFO'
5198 include 'COMMON.FFIELD'
5199 include 'COMMON.DERIV'
5200 include 'COMMON.INTERACT'
5201 include 'COMMON.CONTACTS'
5203 parameter (max_cont=maxconts)
5204 parameter (max_dim=2*(8*3+2))
5205 parameter (msglen1=max_cont*max_dim*4)
5206 parameter (msglen2=2*msglen1)
5207 integer source,CorrelType,CorrelID,Error
5208 double precision buffer(max_cont,max_dim)
5210 double precision gx(3),gx1(3)
5213 C Set lprn=.true. for debugging
5219 if (fgProcs.le.1) goto 30
5221 write (iout,'(a)') 'Contact function values:'
5223 write (iout,'(2i3,50(1x,i2,f5.2))')
5224 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5225 & j=1,num_cont_hb(i))
5228 C Caution! Following code assumes that electrostatic interactions concerning
5229 C a given atom are split among at most two processors!
5239 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5242 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5243 if (MyRank.gt.0) then
5244 C Send correlation contributions to the preceding processor
5246 nn=num_cont_hb(iatel_s)
5247 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5248 cd write (iout,*) 'The BUFFER array:'
5250 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5252 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5254 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5255 C Clear the contacts of the atom passed to the neighboring processor
5256 nn=num_cont_hb(iatel_s+1)
5258 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5260 num_cont_hb(iatel_s)=0
5262 cd write (iout,*) 'Processor ',MyID,MyRank,
5263 cd & ' is sending correlation contribution to processor',MyID-1,
5264 cd & ' msglen=',msglen
5265 cd write (*,*) 'Processor ',MyID,MyRank,
5266 cd & ' is sending correlation contribution to processor',MyID-1,
5267 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5268 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5269 cd write (iout,*) 'Processor ',MyID,
5270 cd & ' has sent correlation contribution to processor',MyID-1,
5271 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5272 cd write (*,*) 'Processor ',MyID,
5273 cd & ' has sent correlation contribution to processor',MyID-1,
5274 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5276 endif ! (MyRank.gt.0)
5280 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5281 if (MyRank.lt.fgProcs-1) then
5282 C Receive correlation contributions from the next processor
5284 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5285 cd write (iout,*) 'Processor',MyID,
5286 cd & ' is receiving correlation contribution from processor',MyID+1,
5287 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5288 cd write (*,*) 'Processor',MyID,
5289 cd & ' is receiving correlation contribution from processor',MyID+1,
5290 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5292 do while (nbytes.le.0)
5293 call mp_probe(MyID+1,CorrelType,nbytes)
5295 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5296 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5297 cd write (iout,*) 'Processor',MyID,
5298 cd & ' has received correlation contribution from processor',MyID+1,
5299 cd & ' msglen=',msglen,' nbytes=',nbytes
5300 cd write (iout,*) 'The received BUFFER array:'
5302 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5304 if (msglen.eq.msglen1) then
5305 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5306 else if (msglen.eq.msglen2) then
5307 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5308 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5311 & 'ERROR!!!! message length changed while processing correlations.'
5313 & 'ERROR!!!! message length changed while processing correlations.'
5314 call mp_stopall(Error)
5315 endif ! msglen.eq.msglen1
5316 endif ! MyRank.lt.fgProcs-1
5323 write (iout,'(a)') 'Contact function values:'
5325 write (iout,'(2i3,50(1x,i2,f5.2))')
5326 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5327 & j=1,num_cont_hb(i))
5333 C Remove the loop below after debugging !!!
5340 C Calculate the dipole-dipole interaction energies
5341 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5342 do i=iatel_s,iatel_e+1
5343 num_conti=num_cont_hb(i)
5350 C Calculate the local-electrostatic correlation terms
5351 do i=iatel_s,iatel_e+1
5353 num_conti=num_cont_hb(i)
5354 num_conti1=num_cont_hb(i+1)
5359 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5360 c & ' jj=',jj,' kk=',kk
5361 if (j1.eq.j+1 .or. j1.eq.j-1) then
5362 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5363 C The system gains extra energy.
5365 sqd1=dsqrt(d_cont(jj,i))
5366 sqd2=dsqrt(d_cont(kk,i1))
5367 sred_geom = sqd1*sqd2
5368 IF (sred_geom.lt.cutoff_corr) THEN
5369 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5371 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5372 c & ' jj=',jj,' kk=',kk
5373 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5374 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5376 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5377 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5380 cd write (iout,*) 'sred_geom=',sred_geom,
5381 cd & ' ekont=',ekont,' fprim=',fprimcont
5382 call calc_eello(i,j,i+1,j1,jj,kk)
5383 if (wcorr4.gt.0.0d0)
5384 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5385 if (wcorr5.gt.0.0d0)
5386 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5387 c print *,"wcorr5",ecorr5
5388 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5389 cd write(2,*)'ijkl',i,j,i+1,j1
5390 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5391 & .or. wturn6.eq.0.0d0))then
5392 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5393 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5394 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5395 cd & 'ecorr6=',ecorr6
5396 cd write (iout,'(4e15.5)') sred_geom,
5397 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5398 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5399 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5400 else if (wturn6.gt.0.0d0
5401 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5402 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5403 eturn6=eturn6+eello_turn6(i,jj,kk)
5404 cd write (2,*) 'multibody_eello:eturn6',eturn6
5408 else if (j1.eq.j) then
5409 C Contacts I-J and I-(J+1) occur simultaneously.
5410 C The system loses extra energy.
5411 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5416 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5417 c & ' jj=',jj,' kk=',kk
5419 C Contacts I-J and (I+1)-J occur simultaneously.
5420 C The system loses extra energy.
5421 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5428 c------------------------------------------------------------------------------
5429 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5430 implicit real*8 (a-h,o-z)
5431 include 'DIMENSIONS'
5432 include 'COMMON.IOUNITS'
5433 include 'COMMON.DERIV'
5434 include 'COMMON.INTERACT'
5435 include 'COMMON.CONTACTS'
5436 double precision gx(3),gx1(3)
5446 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5447 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5448 C Following 4 lines for diagnostics.
5453 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5455 c write (iout,*)'Contacts have occurred for peptide groups',
5456 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5457 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5458 C Calculate the multi-body contribution to energy.
5459 ecorr=ecorr+ekont*ees
5461 C Calculate multi-body contributions to the gradient.
5463 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5464 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5465 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5466 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5467 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5468 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5469 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5470 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5471 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5472 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5473 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5474 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5475 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5476 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5480 gradcorr(ll,m)=gradcorr(ll,m)+
5481 & ees*ekl*gacont_hbr(ll,jj,i)-
5482 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5483 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5488 gradcorr(ll,m)=gradcorr(ll,m)+
5489 & ees*eij*gacont_hbr(ll,kk,k)-
5490 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5491 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5498 C---------------------------------------------------------------------------
5499 subroutine dipole(i,j,jj)
5500 implicit real*8 (a-h,o-z)
5501 include 'DIMENSIONS'
5502 include 'DIMENSIONS.ZSCOPT'
5503 include 'COMMON.IOUNITS'
5504 include 'COMMON.CHAIN'
5505 include 'COMMON.FFIELD'
5506 include 'COMMON.DERIV'
5507 include 'COMMON.INTERACT'
5508 include 'COMMON.CONTACTS'
5509 include 'COMMON.TORSION'
5510 include 'COMMON.VAR'
5511 include 'COMMON.GEO'
5512 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5514 iti1 = itortyp(itype(i+1))
5515 if (j.lt.nres-1) then
5516 if (itype(j).le.ntyp) then
5517 itj1 = itortyp(itype(j+1))
5525 dipi(iii,1)=Ub2(iii,i)
5526 dipderi(iii)=Ub2der(iii,i)
5527 dipi(iii,2)=b1(iii,iti1)
5528 dipj(iii,1)=Ub2(iii,j)
5529 dipderj(iii)=Ub2der(iii,j)
5530 dipj(iii,2)=b1(iii,itj1)
5534 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5537 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5540 if (.not.calc_grad) return
5545 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5549 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5554 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5555 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5557 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5559 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5561 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5565 C---------------------------------------------------------------------------
5566 subroutine calc_eello(i,j,k,l,jj,kk)
5568 C This subroutine computes matrices and vectors needed to calculate
5569 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5571 implicit real*8 (a-h,o-z)
5572 include 'DIMENSIONS'
5573 include 'DIMENSIONS.ZSCOPT'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.CHAIN'
5576 include 'COMMON.DERIV'
5577 include 'COMMON.INTERACT'
5578 include 'COMMON.CONTACTS'
5579 include 'COMMON.TORSION'
5580 include 'COMMON.VAR'
5581 include 'COMMON.GEO'
5582 include 'COMMON.FFIELD'
5583 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5584 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5587 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5588 cd & ' jj=',jj,' kk=',kk
5589 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5592 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5593 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5596 call transpose2(aa1(1,1),aa1t(1,1))
5597 call transpose2(aa2(1,1),aa2t(1,1))
5600 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5601 & aa1tder(1,1,lll,kkk))
5602 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5603 & aa2tder(1,1,lll,kkk))
5607 C parallel orientation of the two CA-CA-CA frames.
5608 if (i.gt.1 .and. itype(i).le.ntyp) then
5609 iti=itortyp(itype(i))
5613 itk1=itortyp(itype(k+1))
5614 itj=itortyp(itype(j))
5615 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5616 itl1=itortyp(itype(l+1))
5620 C A1 kernel(j+1) A2T
5622 cd write (iout,'(3f10.5,5x,3f10.5)')
5623 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5625 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5626 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5627 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5628 C Following matrices are needed only for 6-th order cumulants
5629 IF (wcorr6.gt.0.0d0) THEN
5630 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5631 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5632 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5633 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5634 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5635 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5636 & ADtEAderx(1,1,1,1,1,1))
5638 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5639 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5640 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5641 & ADtEA1derx(1,1,1,1,1,1))
5643 C End 6-th order cumulants
5646 cd write (2,*) 'In calc_eello6'
5648 cd write (2,*) 'iii=',iii
5650 cd write (2,*) 'kkk=',kkk
5652 cd write (2,'(3(2f10.5),5x)')
5653 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5658 call transpose2(EUgder(1,1,k),auxmat(1,1))
5659 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5660 call transpose2(EUg(1,1,k),auxmat(1,1))
5661 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5662 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5666 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5667 & EAEAderx(1,1,lll,kkk,iii,1))
5671 C A1T kernel(i+1) A2
5672 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5673 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5674 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5675 C Following matrices are needed only for 6-th order cumulants
5676 IF (wcorr6.gt.0.0d0) THEN
5677 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5678 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5679 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5680 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5681 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5682 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5683 & ADtEAderx(1,1,1,1,1,2))
5684 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5685 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5686 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5687 & ADtEA1derx(1,1,1,1,1,2))
5689 C End 6-th order cumulants
5690 call transpose2(EUgder(1,1,l),auxmat(1,1))
5691 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5692 call transpose2(EUg(1,1,l),auxmat(1,1))
5693 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5694 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5698 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5699 & EAEAderx(1,1,lll,kkk,iii,2))
5704 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5705 C They are needed only when the fifth- or the sixth-order cumulants are
5707 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5708 call transpose2(AEA(1,1,1),auxmat(1,1))
5709 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5710 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5711 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5712 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5713 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5714 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5715 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5716 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5717 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5718 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5719 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5720 call transpose2(AEA(1,1,2),auxmat(1,1))
5721 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5722 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5723 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5724 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5725 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5726 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5727 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5728 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5729 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5730 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5731 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5732 C Calculate the Cartesian derivatives of the vectors.
5736 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5737 call matvec2(auxmat(1,1),b1(1,iti),
5738 & AEAb1derx(1,lll,kkk,iii,1,1))
5739 call matvec2(auxmat(1,1),Ub2(1,i),
5740 & AEAb2derx(1,lll,kkk,iii,1,1))
5741 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5742 & AEAb1derx(1,lll,kkk,iii,2,1))
5743 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5744 & AEAb2derx(1,lll,kkk,iii,2,1))
5745 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5746 call matvec2(auxmat(1,1),b1(1,itj),
5747 & AEAb1derx(1,lll,kkk,iii,1,2))
5748 call matvec2(auxmat(1,1),Ub2(1,j),
5749 & AEAb2derx(1,lll,kkk,iii,1,2))
5750 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5751 & AEAb1derx(1,lll,kkk,iii,2,2))
5752 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5753 & AEAb2derx(1,lll,kkk,iii,2,2))
5760 C Antiparallel orientation of the two CA-CA-CA frames.
5761 if (i.gt.1 .and. itype(i).le.ntyp) then
5762 iti=itortyp(itype(i))
5766 itk1=itortyp(itype(k+1))
5767 itl=itortyp(itype(l))
5768 itj=itortyp(itype(j))
5769 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5770 itj1=itortyp(itype(j+1))
5774 C A2 kernel(j-1)T A1T
5775 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5776 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5777 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5778 C Following matrices are needed only for 6-th order cumulants
5779 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5780 & j.eq.i+4 .and. l.eq.i+3)) THEN
5781 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5782 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5783 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5784 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5785 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5786 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5787 & ADtEAderx(1,1,1,1,1,1))
5788 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5789 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5790 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5791 & ADtEA1derx(1,1,1,1,1,1))
5793 C End 6-th order cumulants
5794 call transpose2(EUgder(1,1,k),auxmat(1,1))
5795 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5796 call transpose2(EUg(1,1,k),auxmat(1,1))
5797 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5798 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5802 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5803 & EAEAderx(1,1,lll,kkk,iii,1))
5807 C A2T kernel(i+1)T A1
5808 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5809 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5810 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5811 C Following matrices are needed only for 6-th order cumulants
5812 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5813 & j.eq.i+4 .and. l.eq.i+3)) THEN
5814 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5815 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5816 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5817 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5818 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5819 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5820 & ADtEAderx(1,1,1,1,1,2))
5821 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5822 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5823 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5824 & ADtEA1derx(1,1,1,1,1,2))
5826 C End 6-th order cumulants
5827 call transpose2(EUgder(1,1,j),auxmat(1,1))
5828 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5829 call transpose2(EUg(1,1,j),auxmat(1,1))
5830 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5831 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5835 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5836 & EAEAderx(1,1,lll,kkk,iii,2))
5841 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5842 C They are needed only when the fifth- or the sixth-order cumulants are
5844 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5845 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5846 call transpose2(AEA(1,1,1),auxmat(1,1))
5847 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5848 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5849 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5850 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5851 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5852 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5853 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5854 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5855 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5856 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5857 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5858 call transpose2(AEA(1,1,2),auxmat(1,1))
5859 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5860 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5861 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5862 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5863 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5864 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5865 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5866 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5867 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5868 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5869 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5870 C Calculate the Cartesian derivatives of the vectors.
5874 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5875 call matvec2(auxmat(1,1),b1(1,iti),
5876 & AEAb1derx(1,lll,kkk,iii,1,1))
5877 call matvec2(auxmat(1,1),Ub2(1,i),
5878 & AEAb2derx(1,lll,kkk,iii,1,1))
5879 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5880 & AEAb1derx(1,lll,kkk,iii,2,1))
5881 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5882 & AEAb2derx(1,lll,kkk,iii,2,1))
5883 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5884 call matvec2(auxmat(1,1),b1(1,itl),
5885 & AEAb1derx(1,lll,kkk,iii,1,2))
5886 call matvec2(auxmat(1,1),Ub2(1,l),
5887 & AEAb2derx(1,lll,kkk,iii,1,2))
5888 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5889 & AEAb1derx(1,lll,kkk,iii,2,2))
5890 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5891 & AEAb2derx(1,lll,kkk,iii,2,2))
5900 C---------------------------------------------------------------------------
5901 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5902 & KK,KKderg,AKA,AKAderg,AKAderx)
5906 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5907 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5908 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5913 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5915 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5918 cd if (lprn) write (2,*) 'In kernel'
5920 cd if (lprn) write (2,*) 'kkk=',kkk
5922 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5923 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5925 cd write (2,*) 'lll=',lll
5926 cd write (2,*) 'iii=1'
5928 cd write (2,'(3(2f10.5),5x)')
5929 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5932 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5933 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5935 cd write (2,*) 'lll=',lll
5936 cd write (2,*) 'iii=2'
5938 cd write (2,'(3(2f10.5),5x)')
5939 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5946 C---------------------------------------------------------------------------
5947 double precision function eello4(i,j,k,l,jj,kk)
5948 implicit real*8 (a-h,o-z)
5949 include 'DIMENSIONS'
5950 include 'DIMENSIONS.ZSCOPT'
5951 include 'COMMON.IOUNITS'
5952 include 'COMMON.CHAIN'
5953 include 'COMMON.DERIV'
5954 include 'COMMON.INTERACT'
5955 include 'COMMON.CONTACTS'
5956 include 'COMMON.TORSION'
5957 include 'COMMON.VAR'
5958 include 'COMMON.GEO'
5959 double precision pizda(2,2),ggg1(3),ggg2(3)
5960 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5964 cd print *,'eello4:',i,j,k,l,jj,kk
5965 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5966 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5967 cold eij=facont_hb(jj,i)
5968 cold ekl=facont_hb(kk,k)
5970 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5972 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5973 gcorr_loc(k-1)=gcorr_loc(k-1)
5974 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5976 gcorr_loc(l-1)=gcorr_loc(l-1)
5977 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5979 gcorr_loc(j-1)=gcorr_loc(j-1)
5980 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5985 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5986 & -EAEAderx(2,2,lll,kkk,iii,1)
5987 cd derx(lll,kkk,iii)=0.0d0
5991 cd gcorr_loc(l-1)=0.0d0
5992 cd gcorr_loc(j-1)=0.0d0
5993 cd gcorr_loc(k-1)=0.0d0
5995 cd write (iout,*)'Contacts have occurred for peptide groups',
5996 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5997 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5998 if (j.lt.nres-1) then
6005 if (l.lt.nres-1) then
6013 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6014 ggg1(ll)=eel4*g_contij(ll,1)
6015 ggg2(ll)=eel4*g_contij(ll,2)
6016 ghalf=0.5d0*ggg1(ll)
6018 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6019 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6020 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6021 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6022 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6023 ghalf=0.5d0*ggg2(ll)
6025 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6026 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6027 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6028 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6033 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6034 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6039 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6040 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6046 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6051 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6055 cd write (2,*) iii,gcorr_loc(iii)
6059 cd write (2,*) 'ekont',ekont
6060 cd write (iout,*) 'eello4',ekont*eel4
6063 C---------------------------------------------------------------------------
6064 double precision function eello5(i,j,k,l,jj,kk)
6065 implicit real*8 (a-h,o-z)
6066 include 'DIMENSIONS'
6067 include 'DIMENSIONS.ZSCOPT'
6068 include 'COMMON.IOUNITS'
6069 include 'COMMON.CHAIN'
6070 include 'COMMON.DERIV'
6071 include 'COMMON.INTERACT'
6072 include 'COMMON.CONTACTS'
6073 include 'COMMON.TORSION'
6074 include 'COMMON.VAR'
6075 include 'COMMON.GEO'
6076 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6077 double precision ggg1(3),ggg2(3)
6078 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6083 C /l\ / \ \ / \ / \ / C
6084 C / \ / \ \ / \ / \ / C
6085 C j| o |l1 | o | o| o | | o |o C
6086 C \ |/k\| |/ \| / |/ \| |/ \| C
6087 C \i/ \ / \ / / \ / \ C
6089 C (I) (II) (III) (IV) C
6091 C eello5_1 eello5_2 eello5_3 eello5_4 C
6093 C Antiparallel chains C
6096 C /j\ / \ \ / \ / \ / C
6097 C / \ / \ \ / \ / \ / C
6098 C j1| o |l | o | o| o | | o |o C
6099 C \ |/k\| |/ \| / |/ \| |/ \| C
6100 C \i/ \ / \ / / \ / \ C
6102 C (I) (II) (III) (IV) C
6104 C eello5_1 eello5_2 eello5_3 eello5_4 C
6106 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6108 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6109 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6114 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6116 itk=itortyp(itype(k))
6117 itl=itortyp(itype(l))
6118 itj=itortyp(itype(j))
6123 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6124 cd & eel5_3_num,eel5_4_num)
6128 derx(lll,kkk,iii)=0.0d0
6132 cd eij=facont_hb(jj,i)
6133 cd ekl=facont_hb(kk,k)
6135 cd write (iout,*)'Contacts have occurred for peptide groups',
6136 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6138 C Contribution from the graph I.
6139 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6140 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6141 call transpose2(EUg(1,1,k),auxmat(1,1))
6142 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6143 vv(1)=pizda(1,1)-pizda(2,2)
6144 vv(2)=pizda(1,2)+pizda(2,1)
6145 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6146 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6148 C Explicit gradient in virtual-dihedral angles.
6149 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6150 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6151 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6152 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6153 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6154 vv(1)=pizda(1,1)-pizda(2,2)
6155 vv(2)=pizda(1,2)+pizda(2,1)
6156 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6157 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6158 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6159 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6160 vv(1)=pizda(1,1)-pizda(2,2)
6161 vv(2)=pizda(1,2)+pizda(2,1)
6163 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6164 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6165 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6167 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6168 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6169 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6171 C Cartesian gradient
6175 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6177 vv(1)=pizda(1,1)-pizda(2,2)
6178 vv(2)=pizda(1,2)+pizda(2,1)
6179 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6180 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6181 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6188 C Contribution from graph II
6189 call transpose2(EE(1,1,itk),auxmat(1,1))
6190 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6191 vv(1)=pizda(1,1)+pizda(2,2)
6192 vv(2)=pizda(2,1)-pizda(1,2)
6193 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6194 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6196 C Explicit gradient in virtual-dihedral angles.
6197 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6198 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6199 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6200 vv(1)=pizda(1,1)+pizda(2,2)
6201 vv(2)=pizda(2,1)-pizda(1,2)
6203 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6204 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6205 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6207 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6208 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6209 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6211 C Cartesian gradient
6215 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6217 vv(1)=pizda(1,1)+pizda(2,2)
6218 vv(2)=pizda(2,1)-pizda(1,2)
6219 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6220 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6221 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6230 C Parallel orientation
6231 C Contribution from graph III
6232 call transpose2(EUg(1,1,l),auxmat(1,1))
6233 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6234 vv(1)=pizda(1,1)-pizda(2,2)
6235 vv(2)=pizda(1,2)+pizda(2,1)
6236 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6237 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6239 C Explicit gradient in virtual-dihedral angles.
6240 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6241 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6242 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6243 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6244 vv(1)=pizda(1,1)-pizda(2,2)
6245 vv(2)=pizda(1,2)+pizda(2,1)
6246 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6247 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6248 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6249 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6250 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6251 vv(1)=pizda(1,1)-pizda(2,2)
6252 vv(2)=pizda(1,2)+pizda(2,1)
6253 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6254 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6255 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6256 C Cartesian gradient
6260 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6262 vv(1)=pizda(1,1)-pizda(2,2)
6263 vv(2)=pizda(1,2)+pizda(2,1)
6264 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6265 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6266 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6272 C Contribution from graph IV
6274 call transpose2(EE(1,1,itl),auxmat(1,1))
6275 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6279 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6281 C Explicit gradient in virtual-dihedral angles.
6282 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6283 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6284 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6285 vv(1)=pizda(1,1)+pizda(2,2)
6286 vv(2)=pizda(2,1)-pizda(1,2)
6287 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6288 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6289 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6290 C Cartesian gradient
6294 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6296 vv(1)=pizda(1,1)+pizda(2,2)
6297 vv(2)=pizda(2,1)-pizda(1,2)
6298 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6299 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6300 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6306 C Antiparallel orientation
6307 C Contribution from graph III
6309 call transpose2(EUg(1,1,j),auxmat(1,1))
6310 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6311 vv(1)=pizda(1,1)-pizda(2,2)
6312 vv(2)=pizda(1,2)+pizda(2,1)
6313 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6314 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6316 C Explicit gradient in virtual-dihedral angles.
6317 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6318 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6319 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6320 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6321 vv(1)=pizda(1,1)-pizda(2,2)
6322 vv(2)=pizda(1,2)+pizda(2,1)
6323 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6324 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6325 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6326 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6327 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6328 vv(1)=pizda(1,1)-pizda(2,2)
6329 vv(2)=pizda(1,2)+pizda(2,1)
6330 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6331 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6332 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6333 C Cartesian gradient
6337 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6339 vv(1)=pizda(1,1)-pizda(2,2)
6340 vv(2)=pizda(1,2)+pizda(2,1)
6341 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6342 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6343 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6349 C Contribution from graph IV
6351 call transpose2(EE(1,1,itj),auxmat(1,1))
6352 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6356 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6358 C Explicit gradient in virtual-dihedral angles.
6359 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6360 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6361 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6362 vv(1)=pizda(1,1)+pizda(2,2)
6363 vv(2)=pizda(2,1)-pizda(1,2)
6364 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6365 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6366 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6367 C Cartesian gradient
6371 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6373 vv(1)=pizda(1,1)+pizda(2,2)
6374 vv(2)=pizda(2,1)-pizda(1,2)
6375 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6376 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6377 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6384 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6385 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6386 cd write (2,*) 'ijkl',i,j,k,l
6387 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6388 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6390 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6391 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6392 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6393 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6395 if (j.lt.nres-1) then
6402 if (l.lt.nres-1) then
6412 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6414 ggg1(ll)=eel5*g_contij(ll,1)
6415 ggg2(ll)=eel5*g_contij(ll,2)
6416 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6417 ghalf=0.5d0*ggg1(ll)
6419 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6420 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6421 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6422 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6423 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6424 ghalf=0.5d0*ggg2(ll)
6426 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6427 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6428 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6429 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6434 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6435 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6440 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6441 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6447 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6452 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6456 cd write (2,*) iii,g_corr5_loc(iii)
6460 cd write (2,*) 'ekont',ekont
6461 cd write (iout,*) 'eello5',ekont*eel5
6464 c--------------------------------------------------------------------------
6465 double precision function eello6(i,j,k,l,jj,kk)
6466 implicit real*8 (a-h,o-z)
6467 include 'DIMENSIONS'
6468 include 'DIMENSIONS.ZSCOPT'
6469 include 'COMMON.IOUNITS'
6470 include 'COMMON.CHAIN'
6471 include 'COMMON.DERIV'
6472 include 'COMMON.INTERACT'
6473 include 'COMMON.CONTACTS'
6474 include 'COMMON.TORSION'
6475 include 'COMMON.VAR'
6476 include 'COMMON.GEO'
6477 include 'COMMON.FFIELD'
6478 double precision ggg1(3),ggg2(3)
6479 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6484 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6492 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6493 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6497 derx(lll,kkk,iii)=0.0d0
6501 cd eij=facont_hb(jj,i)
6502 cd ekl=facont_hb(kk,k)
6508 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6509 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6510 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6511 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6512 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6513 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6515 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6516 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6517 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6518 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6519 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6520 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6524 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6526 C If turn contributions are considered, they will be handled separately.
6527 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6528 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6529 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6530 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6531 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6532 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6533 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6536 if (j.lt.nres-1) then
6543 if (l.lt.nres-1) then
6551 ggg1(ll)=eel6*g_contij(ll,1)
6552 ggg2(ll)=eel6*g_contij(ll,2)
6553 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6554 ghalf=0.5d0*ggg1(ll)
6556 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6557 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6558 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6559 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6560 ghalf=0.5d0*ggg2(ll)
6561 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6563 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6564 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6565 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6566 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6571 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6572 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6577 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6578 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6584 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6589 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6593 cd write (2,*) iii,g_corr6_loc(iii)
6597 cd write (2,*) 'ekont',ekont
6598 cd write (iout,*) 'eello6',ekont*eel6
6601 c--------------------------------------------------------------------------
6602 double precision function eello6_graph1(i,j,k,l,imat,swap)
6603 implicit real*8 (a-h,o-z)
6604 include 'DIMENSIONS'
6605 include 'DIMENSIONS.ZSCOPT'
6606 include 'COMMON.IOUNITS'
6607 include 'COMMON.CHAIN'
6608 include 'COMMON.DERIV'
6609 include 'COMMON.INTERACT'
6610 include 'COMMON.CONTACTS'
6611 include 'COMMON.TORSION'
6612 include 'COMMON.VAR'
6613 include 'COMMON.GEO'
6614 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6618 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6620 C Parallel Antiparallel C
6626 C \ j|/k\| / \ |/k\|l / C
6631 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6632 itk=itortyp(itype(k))
6633 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6634 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6635 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6636 call transpose2(EUgC(1,1,k),auxmat(1,1))
6637 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6638 vv1(1)=pizda1(1,1)-pizda1(2,2)
6639 vv1(2)=pizda1(1,2)+pizda1(2,1)
6640 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6641 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6642 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6643 s5=scalar2(vv(1),Dtobr2(1,i))
6644 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6645 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6646 if (.not. calc_grad) return
6647 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6648 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6649 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6650 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6651 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6652 & +scalar2(vv(1),Dtobr2der(1,i)))
6653 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6654 vv1(1)=pizda1(1,1)-pizda1(2,2)
6655 vv1(2)=pizda1(1,2)+pizda1(2,1)
6656 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6657 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6659 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6660 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6661 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6662 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6663 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6665 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6666 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6667 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6668 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6669 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6671 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6672 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6673 vv1(1)=pizda1(1,1)-pizda1(2,2)
6674 vv1(2)=pizda1(1,2)+pizda1(2,1)
6675 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6676 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6677 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6678 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6687 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6688 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6689 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6690 call transpose2(EUgC(1,1,k),auxmat(1,1))
6691 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6693 vv1(1)=pizda1(1,1)-pizda1(2,2)
6694 vv1(2)=pizda1(1,2)+pizda1(2,1)
6695 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6696 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6697 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6698 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6699 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6700 s5=scalar2(vv(1),Dtobr2(1,i))
6701 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6707 c----------------------------------------------------------------------------
6708 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6709 implicit real*8 (a-h,o-z)
6710 include 'DIMENSIONS'
6711 include 'DIMENSIONS.ZSCOPT'
6712 include 'COMMON.IOUNITS'
6713 include 'COMMON.CHAIN'
6714 include 'COMMON.DERIV'
6715 include 'COMMON.INTERACT'
6716 include 'COMMON.CONTACTS'
6717 include 'COMMON.TORSION'
6718 include 'COMMON.VAR'
6719 include 'COMMON.GEO'
6721 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6722 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6727 C Parallel Antiparallel C
6733 C \ j|/k\| \ |/k\|l C
6738 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6739 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6740 C AL 7/4/01 s1 would occur in the sixth-order moment,
6741 C but not in a cluster cumulant
6743 s1=dip(1,jj,i)*dip(1,kk,k)
6745 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6746 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6747 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6748 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6749 call transpose2(EUg(1,1,k),auxmat(1,1))
6750 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6751 vv(1)=pizda(1,1)-pizda(2,2)
6752 vv(2)=pizda(1,2)+pizda(2,1)
6753 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6754 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6756 eello6_graph2=-(s1+s2+s3+s4)
6758 eello6_graph2=-(s2+s3+s4)
6761 if (.not. calc_grad) return
6762 C Derivatives in gamma(i-1)
6765 s1=dipderg(1,jj,i)*dip(1,kk,k)
6767 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6768 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6769 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6770 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6772 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6774 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6776 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6778 C Derivatives in gamma(k-1)
6780 s1=dip(1,jj,i)*dipderg(1,kk,k)
6782 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6783 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6784 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6785 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6786 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6787 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6788 vv(1)=pizda(1,1)-pizda(2,2)
6789 vv(2)=pizda(1,2)+pizda(2,1)
6790 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6792 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6794 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6796 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6797 C Derivatives in gamma(j-1) or gamma(l-1)
6800 s1=dipderg(3,jj,i)*dip(1,kk,k)
6802 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6803 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6804 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6805 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6806 vv(1)=pizda(1,1)-pizda(2,2)
6807 vv(2)=pizda(1,2)+pizda(2,1)
6808 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6811 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6813 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6816 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6817 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6819 C Derivatives in gamma(l-1) or gamma(j-1)
6822 s1=dip(1,jj,i)*dipderg(3,kk,k)
6824 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6825 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6826 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6827 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6828 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6829 vv(1)=pizda(1,1)-pizda(2,2)
6830 vv(2)=pizda(1,2)+pizda(2,1)
6831 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6834 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6836 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6839 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6840 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6842 C Cartesian derivatives.
6844 write (2,*) 'In eello6_graph2'
6846 write (2,*) 'iii=',iii
6848 write (2,*) 'kkk=',kkk
6850 write (2,'(3(2f10.5),5x)')
6851 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6861 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6863 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6866 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6868 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6869 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6871 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6872 call transpose2(EUg(1,1,k),auxmat(1,1))
6873 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6875 vv(1)=pizda(1,1)-pizda(2,2)
6876 vv(2)=pizda(1,2)+pizda(2,1)
6877 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6878 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6880 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6882 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6885 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6887 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6894 c----------------------------------------------------------------------------
6895 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6896 implicit real*8 (a-h,o-z)
6897 include 'DIMENSIONS'
6898 include 'DIMENSIONS.ZSCOPT'
6899 include 'COMMON.IOUNITS'
6900 include 'COMMON.CHAIN'
6901 include 'COMMON.DERIV'
6902 include 'COMMON.INTERACT'
6903 include 'COMMON.CONTACTS'
6904 include 'COMMON.TORSION'
6905 include 'COMMON.VAR'
6906 include 'COMMON.GEO'
6907 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6909 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6911 C Parallel Antiparallel C
6917 C j|/k\| / |/k\|l / C
6922 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6924 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6925 C energy moment and not to the cluster cumulant.
6926 iti=itortyp(itype(i))
6927 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6928 itj1=itortyp(itype(j+1))
6932 itk=itortyp(itype(k))
6933 itk1=itortyp(itype(k+1))
6934 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6935 itl1=itortyp(itype(l+1))
6940 s1=dip(4,jj,i)*dip(4,kk,k)
6942 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6943 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6944 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6945 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6946 call transpose2(EE(1,1,itk),auxmat(1,1))
6947 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6948 vv(1)=pizda(1,1)+pizda(2,2)
6949 vv(2)=pizda(2,1)-pizda(1,2)
6950 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6951 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6953 eello6_graph3=-(s1+s2+s3+s4)
6955 eello6_graph3=-(s2+s3+s4)
6958 if (.not. calc_grad) return
6959 C Derivatives in gamma(k-1)
6960 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6961 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6962 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6963 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6964 C Derivatives in gamma(l-1)
6965 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6966 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6967 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6968 vv(1)=pizda(1,1)+pizda(2,2)
6969 vv(2)=pizda(2,1)-pizda(1,2)
6970 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6971 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6972 C Cartesian derivatives.
6978 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6980 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6983 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6985 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6986 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6988 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6989 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6991 vv(1)=pizda(1,1)+pizda(2,2)
6992 vv(2)=pizda(2,1)-pizda(1,2)
6993 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6995 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6997 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7000 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7002 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7004 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7010 c----------------------------------------------------------------------------
7011 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7012 implicit real*8 (a-h,o-z)
7013 include 'DIMENSIONS'
7014 include 'DIMENSIONS.ZSCOPT'
7015 include 'COMMON.IOUNITS'
7016 include 'COMMON.CHAIN'
7017 include 'COMMON.DERIV'
7018 include 'COMMON.INTERACT'
7019 include 'COMMON.CONTACTS'
7020 include 'COMMON.TORSION'
7021 include 'COMMON.VAR'
7022 include 'COMMON.GEO'
7023 include 'COMMON.FFIELD'
7024 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7025 & auxvec1(2),auxmat1(2,2)
7027 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7029 C Parallel Antiparallel C
7035 C \ j|/k\| \ |/k\|l C
7040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7042 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7043 C energy moment and not to the cluster cumulant.
7044 cd write (2,*) 'eello_graph4: wturn6',wturn6
7045 iti=itortyp(itype(i))
7046 itj=itortyp(itype(j))
7047 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7048 itj1=itortyp(itype(j+1))
7052 itk=itortyp(itype(k))
7053 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7054 itk1=itortyp(itype(k+1))
7058 itl=itortyp(itype(l))
7059 if (l.lt.nres-1) then
7060 itl1=itortyp(itype(l+1))
7064 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7065 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7066 cd & ' itl',itl,' itl1',itl1
7069 s1=dip(3,jj,i)*dip(3,kk,k)
7071 s1=dip(2,jj,j)*dip(2,kk,l)
7074 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7075 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7077 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7078 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7080 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7081 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7083 call transpose2(EUg(1,1,k),auxmat(1,1))
7084 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7085 vv(1)=pizda(1,1)-pizda(2,2)
7086 vv(2)=pizda(2,1)+pizda(1,2)
7087 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7088 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7090 eello6_graph4=-(s1+s2+s3+s4)
7092 eello6_graph4=-(s2+s3+s4)
7094 if (.not. calc_grad) return
7095 C Derivatives in gamma(i-1)
7099 s1=dipderg(2,jj,i)*dip(3,kk,k)
7101 s1=dipderg(4,jj,j)*dip(2,kk,l)
7104 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7106 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7107 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7109 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7110 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7112 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7113 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7114 cd write (2,*) 'turn6 derivatives'
7116 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7118 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7122 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7124 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7128 C Derivatives in gamma(k-1)
7131 s1=dip(3,jj,i)*dipderg(2,kk,k)
7133 s1=dip(2,jj,j)*dipderg(4,kk,l)
7136 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7137 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7139 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7140 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7142 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7143 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7145 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7146 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7147 vv(1)=pizda(1,1)-pizda(2,2)
7148 vv(2)=pizda(2,1)+pizda(1,2)
7149 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7150 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7152 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7154 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7158 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7160 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7163 C Derivatives in gamma(j-1) or gamma(l-1)
7164 if (l.eq.j+1 .and. l.gt.1) then
7165 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7166 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7167 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7168 vv(1)=pizda(1,1)-pizda(2,2)
7169 vv(2)=pizda(2,1)+pizda(1,2)
7170 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7171 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7172 else if (j.gt.1) then
7173 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7174 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7175 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7176 vv(1)=pizda(1,1)-pizda(2,2)
7177 vv(2)=pizda(2,1)+pizda(1,2)
7178 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7179 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7180 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7182 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7185 C Cartesian derivatives.
7192 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7194 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7198 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7200 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7204 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7206 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7208 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7209 & b1(1,itj1),auxvec(1))
7210 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7212 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7213 & b1(1,itl1),auxvec(1))
7214 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7216 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7218 vv(1)=pizda(1,1)-pizda(2,2)
7219 vv(2)=pizda(2,1)+pizda(1,2)
7220 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7222 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7224 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7227 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7230 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7233 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7235 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7237 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7241 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7243 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7246 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7248 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7256 c----------------------------------------------------------------------------
7257 double precision function eello_turn6(i,jj,kk)
7258 implicit real*8 (a-h,o-z)
7259 include 'DIMENSIONS'
7260 include 'DIMENSIONS.ZSCOPT'
7261 include 'COMMON.IOUNITS'
7262 include 'COMMON.CHAIN'
7263 include 'COMMON.DERIV'
7264 include 'COMMON.INTERACT'
7265 include 'COMMON.CONTACTS'
7266 include 'COMMON.TORSION'
7267 include 'COMMON.VAR'
7268 include 'COMMON.GEO'
7269 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7270 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7272 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7273 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7274 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7275 C the respective energy moment and not to the cluster cumulant.
7280 iti=itortyp(itype(i))
7281 itk=itortyp(itype(k))
7282 itk1=itortyp(itype(k+1))
7283 itl=itortyp(itype(l))
7284 itj=itortyp(itype(j))
7285 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7286 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7287 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7292 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7294 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7298 derx_turn(lll,kkk,iii)=0.0d0
7305 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7307 cd write (2,*) 'eello6_5',eello6_5
7309 call transpose2(AEA(1,1,1),auxmat(1,1))
7310 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7311 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7312 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7316 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7317 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7318 s2 = scalar2(b1(1,itk),vtemp1(1))
7320 call transpose2(AEA(1,1,2),atemp(1,1))
7321 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7322 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7323 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7327 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7328 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7329 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7331 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7332 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7333 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7334 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7335 ss13 = scalar2(b1(1,itk),vtemp4(1))
7336 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7340 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7346 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7348 C Derivatives in gamma(i+2)
7350 call transpose2(AEA(1,1,1),auxmatd(1,1))
7351 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7352 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7353 call transpose2(AEAderg(1,1,2),atempd(1,1))
7354 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7355 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7359 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7360 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7361 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7367 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7368 C Derivatives in gamma(i+3)
7370 call transpose2(AEA(1,1,1),auxmatd(1,1))
7371 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7372 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7373 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7377 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7378 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7379 s2d = scalar2(b1(1,itk),vtemp1d(1))
7381 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7382 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7384 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7386 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7387 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7388 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7398 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7399 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7401 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7402 & -0.5d0*ekont*(s2d+s12d)
7404 C Derivatives in gamma(i+4)
7405 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7406 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7407 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7409 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7410 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7411 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7421 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7423 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7425 C Derivatives in gamma(i+5)
7427 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7428 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7429 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7433 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7434 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7435 s2d = scalar2(b1(1,itk),vtemp1d(1))
7437 call transpose2(AEA(1,1,2),atempd(1,1))
7438 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7439 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7443 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7444 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7446 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7447 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7448 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7458 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7459 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7461 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7462 & -0.5d0*ekont*(s2d+s12d)
7464 C Cartesian derivatives
7469 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7470 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7471 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7475 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7476 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7478 s2d = scalar2(b1(1,itk),vtemp1d(1))
7480 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7481 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7482 s8d = -(atempd(1,1)+atempd(2,2))*
7483 & scalar2(cc(1,1,itl),vtemp2(1))
7487 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7489 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7490 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7497 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7500 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7504 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7505 & - 0.5d0*(s8d+s12d)
7507 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7516 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7518 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7519 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7520 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7521 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7522 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7524 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7525 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7526 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7530 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7531 cd & 16*eel_turn6_num
7533 if (j.lt.nres-1) then
7540 if (l.lt.nres-1) then
7548 ggg1(ll)=eel_turn6*g_contij(ll,1)
7549 ggg2(ll)=eel_turn6*g_contij(ll,2)
7550 ghalf=0.5d0*ggg1(ll)
7552 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7553 & +ekont*derx_turn(ll,2,1)
7554 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7555 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7556 & +ekont*derx_turn(ll,4,1)
7557 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7558 ghalf=0.5d0*ggg2(ll)
7560 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7561 & +ekont*derx_turn(ll,2,2)
7562 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7563 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7564 & +ekont*derx_turn(ll,4,2)
7565 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7570 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7575 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7581 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7586 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7590 cd write (2,*) iii,g_corr6_loc(iii)
7593 eello_turn6=ekont*eel_turn6
7594 cd write (2,*) 'ekont',ekont
7595 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7598 crc-------------------------------------------------
7599 SUBROUTINE MATVEC2(A1,V1,V2)
7600 implicit real*8 (a-h,o-z)
7601 include 'DIMENSIONS'
7602 DIMENSION A1(2,2),V1(2),V2(2)
7606 c 3 VI=VI+A1(I,K)*V1(K)
7610 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7611 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7616 C---------------------------------------
7617 SUBROUTINE MATMAT2(A1,A2,A3)
7618 implicit real*8 (a-h,o-z)
7619 include 'DIMENSIONS'
7620 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7621 c DIMENSION AI3(2,2)
7625 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7631 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7632 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7633 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7634 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7642 c-------------------------------------------------------------------------
7643 double precision function scalar2(u,v)
7645 double precision u(2),v(2)
7648 scalar2=u(1)*v(1)+u(2)*v(2)
7652 C-----------------------------------------------------------------------------
7654 subroutine transpose2(a,at)
7656 double precision a(2,2),at(2,2)
7663 c--------------------------------------------------------------------------
7664 subroutine transpose(n,a,at)
7667 double precision a(n,n),at(n,n)
7675 C---------------------------------------------------------------------------
7676 subroutine prodmat3(a1,a2,kk,transp,prod)
7679 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7681 crc double precision auxmat(2,2),prod_(2,2)
7684 crc call transpose2(kk(1,1),auxmat(1,1))
7685 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7686 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7688 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7689 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7690 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7691 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7692 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7693 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7694 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7695 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7698 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7699 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7701 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7702 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7703 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7704 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7705 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7706 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7707 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7708 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7711 c call transpose2(a2(1,1),a2t(1,1))
7714 crc print *,((prod_(i,j),i=1,2),j=1,2)
7715 crc print *,((prod(i,j),i=1,2),j=1,2)
7719 C-----------------------------------------------------------------------------
7720 double precision function scalar(u,v)
7722 double precision u(3),v(3)
7732 C-----------------------------------------------------------------------
7733 double precision function sscale(r)
7734 double precision r,gamm
7735 include "COMMON.SPLITELE"
7736 if(r.lt.r_cut-rlamb) then
7738 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7739 gamm=(r-(r_cut-rlamb))/rlamb
7740 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7746 C-----------------------------------------------------------------------
7747 C-----------------------------------------------------------------------
7748 double precision function sscagrad(r)
7749 double precision r,gamm
7750 include "COMMON.SPLITELE"
7751 if(r.lt.r_cut-rlamb) then
7753 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7754 gamm=(r-(r_cut-rlamb))/rlamb
7755 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7761 C-----------------------------------------------------------------------