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-xi)**2+(yj-yi)**2+(zj-zi)**2
1989 xj=xj_safe+xshift*boxxsize
1990 yj=yj_safe+yshift*boxysize
1991 zj=zj_safe+zshift*boxzsize
1992 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1993 if(dist_temp.lt.dist_init) then
2003 if (isubchap.eq.1) then
2013 rij=xj*xj+yj*yj+zj*zj
2014 sss=sscale(sqrt(rij))
2015 sssgrad=sscagrad(sqrt(rij))
2021 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2022 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2023 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2024 fac=cosa-3.0D0*cosb*cosg
2026 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2027 if (j.eq.i+2) ev1=scal_el*ev1
2032 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2035 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2036 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2037 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2039 evdw1=evdw1+evdwij*sss
2040 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2041 c &'evdw1',i,j,evdwij
2042 c &,iteli,itelj,aaa,evdw1
2044 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2045 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2046 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2047 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2048 c & xmedi,ymedi,zmedi,xj,yj,zj
2050 C Calculate contributions to the Cartesian gradient.
2053 facvdw=-6*rrmij*(ev1+evdwij)*sss
2054 facel=-3*rrmij*(el1+eesij)
2061 * Radial derivatives. First process both termini of the fragment (i,j)
2068 gelc(k,i)=gelc(k,i)+ghalf
2069 gelc(k,j)=gelc(k,j)+ghalf
2072 * Loop over residues i+1 thru j-1.
2076 gelc(l,k)=gelc(l,k)+ggg(l)
2082 if (sss.gt.0.0) then
2083 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2084 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2085 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2093 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2094 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2097 * Loop over residues i+1 thru j-1.
2101 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2105 facvdw=(ev1+evdwij)*sss
2108 fac=-3*rrmij*(facvdw+facvdw+facel)
2114 * Radial derivatives. First process both termini of the fragment (i,j)
2121 gelc(k,i)=gelc(k,i)+ghalf
2122 gelc(k,j)=gelc(k,j)+ghalf
2125 * Loop over residues i+1 thru j-1.
2129 gelc(l,k)=gelc(l,k)+ggg(l)
2136 ecosa=2.0D0*fac3*fac1+fac4
2139 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2140 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2142 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2143 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2145 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2146 cd & (dcosg(k),k=1,3)
2148 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2152 gelc(k,i)=gelc(k,i)+ghalf
2153 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2154 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2155 gelc(k,j)=gelc(k,j)+ghalf
2156 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2157 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2161 gelc(l,k)=gelc(l,k)+ggg(l)
2166 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2167 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2168 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2170 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2171 C energy of a peptide unit is assumed in the form of a second-order
2172 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2173 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2174 C are computed for EVERY pair of non-contiguous peptide groups.
2176 if (j.lt.nres-1) then
2187 muij(kkk)=mu(k,i)*mu(l,j)
2190 cd write (iout,*) 'EELEC: i',i,' j',j
2191 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2192 cd write(iout,*) 'muij',muij
2193 ury=scalar(uy(1,i),erij)
2194 urz=scalar(uz(1,i),erij)
2195 vry=scalar(uy(1,j),erij)
2196 vrz=scalar(uz(1,j),erij)
2197 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2198 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2199 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2200 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2201 C For diagnostics only
2206 fac=dsqrt(-ael6i)*r3ij
2207 cd write (2,*) 'fac=',fac
2208 C For diagnostics only
2214 cd write (iout,'(4i5,4f10.5)')
2215 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2216 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2217 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2218 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2219 cd write (iout,'(4f10.5)')
2220 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2221 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2222 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2223 cd write (iout,'(2i3,9f10.5/)') i,j,
2224 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2226 C Derivatives of the elements of A in virtual-bond vectors
2227 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2234 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2235 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2236 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2237 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2238 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2239 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2240 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2241 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2242 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2243 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2244 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2245 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2255 C Compute radial contributions to the gradient
2277 C Add the contributions coming from er
2280 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2281 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2282 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2283 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2286 C Derivatives in DC(i)
2287 ghalf1=0.5d0*agg(k,1)
2288 ghalf2=0.5d0*agg(k,2)
2289 ghalf3=0.5d0*agg(k,3)
2290 ghalf4=0.5d0*agg(k,4)
2291 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2292 & -3.0d0*uryg(k,2)*vry)+ghalf1
2293 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2294 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2295 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2296 & -3.0d0*urzg(k,2)*vry)+ghalf3
2297 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2298 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2299 C Derivatives in DC(i+1)
2300 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2301 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2302 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2303 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2304 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2305 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2306 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2307 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2308 C Derivatives in DC(j)
2309 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2310 & -3.0d0*vryg(k,2)*ury)+ghalf1
2311 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2312 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2313 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2314 & -3.0d0*vryg(k,2)*urz)+ghalf3
2315 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2316 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2317 C Derivatives in DC(j+1) or DC(nres-1)
2318 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2319 & -3.0d0*vryg(k,3)*ury)
2320 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2321 & -3.0d0*vrzg(k,3)*ury)
2322 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2323 & -3.0d0*vryg(k,3)*urz)
2324 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2325 & -3.0d0*vrzg(k,3)*urz)
2330 C Derivatives in DC(i+1)
2331 cd aggi1(k,1)=agg(k,1)
2332 cd aggi1(k,2)=agg(k,2)
2333 cd aggi1(k,3)=agg(k,3)
2334 cd aggi1(k,4)=agg(k,4)
2335 C Derivatives in DC(j)
2340 C Derivatives in DC(j+1)
2345 if (j.eq.nres-1 .and. i.lt.j-2) then
2347 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2348 cd aggj1(k,l)=agg(k,l)
2354 C Check the loc-el terms by numerical integration
2364 aggi(k,l)=-aggi(k,l)
2365 aggi1(k,l)=-aggi1(k,l)
2366 aggj(k,l)=-aggj(k,l)
2367 aggj1(k,l)=-aggj1(k,l)
2370 if (j.lt.nres-1) then
2376 aggi(k,l)=-aggi(k,l)
2377 aggi1(k,l)=-aggi1(k,l)
2378 aggj(k,l)=-aggj(k,l)
2379 aggj1(k,l)=-aggj1(k,l)
2390 aggi(k,l)=-aggi(k,l)
2391 aggi1(k,l)=-aggi1(k,l)
2392 aggj(k,l)=-aggj(k,l)
2393 aggj1(k,l)=-aggj1(k,l)
2399 IF (wel_loc.gt.0.0d0) THEN
2400 C Contribution to the local-electrostatic energy coming from the i-j pair
2401 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2403 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2404 c write (iout,'(a6,2i5,0pf7.3)')
2405 c & 'eelloc',i,j,eel_loc_ij
2406 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2407 eel_loc=eel_loc+eel_loc_ij
2408 C Partial derivatives in virtual-bond dihedral angles gamma
2411 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2412 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2413 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2414 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2415 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2416 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2417 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2418 cd write(iout,*) 'agg ',agg
2419 cd write(iout,*) 'aggi ',aggi
2420 cd write(iout,*) 'aggi1',aggi1
2421 cd write(iout,*) 'aggj ',aggj
2422 cd write(iout,*) 'aggj1',aggj1
2424 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2426 ggg(l)=agg(l,1)*muij(1)+
2427 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2431 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2434 C Remaining derivatives of eello
2436 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2437 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2438 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2439 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2440 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2441 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2442 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2443 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2447 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2448 C Contributions from turns
2453 call eturn34(i,j,eello_turn3,eello_turn4)
2455 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2456 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2458 C Calculate the contact function. The ith column of the array JCONT will
2459 C contain the numbers of atoms that make contacts with the atom I (of numbers
2460 C greater than I). The arrays FACONT and GACONT will contain the values of
2461 C the contact function and its derivative.
2462 c r0ij=1.02D0*rpp(iteli,itelj)
2463 c r0ij=1.11D0*rpp(iteli,itelj)
2464 r0ij=2.20D0*rpp(iteli,itelj)
2465 c r0ij=1.55D0*rpp(iteli,itelj)
2466 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2467 if (fcont.gt.0.0D0) then
2468 num_conti=num_conti+1
2469 if (num_conti.gt.maxconts) then
2470 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2471 & ' will skip next contacts for this conf.'
2473 jcont_hb(num_conti,i)=j
2474 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2475 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2476 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2478 d_cont(num_conti,i)=rij
2479 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2480 C --- Electrostatic-interaction matrix ---
2481 a_chuj(1,1,num_conti,i)=a22
2482 a_chuj(1,2,num_conti,i)=a23
2483 a_chuj(2,1,num_conti,i)=a32
2484 a_chuj(2,2,num_conti,i)=a33
2485 C --- Gradient of rij
2487 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2490 c a_chuj(1,1,num_conti,i)=-0.61d0
2491 c a_chuj(1,2,num_conti,i)= 0.4d0
2492 c a_chuj(2,1,num_conti,i)= 0.65d0
2493 c a_chuj(2,2,num_conti,i)= 0.50d0
2494 c else if (i.eq.2) then
2495 c a_chuj(1,1,num_conti,i)= 0.0d0
2496 c a_chuj(1,2,num_conti,i)= 0.0d0
2497 c a_chuj(2,1,num_conti,i)= 0.0d0
2498 c a_chuj(2,2,num_conti,i)= 0.0d0
2500 C --- and its gradients
2501 cd write (iout,*) 'i',i,' j',j
2503 cd write (iout,*) 'iii 1 kkk',kkk
2504 cd write (iout,*) agg(kkk,:)
2507 cd write (iout,*) 'iii 2 kkk',kkk
2508 cd write (iout,*) aggi(kkk,:)
2511 cd write (iout,*) 'iii 3 kkk',kkk
2512 cd write (iout,*) aggi1(kkk,:)
2515 cd write (iout,*) 'iii 4 kkk',kkk
2516 cd write (iout,*) aggj(kkk,:)
2519 cd write (iout,*) 'iii 5 kkk',kkk
2520 cd write (iout,*) aggj1(kkk,:)
2527 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2528 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2529 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2530 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2531 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2533 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2539 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2540 C Calculate contact energies
2542 wij=cosa-3.0D0*cosb*cosg
2545 c fac3=dsqrt(-ael6i)/r0ij**3
2546 fac3=dsqrt(-ael6i)*r3ij
2547 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2548 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2550 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2551 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2552 C Diagnostics. Comment out or remove after debugging!
2553 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2554 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2555 c ees0m(num_conti,i)=0.0D0
2557 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2558 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2559 facont_hb(num_conti,i)=fcont
2561 C Angular derivatives of the contact function
2562 ees0pij1=fac3/ees0pij
2563 ees0mij1=fac3/ees0mij
2564 fac3p=-3.0D0*fac3*rrmij
2565 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2566 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2568 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2569 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2570 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2571 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2572 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2573 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2574 ecosap=ecosa1+ecosa2
2575 ecosbp=ecosb1+ecosb2
2576 ecosgp=ecosg1+ecosg2
2577 ecosam=ecosa1-ecosa2
2578 ecosbm=ecosb1-ecosb2
2579 ecosgm=ecosg1-ecosg2
2588 fprimcont=fprimcont/rij
2589 cd facont_hb(num_conti,i)=1.0D0
2590 C Following line is for diagnostics.
2593 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2594 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2597 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2598 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2600 gggp(1)=gggp(1)+ees0pijp*xj
2601 gggp(2)=gggp(2)+ees0pijp*yj
2602 gggp(3)=gggp(3)+ees0pijp*zj
2603 gggm(1)=gggm(1)+ees0mijp*xj
2604 gggm(2)=gggm(2)+ees0mijp*yj
2605 gggm(3)=gggm(3)+ees0mijp*zj
2606 C Derivatives due to the contact function
2607 gacont_hbr(1,num_conti,i)=fprimcont*xj
2608 gacont_hbr(2,num_conti,i)=fprimcont*yj
2609 gacont_hbr(3,num_conti,i)=fprimcont*zj
2611 ghalfp=0.5D0*gggp(k)
2612 ghalfm=0.5D0*gggm(k)
2613 gacontp_hb1(k,num_conti,i)=ghalfp
2614 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2615 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2616 gacontp_hb2(k,num_conti,i)=ghalfp
2617 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2618 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2619 gacontp_hb3(k,num_conti,i)=gggp(k)
2620 gacontm_hb1(k,num_conti,i)=ghalfm
2621 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2622 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2623 gacontm_hb2(k,num_conti,i)=ghalfm
2624 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2625 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2626 gacontm_hb3(k,num_conti,i)=gggm(k)
2629 C Diagnostics. Comment out or remove after debugging!
2631 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2632 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2633 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2634 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2635 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2636 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2639 endif ! num_conti.le.maxconts
2644 num_cont_hb(i)=num_conti
2648 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2649 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2651 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2652 ccc eel_loc=eel_loc+eello_turn3
2655 C-----------------------------------------------------------------------------
2656 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2657 C Third- and fourth-order contributions from turns
2658 implicit real*8 (a-h,o-z)
2659 include 'DIMENSIONS'
2660 include 'DIMENSIONS.ZSCOPT'
2661 include 'COMMON.IOUNITS'
2662 include 'COMMON.GEO'
2663 include 'COMMON.VAR'
2664 include 'COMMON.LOCAL'
2665 include 'COMMON.CHAIN'
2666 include 'COMMON.DERIV'
2667 include 'COMMON.INTERACT'
2668 include 'COMMON.CONTACTS'
2669 include 'COMMON.TORSION'
2670 include 'COMMON.VECTORS'
2671 include 'COMMON.FFIELD'
2673 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2674 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2675 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2676 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2677 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2678 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2680 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2682 C Third-order contributions
2689 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2690 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2691 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2692 call transpose2(auxmat(1,1),auxmat1(1,1))
2693 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2694 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2695 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2696 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2697 cd & ' eello_turn3_num',4*eello_turn3_num
2699 C Derivatives in gamma(i)
2700 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2701 call transpose2(auxmat2(1,1),pizda(1,1))
2702 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2703 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2704 C Derivatives in gamma(i+1)
2705 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2706 call transpose2(auxmat2(1,1),pizda(1,1))
2707 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2708 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2709 & +0.5d0*(pizda(1,1)+pizda(2,2))
2710 C Cartesian derivatives
2712 a_temp(1,1)=aggi(l,1)
2713 a_temp(1,2)=aggi(l,2)
2714 a_temp(2,1)=aggi(l,3)
2715 a_temp(2,2)=aggi(l,4)
2716 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2717 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2718 & +0.5d0*(pizda(1,1)+pizda(2,2))
2719 a_temp(1,1)=aggi1(l,1)
2720 a_temp(1,2)=aggi1(l,2)
2721 a_temp(2,1)=aggi1(l,3)
2722 a_temp(2,2)=aggi1(l,4)
2723 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2724 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2725 & +0.5d0*(pizda(1,1)+pizda(2,2))
2726 a_temp(1,1)=aggj(l,1)
2727 a_temp(1,2)=aggj(l,2)
2728 a_temp(2,1)=aggj(l,3)
2729 a_temp(2,2)=aggj(l,4)
2730 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2731 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2732 & +0.5d0*(pizda(1,1)+pizda(2,2))
2733 a_temp(1,1)=aggj1(l,1)
2734 a_temp(1,2)=aggj1(l,2)
2735 a_temp(2,1)=aggj1(l,3)
2736 a_temp(2,2)=aggj1(l,4)
2737 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2738 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2739 & +0.5d0*(pizda(1,1)+pizda(2,2))
2742 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2745 C Fourth-order contributions
2753 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2754 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2755 iti1=itortyp(itype(i+1))
2756 iti2=itortyp(itype(i+2))
2757 iti3=itortyp(itype(i+3))
2758 call transpose2(EUg(1,1,i+1),e1t(1,1))
2759 call transpose2(Eug(1,1,i+2),e2t(1,1))
2760 call transpose2(Eug(1,1,i+3),e3t(1,1))
2761 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2762 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2763 s1=scalar2(b1(1,iti2),auxvec(1))
2764 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2765 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2766 s2=scalar2(b1(1,iti1),auxvec(1))
2767 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2768 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2769 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2770 eello_turn4=eello_turn4-(s1+s2+s3)
2771 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2772 cd & ' eello_turn4_num',8*eello_turn4_num
2773 C Derivatives in gamma(i)
2775 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2776 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2777 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2778 s1=scalar2(b1(1,iti2),auxvec(1))
2779 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2780 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2781 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2782 C Derivatives in gamma(i+1)
2783 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2784 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2785 s2=scalar2(b1(1,iti1),auxvec(1))
2786 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2787 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2788 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2789 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2790 C Derivatives in gamma(i+2)
2791 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2792 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2793 s1=scalar2(b1(1,iti2),auxvec(1))
2794 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2795 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2796 s2=scalar2(b1(1,iti1),auxvec(1))
2797 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2798 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2799 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2800 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2801 C Cartesian derivatives
2802 C Derivatives of this turn contributions in DC(i+2)
2803 if (j.lt.nres-1) then
2805 a_temp(1,1)=agg(l,1)
2806 a_temp(1,2)=agg(l,2)
2807 a_temp(2,1)=agg(l,3)
2808 a_temp(2,2)=agg(l,4)
2809 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2810 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2811 s1=scalar2(b1(1,iti2),auxvec(1))
2812 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2813 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2814 s2=scalar2(b1(1,iti1),auxvec(1))
2815 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2816 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2817 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2819 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2822 C Remaining derivatives of this turn contribution
2824 a_temp(1,1)=aggi(l,1)
2825 a_temp(1,2)=aggi(l,2)
2826 a_temp(2,1)=aggi(l,3)
2827 a_temp(2,2)=aggi(l,4)
2828 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2829 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2830 s1=scalar2(b1(1,iti2),auxvec(1))
2831 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2832 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2833 s2=scalar2(b1(1,iti1),auxvec(1))
2834 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2835 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2836 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2837 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2838 a_temp(1,1)=aggi1(l,1)
2839 a_temp(1,2)=aggi1(l,2)
2840 a_temp(2,1)=aggi1(l,3)
2841 a_temp(2,2)=aggi1(l,4)
2842 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2843 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2844 s1=scalar2(b1(1,iti2),auxvec(1))
2845 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2846 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2847 s2=scalar2(b1(1,iti1),auxvec(1))
2848 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2849 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2850 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2851 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2852 a_temp(1,1)=aggj(l,1)
2853 a_temp(1,2)=aggj(l,2)
2854 a_temp(2,1)=aggj(l,3)
2855 a_temp(2,2)=aggj(l,4)
2856 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2857 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2858 s1=scalar2(b1(1,iti2),auxvec(1))
2859 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2860 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2861 s2=scalar2(b1(1,iti1),auxvec(1))
2862 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2863 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2864 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2865 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2866 a_temp(1,1)=aggj1(l,1)
2867 a_temp(1,2)=aggj1(l,2)
2868 a_temp(2,1)=aggj1(l,3)
2869 a_temp(2,2)=aggj1(l,4)
2870 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2871 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2872 s1=scalar2(b1(1,iti2),auxvec(1))
2873 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2874 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2875 s2=scalar2(b1(1,iti1),auxvec(1))
2876 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2877 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2878 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2879 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2885 C-----------------------------------------------------------------------------
2886 subroutine vecpr(u,v,w)
2887 implicit real*8(a-h,o-z)
2888 dimension u(3),v(3),w(3)
2889 w(1)=u(2)*v(3)-u(3)*v(2)
2890 w(2)=-u(1)*v(3)+u(3)*v(1)
2891 w(3)=u(1)*v(2)-u(2)*v(1)
2894 C-----------------------------------------------------------------------------
2895 subroutine unormderiv(u,ugrad,unorm,ungrad)
2896 C This subroutine computes the derivatives of a normalized vector u, given
2897 C the derivatives computed without normalization conditions, ugrad. Returns
2900 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2901 double precision vec(3)
2902 double precision scalar
2904 c write (2,*) 'ugrad',ugrad
2907 vec(i)=scalar(ugrad(1,i),u(1))
2909 c write (2,*) 'vec',vec
2912 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2915 c write (2,*) 'ungrad',ungrad
2918 C-----------------------------------------------------------------------------
2919 subroutine escp(evdw2,evdw2_14)
2921 C This subroutine calculates the excluded-volume interaction energy between
2922 C peptide-group centers and side chains and its gradient in virtual-bond and
2923 C side-chain vectors.
2925 implicit real*8 (a-h,o-z)
2926 include 'DIMENSIONS'
2927 include 'DIMENSIONS.ZSCOPT'
2928 include 'COMMON.GEO'
2929 include 'COMMON.VAR'
2930 include 'COMMON.LOCAL'
2931 include 'COMMON.CHAIN'
2932 include 'COMMON.DERIV'
2933 include 'COMMON.INTERACT'
2934 include 'COMMON.FFIELD'
2935 include 'COMMON.IOUNITS'
2939 cd print '(a)','Enter ESCP'
2940 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2941 c & ' scal14',scal14
2942 do i=iatscp_s,iatscp_e
2943 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2945 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2946 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2947 if (iteli.eq.0) goto 1225
2948 xi=0.5D0*(c(1,i)+c(1,i+1))
2949 yi=0.5D0*(c(2,i)+c(2,i+1))
2950 zi=0.5D0*(c(3,i)+c(3,i+1))
2951 C Returning the ith atom to box
2953 if (xi.lt.0) xi=xi+boxxsize
2955 if (yi.lt.0) yi=yi+boxysize
2957 if (zi.lt.0) zi=zi+boxzsize
2958 do iint=1,nscp_gr(i)
2960 do j=iscpstart(i,iint),iscpend(i,iint)
2961 itypj=iabs(itype(j))
2962 if (itypj.eq.ntyp1) cycle
2963 C Uncomment following three lines for SC-p interactions
2967 C Uncomment following three lines for Ca-p interactions
2971 C returning the jth atom to box
2973 if (xj.lt.0) xj=xj+boxxsize
2975 if (yj.lt.0) yj=yj+boxysize
2977 if (zj.lt.0) zj=zj+boxzsize
2978 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2983 C Finding the closest jth atom
2987 xj=xj_safe+xshift*boxxsize
2988 yj=yj_safe+yshift*boxysize
2989 zj=zj_safe+zshift*boxzsize
2990 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2991 if(dist_temp.lt.dist_init) then
3001 if (subchap.eq.1) then
3010 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3011 C sss is scaling function for smoothing the cutoff gradient otherwise
3012 C the gradient would not be continuouse
3013 sss=sscale(1.0d0/(dsqrt(rrij)))
3014 if (sss.le.0.0d0) cycle
3015 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3017 e1=fac*fac*aad(itypj,iteli)
3018 e2=fac*bad(itypj,iteli)
3019 if (iabs(j-i) .le. 2) then
3022 evdw2_14=evdw2_14+(e1+e2)*sss
3025 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3026 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3027 c & bad(itypj,iteli)
3028 evdw2=evdw2+evdwij*sss
3031 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3033 fac=-(evdwij+e1)*rrij*sss
3034 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3039 cd write (iout,*) 'j<i'
3040 C Uncomment following three lines for SC-p interactions
3042 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3045 cd write (iout,*) 'j>i'
3048 C Uncomment following line for SC-p interactions
3049 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3053 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3057 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3058 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3061 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3071 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3072 gradx_scp(j,i)=expon*gradx_scp(j,i)
3075 C******************************************************************************
3079 C To save time the factor EXPON has been extracted from ALL components
3080 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3083 C******************************************************************************
3086 C--------------------------------------------------------------------------
3087 subroutine edis(ehpb)
3089 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3091 implicit real*8 (a-h,o-z)
3092 include 'DIMENSIONS'
3093 include 'DIMENSIONS.ZSCOPT'
3094 include 'COMMON.SBRIDGE'
3095 include 'COMMON.CHAIN'
3096 include 'COMMON.DERIV'
3097 include 'COMMON.VAR'
3098 include 'COMMON.INTERACT'
3101 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3102 cd print *,'link_start=',link_start,' link_end=',link_end
3103 if (link_end.eq.0) return
3104 do i=link_start,link_end
3105 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3106 C CA-CA distance used in regularization of structure.
3109 C iii and jjj point to the residues for which the distance is assigned.
3110 if (ii.gt.nres) then
3117 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3118 C distance and angle dependent SS bond potential.
3119 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3120 & iabs(itype(jjj)).eq.1) then
3121 call ssbond_ene(iii,jjj,eij)
3124 C Calculate the distance between the two points and its difference from the
3128 C Get the force constant corresponding to this distance.
3130 C Calculate the contribution to energy.
3131 ehpb=ehpb+waga*rdis*rdis
3133 C Evaluate gradient.
3136 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3137 cd & ' waga=',waga,' fac=',fac
3139 ggg(j)=fac*(c(j,jj)-c(j,ii))
3141 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3142 C If this is a SC-SC distance, we need to calculate the contributions to the
3143 C Cartesian gradient in the SC vectors (ghpbx).
3146 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3147 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3152 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3160 C--------------------------------------------------------------------------
3161 subroutine ssbond_ene(i,j,eij)
3163 C Calculate the distance and angle dependent SS-bond potential energy
3164 C using a free-energy function derived based on RHF/6-31G** ab initio
3165 C calculations of diethyl disulfide.
3167 C A. Liwo and U. Kozlowska, 11/24/03
3169 implicit real*8 (a-h,o-z)
3170 include 'DIMENSIONS'
3171 include 'DIMENSIONS.ZSCOPT'
3172 include 'COMMON.SBRIDGE'
3173 include 'COMMON.CHAIN'
3174 include 'COMMON.DERIV'
3175 include 'COMMON.LOCAL'
3176 include 'COMMON.INTERACT'
3177 include 'COMMON.VAR'
3178 include 'COMMON.IOUNITS'
3179 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3180 itypi=iabs(itype(i))
3184 dxi=dc_norm(1,nres+i)
3185 dyi=dc_norm(2,nres+i)
3186 dzi=dc_norm(3,nres+i)
3187 dsci_inv=dsc_inv(itypi)
3188 itypj=iabs(itype(j))
3189 dscj_inv=dsc_inv(itypj)
3193 dxj=dc_norm(1,nres+j)
3194 dyj=dc_norm(2,nres+j)
3195 dzj=dc_norm(3,nres+j)
3196 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3201 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3202 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3203 om12=dxi*dxj+dyi*dyj+dzi*dzj
3205 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3206 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3212 deltat12=om2-om1+2.0d0
3214 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3215 & +akct*deltad*deltat12
3216 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3217 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3218 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3219 c & " deltat12",deltat12," eij",eij
3220 ed=2*akcm*deltad+akct*deltat12
3222 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3223 eom1=-2*akth*deltat1-pom1-om2*pom2
3224 eom2= 2*akth*deltat2+pom1-om1*pom2
3227 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3230 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3231 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3232 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3233 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3236 C Calculate the components of the gradient in DC and X
3240 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3245 C--------------------------------------------------------------------------
3246 subroutine ebond(estr)
3248 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3250 implicit real*8 (a-h,o-z)
3251 include 'DIMENSIONS'
3252 include 'DIMENSIONS.ZSCOPT'
3253 include 'COMMON.LOCAL'
3254 include 'COMMON.GEO'
3255 include 'COMMON.INTERACT'
3256 include 'COMMON.DERIV'
3257 include 'COMMON.VAR'
3258 include 'COMMON.CHAIN'
3259 include 'COMMON.IOUNITS'
3260 include 'COMMON.NAMES'
3261 include 'COMMON.FFIELD'
3262 include 'COMMON.CONTROL'
3263 logical energy_dec /.false./
3264 double precision u(3),ud(3)
3267 c write (iout,*) "distchainmax",distchainmax
3269 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3270 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3272 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3273 C & *dc(j,i-1)/vbld(i)
3275 C if (energy_dec) write(iout,*)
3276 C & "estr1",i,vbld(i),distchainmax,
3277 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3279 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3280 diff = vbld(i)-vbldpDUM
3282 diff = vbld(i)-vbldp0
3283 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3287 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3290 C write (iout,'(a7,i5,4f7.3)')
3291 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3293 estr=0.5d0*AKP*estr+estr1
3295 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3299 if (iti.ne.10 .and. iti.ne.ntyp1) then
3302 diff=vbld(i+nres)-vbldsc0(1,iti)
3303 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3304 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3305 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3307 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3311 diff=vbld(i+nres)-vbldsc0(j,iti)
3312 ud(j)=aksc(j,iti)*diff
3313 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3327 uprod2=uprod2*u(k)*u(k)
3331 usumsqder=usumsqder+ud(j)*uprod2
3333 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3334 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3335 estr=estr+uprod/usum
3337 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3345 C--------------------------------------------------------------------------
3346 subroutine ebend(etheta)
3348 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3349 C angles gamma and its derivatives in consecutive thetas and gammas.
3351 implicit real*8 (a-h,o-z)
3352 include 'DIMENSIONS'
3353 include 'DIMENSIONS.ZSCOPT'
3354 include 'COMMON.LOCAL'
3355 include 'COMMON.GEO'
3356 include 'COMMON.INTERACT'
3357 include 'COMMON.DERIV'
3358 include 'COMMON.VAR'
3359 include 'COMMON.CHAIN'
3360 include 'COMMON.IOUNITS'
3361 include 'COMMON.NAMES'
3362 include 'COMMON.FFIELD'
3363 common /calcthet/ term1,term2,termm,diffak,ratak,
3364 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3365 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3366 double precision y(2),z(2)
3368 time11=dexp(-2*time)
3371 c write (iout,*) "nres",nres
3372 c write (*,'(a,i2)') 'EBEND ICG=',icg
3373 c write (iout,*) ithet_start,ithet_end
3374 do i=ithet_start,ithet_end
3375 C if (itype(i-1).eq.ntyp1) cycle
3377 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3378 & .or.itype(i).eq.ntyp1) cycle
3379 C Zero the energy function and its derivative at 0 or pi.
3380 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3382 ichir1=isign(1,itype(i-2))
3383 ichir2=isign(1,itype(i))
3384 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3385 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3386 if (itype(i-1).eq.10) then
3387 itype1=isign(10,itype(i-2))
3388 ichir11=isign(1,itype(i-2))
3389 ichir12=isign(1,itype(i-2))
3390 itype2=isign(10,itype(i))
3391 ichir21=isign(1,itype(i))
3392 ichir22=isign(1,itype(i))
3399 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3403 call proc_proc(phii,icrc)
3404 if (icrc.eq.1) phii=150.0
3415 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3419 call proc_proc(phii1,icrc)
3420 if (icrc.eq.1) phii1=150.0
3432 C Calculate the "mean" value of theta from the part of the distribution
3433 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3434 C In following comments this theta will be referred to as t_c.
3435 thet_pred_mean=0.0d0
3437 athetk=athet(k,it,ichir1,ichir2)
3438 bthetk=bthet(k,it,ichir1,ichir2)
3440 athetk=athet(k,itype1,ichir11,ichir12)
3441 bthetk=bthet(k,itype2,ichir21,ichir22)
3443 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3445 c write (iout,*) "thet_pred_mean",thet_pred_mean
3446 dthett=thet_pred_mean*ssd
3447 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3448 c write (iout,*) "thet_pred_mean",thet_pred_mean
3449 C Derivatives of the "mean" values in gamma1 and gamma2.
3450 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3451 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3452 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3453 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3455 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3456 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3457 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3458 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3460 if (theta(i).gt.pi-delta) then
3461 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3463 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3464 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3465 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3467 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3469 else if (theta(i).lt.delta) then
3470 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3471 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3472 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3474 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3475 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3478 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3481 etheta=etheta+ethetai
3482 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3483 c & 'ebend',i,ethetai,theta(i),itype(i)
3484 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3485 c & rad2deg*phii,rad2deg*phii1,ethetai
3486 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3487 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3488 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3491 C Ufff.... We've done all this!!!
3494 C---------------------------------------------------------------------------
3495 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3497 implicit real*8 (a-h,o-z)
3498 include 'DIMENSIONS'
3499 include 'COMMON.LOCAL'
3500 include 'COMMON.IOUNITS'
3501 common /calcthet/ term1,term2,termm,diffak,ratak,
3502 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3503 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3504 C Calculate the contributions to both Gaussian lobes.
3505 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3506 C The "polynomial part" of the "standard deviation" of this part of
3510 sig=sig*thet_pred_mean+polthet(j,it)
3512 C Derivative of the "interior part" of the "standard deviation of the"
3513 C gamma-dependent Gaussian lobe in t_c.
3514 sigtc=3*polthet(3,it)
3516 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3519 C Set the parameters of both Gaussian lobes of the distribution.
3520 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3521 fac=sig*sig+sigc0(it)
3524 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3525 sigsqtc=-4.0D0*sigcsq*sigtc
3526 c print *,i,sig,sigtc,sigsqtc
3527 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3528 sigtc=-sigtc/(fac*fac)
3529 C Following variable is sigma(t_c)**(-2)
3530 sigcsq=sigcsq*sigcsq
3532 sig0inv=1.0D0/sig0i**2
3533 delthec=thetai-thet_pred_mean
3534 delthe0=thetai-theta0i
3535 term1=-0.5D0*sigcsq*delthec*delthec
3536 term2=-0.5D0*sig0inv*delthe0*delthe0
3537 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3538 C NaNs in taking the logarithm. We extract the largest exponent which is added
3539 C to the energy (this being the log of the distribution) at the end of energy
3540 C term evaluation for this virtual-bond angle.
3541 if (term1.gt.term2) then
3543 term2=dexp(term2-termm)
3547 term1=dexp(term1-termm)
3550 C The ratio between the gamma-independent and gamma-dependent lobes of
3551 C the distribution is a Gaussian function of thet_pred_mean too.
3552 diffak=gthet(2,it)-thet_pred_mean
3553 ratak=diffak/gthet(3,it)**2
3554 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3555 C Let's differentiate it in thet_pred_mean NOW.
3557 C Now put together the distribution terms to make complete distribution.
3558 termexp=term1+ak*term2
3559 termpre=sigc+ak*sig0i
3560 C Contribution of the bending energy from this theta is just the -log of
3561 C the sum of the contributions from the two lobes and the pre-exponential
3562 C factor. Simple enough, isn't it?
3563 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3564 C NOW the derivatives!!!
3565 C 6/6/97 Take into account the deformation.
3566 E_theta=(delthec*sigcsq*term1
3567 & +ak*delthe0*sig0inv*term2)/termexp
3568 E_tc=((sigtc+aktc*sig0i)/termpre
3569 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3570 & aktc*term2)/termexp)
3573 c-----------------------------------------------------------------------------
3574 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3575 implicit real*8 (a-h,o-z)
3576 include 'DIMENSIONS'
3577 include 'COMMON.LOCAL'
3578 include 'COMMON.IOUNITS'
3579 common /calcthet/ term1,term2,termm,diffak,ratak,
3580 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3581 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3582 delthec=thetai-thet_pred_mean
3583 delthe0=thetai-theta0i
3584 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3585 t3 = thetai-thet_pred_mean
3589 t14 = t12+t6*sigsqtc
3591 t21 = thetai-theta0i
3597 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3598 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3599 & *(-t12*t9-ak*sig0inv*t27)
3603 C--------------------------------------------------------------------------
3604 subroutine ebend(etheta)
3606 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3607 C angles gamma and its derivatives in consecutive thetas and gammas.
3608 C ab initio-derived potentials from
3609 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3611 implicit real*8 (a-h,o-z)
3612 include 'DIMENSIONS'
3613 include 'DIMENSIONS.ZSCOPT'
3614 include 'COMMON.LOCAL'
3615 include 'COMMON.GEO'
3616 include 'COMMON.INTERACT'
3617 include 'COMMON.DERIV'
3618 include 'COMMON.VAR'
3619 include 'COMMON.CHAIN'
3620 include 'COMMON.IOUNITS'
3621 include 'COMMON.NAMES'
3622 include 'COMMON.FFIELD'
3623 include 'COMMON.CONTROL'
3624 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3625 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3626 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3627 & sinph1ph2(maxdouble,maxdouble)
3628 logical lprn /.false./, lprn1 /.false./
3630 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3631 do i=ithet_start,ithet_end
3633 C if (itype(i-1).eq.ntyp1) cycle
3635 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3636 & .or.itype(i).eq.ntyp1) cycle
3637 if (iabs(itype(i+1)).eq.20) iblock=2
3638 if (iabs(itype(i+1)).ne.20) iblock=1
3642 theti2=0.5d0*theta(i)
3643 ityp2=ithetyp((itype(i-1)))
3645 coskt(k)=dcos(k*theti2)
3646 sinkt(k)=dsin(k*theti2)
3656 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3659 if (phii.ne.phii) phii=150.0
3663 ityp1=ithetyp((itype(i-2)))
3665 cosph1(k)=dcos(k*phii)
3666 sinph1(k)=dsin(k*phii)
3677 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3680 if (phii1.ne.phii1) phii1=150.0
3685 ityp3=ithetyp((itype(i)))
3687 cosph2(k)=dcos(k*phii1)
3688 sinph2(k)=dsin(k*phii1)
3698 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3699 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3701 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3704 ccl=cosph1(l)*cosph2(k-l)
3705 ssl=sinph1(l)*sinph2(k-l)
3706 scl=sinph1(l)*cosph2(k-l)
3707 csl=cosph1(l)*sinph2(k-l)
3708 cosph1ph2(l,k)=ccl-ssl
3709 cosph1ph2(k,l)=ccl+ssl
3710 sinph1ph2(l,k)=scl+csl
3711 sinph1ph2(k,l)=scl-csl
3715 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3716 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3717 write (iout,*) "coskt and sinkt"
3719 write (iout,*) k,coskt(k),sinkt(k)
3723 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3724 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3727 & write (iout,*) "k",k,"
3728 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3729 & " ethetai",ethetai
3732 write (iout,*) "cosph and sinph"
3734 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3736 write (iout,*) "cosph1ph2 and sinph2ph2"
3739 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3740 & sinph1ph2(l,k),sinph1ph2(k,l)
3743 write(iout,*) "ethetai",ethetai
3747 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3748 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3749 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3750 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3751 ethetai=ethetai+sinkt(m)*aux
3752 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3753 dephii=dephii+k*sinkt(m)*(
3754 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3755 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3756 dephii1=dephii1+k*sinkt(m)*(
3757 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3758 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3760 & write (iout,*) "m",m," k",k," bbthet",
3761 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3762 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3763 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3764 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3768 & write(iout,*) "ethetai",ethetai
3772 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3773 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3774 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3775 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3776 ethetai=ethetai+sinkt(m)*aux
3777 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3778 dephii=dephii+l*sinkt(m)*(
3779 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3780 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3781 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3782 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3783 dephii1=dephii1+(k-l)*sinkt(m)*(
3784 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3785 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3786 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3787 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3789 write (iout,*) "m",m," k",k," l",l," ffthet",
3790 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3791 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3792 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3793 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3794 & " ethetai",ethetai
3795 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3796 & cosph1ph2(k,l)*sinkt(m),
3797 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3803 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3804 & i,theta(i)*rad2deg,phii*rad2deg,
3805 & phii1*rad2deg,ethetai
3806 etheta=etheta+ethetai
3807 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3808 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3809 gloc(nphi+i-2,icg)=wang*dethetai
3815 c-----------------------------------------------------------------------------
3816 subroutine esc(escloc)
3817 C Calculate the local energy of a side chain and its derivatives in the
3818 C corresponding virtual-bond valence angles THETA and the spherical angles
3820 implicit real*8 (a-h,o-z)
3821 include 'DIMENSIONS'
3822 include 'DIMENSIONS.ZSCOPT'
3823 include 'COMMON.GEO'
3824 include 'COMMON.LOCAL'
3825 include 'COMMON.VAR'
3826 include 'COMMON.INTERACT'
3827 include 'COMMON.DERIV'
3828 include 'COMMON.CHAIN'
3829 include 'COMMON.IOUNITS'
3830 include 'COMMON.NAMES'
3831 include 'COMMON.FFIELD'
3832 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3833 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3834 common /sccalc/ time11,time12,time112,theti,it,nlobit
3837 C write (iout,*) 'ESC'
3838 do i=loc_start,loc_end
3840 if (it.eq.ntyp1) cycle
3841 if (it.eq.10) goto 1
3842 nlobit=nlob(iabs(it))
3843 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3844 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3845 theti=theta(i+1)-pipol
3849 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3851 if (x(2).gt.pi-delta) then
3855 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3857 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3858 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3860 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3861 & ddersc0(1),dersc(1))
3862 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3863 & ddersc0(3),dersc(3))
3865 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3867 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3868 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3869 & dersc0(2),esclocbi,dersc02)
3870 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3872 call splinthet(x(2),0.5d0*delta,ss,ssd)
3877 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3879 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3880 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3882 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3884 c write (iout,*) escloci
3885 else if (x(2).lt.delta) then
3889 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3891 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3892 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3894 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3895 & ddersc0(1),dersc(1))
3896 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3897 & ddersc0(3),dersc(3))
3899 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3901 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3902 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3903 & dersc0(2),esclocbi,dersc02)
3904 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3909 call splinthet(x(2),0.5d0*delta,ss,ssd)
3911 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3913 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3914 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3916 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3917 C write (iout,*) 'i=',i, escloci
3919 call enesc(x,escloci,dersc,ddummy,.false.)
3922 escloc=escloc+escloci
3923 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3924 write (iout,'(a6,i5,0pf7.3)')
3925 & 'escloc',i,escloci
3927 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3929 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3930 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3935 C---------------------------------------------------------------------------
3936 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3937 implicit real*8 (a-h,o-z)
3938 include 'DIMENSIONS'
3939 include 'COMMON.GEO'
3940 include 'COMMON.LOCAL'
3941 include 'COMMON.IOUNITS'
3942 common /sccalc/ time11,time12,time112,theti,it,nlobit
3943 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3944 double precision contr(maxlob,-1:1)
3946 c write (iout,*) 'it=',it,' nlobit=',nlobit
3950 if (mixed) ddersc(j)=0.0d0
3954 C Because of periodicity of the dependence of the SC energy in omega we have
3955 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3956 C To avoid underflows, first compute & store the exponents.
3964 z(k)=x(k)-censc(k,j,it)
3969 Axk=Axk+gaussc(l,k,j,it)*z(l)
3975 expfac=expfac+Ax(k,j,iii)*z(k)
3983 C As in the case of ebend, we want to avoid underflows in exponentiation and
3984 C subsequent NaNs and INFs in energy calculation.
3985 C Find the largest exponent
3989 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3993 cd print *,'it=',it,' emin=',emin
3995 C Compute the contribution to SC energy and derivatives
3999 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4000 cd print *,'j=',j,' expfac=',expfac
4001 escloc_i=escloc_i+expfac
4003 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4007 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4008 & +gaussc(k,2,j,it))*expfac
4015 dersc(1)=dersc(1)/cos(theti)**2
4016 ddersc(1)=ddersc(1)/cos(theti)**2
4019 escloci=-(dlog(escloc_i)-emin)
4021 dersc(j)=dersc(j)/escloc_i
4025 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4030 C------------------------------------------------------------------------------
4031 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4032 implicit real*8 (a-h,o-z)
4033 include 'DIMENSIONS'
4034 include 'COMMON.GEO'
4035 include 'COMMON.LOCAL'
4036 include 'COMMON.IOUNITS'
4037 common /sccalc/ time11,time12,time112,theti,it,nlobit
4038 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4039 double precision contr(maxlob)
4050 z(k)=x(k)-censc(k,j,it)
4056 Axk=Axk+gaussc(l,k,j,it)*z(l)
4062 expfac=expfac+Ax(k,j)*z(k)
4067 C As in the case of ebend, we want to avoid underflows in exponentiation and
4068 C subsequent NaNs and INFs in energy calculation.
4069 C Find the largest exponent
4072 if (emin.gt.contr(j)) emin=contr(j)
4076 C Compute the contribution to SC energy and derivatives
4080 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4081 escloc_i=escloc_i+expfac
4083 dersc(k)=dersc(k)+Ax(k,j)*expfac
4085 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4086 & +gaussc(1,2,j,it))*expfac
4090 dersc(1)=dersc(1)/cos(theti)**2
4091 dersc12=dersc12/cos(theti)**2
4092 escloci=-(dlog(escloc_i)-emin)
4094 dersc(j)=dersc(j)/escloc_i
4096 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4100 c----------------------------------------------------------------------------------
4101 subroutine esc(escloc)
4102 C Calculate the local energy of a side chain and its derivatives in the
4103 C corresponding virtual-bond valence angles THETA and the spherical angles
4104 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4105 C added by Urszula Kozlowska. 07/11/2007
4107 implicit real*8 (a-h,o-z)
4108 include 'DIMENSIONS'
4109 include 'DIMENSIONS.ZSCOPT'
4110 include 'COMMON.GEO'
4111 include 'COMMON.LOCAL'
4112 include 'COMMON.VAR'
4113 include 'COMMON.SCROT'
4114 include 'COMMON.INTERACT'
4115 include 'COMMON.DERIV'
4116 include 'COMMON.CHAIN'
4117 include 'COMMON.IOUNITS'
4118 include 'COMMON.NAMES'
4119 include 'COMMON.FFIELD'
4120 include 'COMMON.CONTROL'
4121 include 'COMMON.VECTORS'
4122 double precision x_prime(3),y_prime(3),z_prime(3)
4123 & , sumene,dsc_i,dp2_i,x(65),
4124 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4125 & de_dxx,de_dyy,de_dzz,de_dt
4126 double precision s1_t,s1_6_t,s2_t,s2_6_t
4128 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4129 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4130 & dt_dCi(3),dt_dCi1(3)
4131 common /sccalc/ time11,time12,time112,theti,it,nlobit
4134 do i=loc_start,loc_end
4135 if (itype(i).eq.ntyp1) cycle
4136 costtab(i+1) =dcos(theta(i+1))
4137 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4138 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4139 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4140 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4141 cosfac=dsqrt(cosfac2)
4142 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4143 sinfac=dsqrt(sinfac2)
4145 if (it.eq.10) goto 1
4147 C Compute the axes of tghe local cartesian coordinates system; store in
4148 c x_prime, y_prime and z_prime
4155 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4156 C & dc_norm(3,i+nres)
4158 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4159 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4162 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4165 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4166 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4167 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4168 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4169 c & " xy",scalar(x_prime(1),y_prime(1)),
4170 c & " xz",scalar(x_prime(1),z_prime(1)),
4171 c & " yy",scalar(y_prime(1),y_prime(1)),
4172 c & " yz",scalar(y_prime(1),z_prime(1)),
4173 c & " zz",scalar(z_prime(1),z_prime(1))
4175 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4176 C to local coordinate system. Store in xx, yy, zz.
4182 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4183 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4184 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4191 C Compute the energy of the ith side cbain
4193 c write (2,*) "xx",xx," yy",yy," zz",zz
4196 x(j) = sc_parmin(j,it)
4199 Cc diagnostics - remove later
4201 yy1 = dsin(alph(2))*dcos(omeg(2))
4202 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4203 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4204 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4206 C," --- ", xx_w,yy_w,zz_w
4209 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4210 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4212 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4213 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4215 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4216 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4217 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4218 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4219 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4221 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4222 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4223 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4224 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4225 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4227 dsc_i = 0.743d0+x(61)
4229 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4230 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4231 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4232 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4233 s1=(1+x(63))/(0.1d0 + dscp1)
4234 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4235 s2=(1+x(65))/(0.1d0 + dscp2)
4236 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4237 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4238 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4239 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4241 c & dscp1,dscp2,sumene
4242 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4243 escloc = escloc + sumene
4244 c write (2,*) "escloc",escloc
4245 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4247 if (.not. calc_grad) goto 1
4250 C This section to check the numerical derivatives of the energy of ith side
4251 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4252 C #define DEBUG in the code to turn it on.
4254 write (2,*) "sumene =",sumene
4258 write (2,*) xx,yy,zz
4259 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4260 de_dxx_num=(sumenep-sumene)/aincr
4262 write (2,*) "xx+ sumene from enesc=",sumenep
4265 write (2,*) xx,yy,zz
4266 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4267 de_dyy_num=(sumenep-sumene)/aincr
4269 write (2,*) "yy+ sumene from enesc=",sumenep
4272 write (2,*) xx,yy,zz
4273 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4274 de_dzz_num=(sumenep-sumene)/aincr
4276 write (2,*) "zz+ sumene from enesc=",sumenep
4277 costsave=cost2tab(i+1)
4278 sintsave=sint2tab(i+1)
4279 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4280 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4281 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4282 de_dt_num=(sumenep-sumene)/aincr
4283 write (2,*) " t+ sumene from enesc=",sumenep
4284 cost2tab(i+1)=costsave
4285 sint2tab(i+1)=sintsave
4286 C End of diagnostics section.
4289 C Compute the gradient of esc
4291 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4292 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4293 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4294 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4295 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4296 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4297 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4298 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4299 pom1=(sumene3*sint2tab(i+1)+sumene1)
4300 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4301 pom2=(sumene4*cost2tab(i+1)+sumene2)
4302 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4303 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4304 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4305 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4307 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4308 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4309 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4311 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4312 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4313 & +(pom1+pom2)*pom_dx
4315 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4318 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4319 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4320 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4322 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4323 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4324 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4325 & +x(59)*zz**2 +x(60)*xx*zz
4326 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4327 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4328 & +(pom1-pom2)*pom_dy
4330 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4333 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4334 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4335 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4336 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4337 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4338 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4339 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4340 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4342 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4345 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4346 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4347 & +pom1*pom_dt1+pom2*pom_dt2
4349 write(2,*), "de_dt = ", de_dt,de_dt_num
4353 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4354 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4355 cosfac2xx=cosfac2*xx
4356 sinfac2yy=sinfac2*yy
4358 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4360 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4362 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4363 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4364 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4365 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4366 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4367 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4368 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4369 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4370 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4371 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4375 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4376 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4377 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4378 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4381 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4382 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4383 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4385 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4386 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4390 dXX_Ctab(k,i)=dXX_Ci(k)
4391 dXX_C1tab(k,i)=dXX_Ci1(k)
4392 dYY_Ctab(k,i)=dYY_Ci(k)
4393 dYY_C1tab(k,i)=dYY_Ci1(k)
4394 dZZ_Ctab(k,i)=dZZ_Ci(k)
4395 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4396 dXX_XYZtab(k,i)=dXX_XYZ(k)
4397 dYY_XYZtab(k,i)=dYY_XYZ(k)
4398 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4402 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4403 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4404 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4405 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4406 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4408 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4409 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4410 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4411 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4412 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4413 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4414 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4415 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4417 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4418 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4420 C to check gradient call subroutine check_grad
4427 c------------------------------------------------------------------------------
4428 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4430 C This procedure calculates two-body contact function g(rij) and its derivative:
4433 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4436 C where x=(rij-r0ij)/delta
4438 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4441 double precision rij,r0ij,eps0ij,fcont,fprimcont
4442 double precision x,x2,x4,delta
4446 if (x.lt.-1.0D0) then
4449 else if (x.le.1.0D0) then
4452 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4453 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4460 c------------------------------------------------------------------------------
4461 subroutine splinthet(theti,delta,ss,ssder)
4462 implicit real*8 (a-h,o-z)
4463 include 'DIMENSIONS'
4464 include 'DIMENSIONS.ZSCOPT'
4465 include 'COMMON.VAR'
4466 include 'COMMON.GEO'
4469 if (theti.gt.pipol) then
4470 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4472 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4477 c------------------------------------------------------------------------------
4478 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4480 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4481 double precision ksi,ksi2,ksi3,a1,a2,a3
4482 a1=fprim0*delta/(f1-f0)
4488 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4489 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4492 c------------------------------------------------------------------------------
4493 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4495 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4496 double precision ksi,ksi2,ksi3,a1,a2,a3
4501 a2=3*(f1x-f0x)-2*fprim0x*delta
4502 a3=fprim0x*delta-2*(f1x-f0x)
4503 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4506 C-----------------------------------------------------------------------------
4508 C-----------------------------------------------------------------------------
4509 subroutine etor(etors,edihcnstr,fact)
4510 implicit real*8 (a-h,o-z)
4511 include 'DIMENSIONS'
4512 include 'DIMENSIONS.ZSCOPT'
4513 include 'COMMON.VAR'
4514 include 'COMMON.GEO'
4515 include 'COMMON.LOCAL'
4516 include 'COMMON.TORSION'
4517 include 'COMMON.INTERACT'
4518 include 'COMMON.DERIV'
4519 include 'COMMON.CHAIN'
4520 include 'COMMON.NAMES'
4521 include 'COMMON.IOUNITS'
4522 include 'COMMON.FFIELD'
4523 include 'COMMON.TORCNSTR'
4525 C Set lprn=.true. for debugging
4529 do i=iphi_start,iphi_end
4530 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4531 & .or. itype(i).eq.ntyp1) cycle
4532 itori=itortyp(itype(i-2))
4533 itori1=itortyp(itype(i-1))
4536 C Proline-Proline pair is a special case...
4537 if (itori.eq.3 .and. itori1.eq.3) then
4538 if (phii.gt.-dwapi3) then
4540 fac=1.0D0/(1.0D0-cosphi)
4541 etorsi=v1(1,3,3)*fac
4542 etorsi=etorsi+etorsi
4543 etors=etors+etorsi-v1(1,3,3)
4544 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4547 v1ij=v1(j+1,itori,itori1)
4548 v2ij=v2(j+1,itori,itori1)
4551 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4552 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4556 v1ij=v1(j,itori,itori1)
4557 v2ij=v2(j,itori,itori1)
4560 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4561 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4565 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4566 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4567 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4568 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4569 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4571 ! 6/20/98 - dihedral angle constraints
4574 itori=idih_constr(i)
4577 if (difi.gt.drange(i)) then
4579 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4580 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4581 else if (difi.lt.-drange(i)) then
4583 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4584 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4586 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4587 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4589 ! write (iout,*) 'edihcnstr',edihcnstr
4592 c------------------------------------------------------------------------------
4594 subroutine etor(etors,edihcnstr,fact)
4595 implicit real*8 (a-h,o-z)
4596 include 'DIMENSIONS'
4597 include 'DIMENSIONS.ZSCOPT'
4598 include 'COMMON.VAR'
4599 include 'COMMON.GEO'
4600 include 'COMMON.LOCAL'
4601 include 'COMMON.TORSION'
4602 include 'COMMON.INTERACT'
4603 include 'COMMON.DERIV'
4604 include 'COMMON.CHAIN'
4605 include 'COMMON.NAMES'
4606 include 'COMMON.IOUNITS'
4607 include 'COMMON.FFIELD'
4608 include 'COMMON.TORCNSTR'
4610 C Set lprn=.true. for debugging
4614 do i=iphi_start,iphi_end
4616 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4617 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4618 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4619 C & .or. itype(i).eq.ntyp1) cycle
4620 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4621 if (iabs(itype(i)).eq.20) then
4626 itori=itortyp(itype(i-2))
4627 itori1=itortyp(itype(i-1))
4630 C Regular cosine and sine terms
4631 do j=1,nterm(itori,itori1,iblock)
4632 v1ij=v1(j,itori,itori1,iblock)
4633 v2ij=v2(j,itori,itori1,iblock)
4636 etors=etors+v1ij*cosphi+v2ij*sinphi
4637 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4641 C E = SUM ----------------------------------- - v1
4642 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4644 cosphi=dcos(0.5d0*phii)
4645 sinphi=dsin(0.5d0*phii)
4646 do j=1,nlor(itori,itori1,iblock)
4647 vl1ij=vlor1(j,itori,itori1)
4648 vl2ij=vlor2(j,itori,itori1)
4649 vl3ij=vlor3(j,itori,itori1)
4650 pom=vl2ij*cosphi+vl3ij*sinphi
4651 pom1=1.0d0/(pom*pom+1.0d0)
4652 etors=etors+vl1ij*pom1
4653 c if (energy_dec) etors_ii=etors_ii+
4656 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4658 C Subtract the constant term
4659 etors=etors-v0(itori,itori1,iblock)
4661 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4662 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4663 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4664 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4665 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4668 ! 6/20/98 - dihedral angle constraints
4671 itori=idih_constr(i)
4673 difi=pinorm(phii-phi0(i))
4675 if (difi.gt.drange(i)) then
4677 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4678 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4679 edihi=0.25d0*ftors*difi**4
4680 else if (difi.lt.-drange(i)) then
4682 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4683 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4684 edihi=0.25d0*ftors*difi**4
4688 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4690 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4691 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4693 ! write (iout,*) 'edihcnstr',edihcnstr
4696 c----------------------------------------------------------------------------
4697 subroutine etor_d(etors_d,fact2)
4698 C 6/23/01 Compute double torsional energy
4699 implicit real*8 (a-h,o-z)
4700 include 'DIMENSIONS'
4701 include 'DIMENSIONS.ZSCOPT'
4702 include 'COMMON.VAR'
4703 include 'COMMON.GEO'
4704 include 'COMMON.LOCAL'
4705 include 'COMMON.TORSION'
4706 include 'COMMON.INTERACT'
4707 include 'COMMON.DERIV'
4708 include 'COMMON.CHAIN'
4709 include 'COMMON.NAMES'
4710 include 'COMMON.IOUNITS'
4711 include 'COMMON.FFIELD'
4712 include 'COMMON.TORCNSTR'
4714 C Set lprn=.true. for debugging
4718 do i=iphi_start,iphi_end-1
4720 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4721 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4722 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4723 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4724 & (itype(i+1).eq.ntyp1)) cycle
4725 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4727 itori=itortyp(itype(i-2))
4728 itori1=itortyp(itype(i-1))
4729 itori2=itortyp(itype(i))
4735 if (iabs(itype(i+1)).eq.20) iblock=2
4736 C Regular cosine and sine terms
4737 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4738 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4739 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4740 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4741 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4742 cosphi1=dcos(j*phii)
4743 sinphi1=dsin(j*phii)
4744 cosphi2=dcos(j*phii1)
4745 sinphi2=dsin(j*phii1)
4746 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4747 & v2cij*cosphi2+v2sij*sinphi2
4748 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4749 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4751 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4753 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4754 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4755 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4756 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4757 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4758 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4759 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4760 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4761 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4762 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4763 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4764 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4765 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4766 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4769 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4770 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4776 c------------------------------------------------------------------------------
4777 subroutine eback_sc_corr(esccor)
4778 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4779 c conformational states; temporarily implemented as differences
4780 c between UNRES torsional potentials (dependent on three types of
4781 c residues) and the torsional potentials dependent on all 20 types
4782 c of residues computed from AM1 energy surfaces of terminally-blocked
4783 c amino-acid residues.
4784 implicit real*8 (a-h,o-z)
4785 include 'DIMENSIONS'
4786 include 'DIMENSIONS.ZSCOPT'
4787 include 'COMMON.VAR'
4788 include 'COMMON.GEO'
4789 include 'COMMON.LOCAL'
4790 include 'COMMON.TORSION'
4791 include 'COMMON.SCCOR'
4792 include 'COMMON.INTERACT'
4793 include 'COMMON.DERIV'
4794 include 'COMMON.CHAIN'
4795 include 'COMMON.NAMES'
4796 include 'COMMON.IOUNITS'
4797 include 'COMMON.FFIELD'
4798 include 'COMMON.CONTROL'
4800 C Set lprn=.true. for debugging
4803 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4805 do i=itau_start,itau_end
4806 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4808 isccori=isccortyp(itype(i-2))
4809 isccori1=isccortyp(itype(i-1))
4811 do intertyp=1,3 !intertyp
4812 cc Added 09 May 2012 (Adasko)
4813 cc Intertyp means interaction type of backbone mainchain correlation:
4814 c 1 = SC...Ca...Ca...Ca
4815 c 2 = Ca...Ca...Ca...SC
4816 c 3 = SC...Ca...Ca...SCi
4818 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4819 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4820 & (itype(i-1).eq.ntyp1)))
4821 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4822 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4823 & .or.(itype(i).eq.ntyp1)))
4824 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4825 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4826 & (itype(i-3).eq.ntyp1)))) cycle
4827 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4828 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4830 do j=1,nterm_sccor(isccori,isccori1)
4831 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4832 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4833 cosphi=dcos(j*tauangle(intertyp,i))
4834 sinphi=dsin(j*tauangle(intertyp,i))
4835 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4836 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4838 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4839 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4840 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4842 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4843 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4844 & (v1sccor(j,1,itori,itori1),j=1,6)
4845 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4846 c gsccor_loc(i-3)=gloci
4851 c------------------------------------------------------------------------------
4852 subroutine multibody(ecorr)
4853 C This subroutine calculates multi-body contributions to energy following
4854 C the idea of Skolnick et al. If side chains I and J make a contact and
4855 C at the same time side chains I+1 and J+1 make a contact, an extra
4856 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4857 implicit real*8 (a-h,o-z)
4858 include 'DIMENSIONS'
4859 include 'COMMON.IOUNITS'
4860 include 'COMMON.DERIV'
4861 include 'COMMON.INTERACT'
4862 include 'COMMON.CONTACTS'
4863 double precision gx(3),gx1(3)
4866 C Set lprn=.true. for debugging
4870 write (iout,'(a)') 'Contact function values:'
4872 write (iout,'(i2,20(1x,i2,f10.5))')
4873 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4888 num_conti=num_cont(i)
4889 num_conti1=num_cont(i1)
4894 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4895 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4896 cd & ' ishift=',ishift
4897 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4898 C The system gains extra energy.
4899 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4900 endif ! j1==j+-ishift
4909 c------------------------------------------------------------------------------
4910 double precision function esccorr(i,j,k,l,jj,kk)
4911 implicit real*8 (a-h,o-z)
4912 include 'DIMENSIONS'
4913 include 'COMMON.IOUNITS'
4914 include 'COMMON.DERIV'
4915 include 'COMMON.INTERACT'
4916 include 'COMMON.CONTACTS'
4917 double precision gx(3),gx1(3)
4922 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4923 C Calculate the multi-body contribution to energy.
4924 C Calculate multi-body contributions to the gradient.
4925 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4926 cd & k,l,(gacont(m,kk,k),m=1,3)
4928 gx(m) =ekl*gacont(m,jj,i)
4929 gx1(m)=eij*gacont(m,kk,k)
4930 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4931 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4932 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4933 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4937 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4942 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4948 c------------------------------------------------------------------------------
4950 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4951 implicit real*8 (a-h,o-z)
4952 include 'DIMENSIONS'
4953 integer dimen1,dimen2,atom,indx
4954 double precision buffer(dimen1,dimen2)
4955 double precision zapas
4956 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4957 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4958 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4959 num_kont=num_cont_hb(atom)
4963 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4966 buffer(i,indx+22)=facont_hb(i,atom)
4967 buffer(i,indx+23)=ees0p(i,atom)
4968 buffer(i,indx+24)=ees0m(i,atom)
4969 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4971 buffer(1,indx+26)=dfloat(num_kont)
4974 c------------------------------------------------------------------------------
4975 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4976 implicit real*8 (a-h,o-z)
4977 include 'DIMENSIONS'
4978 integer dimen1,dimen2,atom,indx
4979 double precision buffer(dimen1,dimen2)
4980 double precision zapas
4981 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4982 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4983 & ees0m(ntyp,maxres),
4984 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4985 num_kont=buffer(1,indx+26)
4986 num_kont_old=num_cont_hb(atom)
4987 num_cont_hb(atom)=num_kont+num_kont_old
4992 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4995 facont_hb(ii,atom)=buffer(i,indx+22)
4996 ees0p(ii,atom)=buffer(i,indx+23)
4997 ees0m(ii,atom)=buffer(i,indx+24)
4998 jcont_hb(ii,atom)=buffer(i,indx+25)
5002 c------------------------------------------------------------------------------
5004 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5005 C This subroutine calculates multi-body contributions to hydrogen-bonding
5006 implicit real*8 (a-h,o-z)
5007 include 'DIMENSIONS'
5008 include 'DIMENSIONS.ZSCOPT'
5009 include 'COMMON.IOUNITS'
5011 include 'COMMON.INFO'
5013 include 'COMMON.FFIELD'
5014 include 'COMMON.DERIV'
5015 include 'COMMON.INTERACT'
5016 include 'COMMON.CONTACTS'
5018 parameter (max_cont=maxconts)
5019 parameter (max_dim=2*(8*3+2))
5020 parameter (msglen1=max_cont*max_dim*4)
5021 parameter (msglen2=2*msglen1)
5022 integer source,CorrelType,CorrelID,Error
5023 double precision buffer(max_cont,max_dim)
5025 double precision gx(3),gx1(3)
5028 C Set lprn=.true. for debugging
5033 if (fgProcs.le.1) goto 30
5035 write (iout,'(a)') 'Contact function values:'
5037 write (iout,'(2i3,50(1x,i2,f5.2))')
5038 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5039 & j=1,num_cont_hb(i))
5042 C Caution! Following code assumes that electrostatic interactions concerning
5043 C a given atom are split among at most two processors!
5053 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5056 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5057 if (MyRank.gt.0) then
5058 C Send correlation contributions to the preceding processor
5060 nn=num_cont_hb(iatel_s)
5061 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5062 cd write (iout,*) 'The BUFFER array:'
5064 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5066 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5068 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5069 C Clear the contacts of the atom passed to the neighboring processor
5070 nn=num_cont_hb(iatel_s+1)
5072 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5074 num_cont_hb(iatel_s)=0
5076 cd write (iout,*) 'Processor ',MyID,MyRank,
5077 cd & ' is sending correlation contribution to processor',MyID-1,
5078 cd & ' msglen=',msglen
5079 cd write (*,*) 'Processor ',MyID,MyRank,
5080 cd & ' is sending correlation contribution to processor',MyID-1,
5081 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5082 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5083 cd write (iout,*) 'Processor ',MyID,
5084 cd & ' has sent correlation contribution to processor',MyID-1,
5085 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5086 cd write (*,*) 'Processor ',MyID,
5087 cd & ' has sent correlation contribution to processor',MyID-1,
5088 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5090 endif ! (MyRank.gt.0)
5094 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5095 if (MyRank.lt.fgProcs-1) then
5096 C Receive correlation contributions from the next processor
5098 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5099 cd write (iout,*) 'Processor',MyID,
5100 cd & ' is receiving correlation contribution from processor',MyID+1,
5101 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5102 cd write (*,*) 'Processor',MyID,
5103 cd & ' is receiving correlation contribution from processor',MyID+1,
5104 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5106 do while (nbytes.le.0)
5107 call mp_probe(MyID+1,CorrelType,nbytes)
5109 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5110 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5111 cd write (iout,*) 'Processor',MyID,
5112 cd & ' has received correlation contribution from processor',MyID+1,
5113 cd & ' msglen=',msglen,' nbytes=',nbytes
5114 cd write (iout,*) 'The received BUFFER array:'
5116 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5118 if (msglen.eq.msglen1) then
5119 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5120 else if (msglen.eq.msglen2) then
5121 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5122 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5125 & 'ERROR!!!! message length changed while processing correlations.'
5127 & 'ERROR!!!! message length changed while processing correlations.'
5128 call mp_stopall(Error)
5129 endif ! msglen.eq.msglen1
5130 endif ! MyRank.lt.fgProcs-1
5137 write (iout,'(a)') 'Contact function values:'
5139 write (iout,'(2i3,50(1x,i2,f5.2))')
5140 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5141 & j=1,num_cont_hb(i))
5145 C Remove the loop below after debugging !!!
5152 C Calculate the local-electrostatic correlation terms
5153 do i=iatel_s,iatel_e+1
5155 num_conti=num_cont_hb(i)
5156 num_conti1=num_cont_hb(i+1)
5161 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5162 c & ' jj=',jj,' kk=',kk
5163 if (j1.eq.j+1 .or. j1.eq.j-1) then
5164 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5165 C The system gains extra energy.
5166 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5168 else if (j1.eq.j) then
5169 C Contacts I-J and I-(J+1) occur simultaneously.
5170 C The system loses extra energy.
5171 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5176 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5177 c & ' jj=',jj,' kk=',kk
5179 C Contacts I-J and (I+1)-J occur simultaneously.
5180 C The system loses extra energy.
5181 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5188 c------------------------------------------------------------------------------
5189 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5191 C This subroutine calculates multi-body contributions to hydrogen-bonding
5192 implicit real*8 (a-h,o-z)
5193 include 'DIMENSIONS'
5194 include 'DIMENSIONS.ZSCOPT'
5195 include 'COMMON.IOUNITS'
5197 include 'COMMON.INFO'
5199 include 'COMMON.FFIELD'
5200 include 'COMMON.DERIV'
5201 include 'COMMON.INTERACT'
5202 include 'COMMON.CONTACTS'
5204 parameter (max_cont=maxconts)
5205 parameter (max_dim=2*(8*3+2))
5206 parameter (msglen1=max_cont*max_dim*4)
5207 parameter (msglen2=2*msglen1)
5208 integer source,CorrelType,CorrelID,Error
5209 double precision buffer(max_cont,max_dim)
5211 double precision gx(3),gx1(3)
5214 C Set lprn=.true. for debugging
5220 if (fgProcs.le.1) goto 30
5222 write (iout,'(a)') 'Contact function values:'
5224 write (iout,'(2i3,50(1x,i2,f5.2))')
5225 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5226 & j=1,num_cont_hb(i))
5229 C Caution! Following code assumes that electrostatic interactions concerning
5230 C a given atom are split among at most two processors!
5240 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5243 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5244 if (MyRank.gt.0) then
5245 C Send correlation contributions to the preceding processor
5247 nn=num_cont_hb(iatel_s)
5248 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5249 cd write (iout,*) 'The BUFFER array:'
5251 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5253 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5255 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5256 C Clear the contacts of the atom passed to the neighboring processor
5257 nn=num_cont_hb(iatel_s+1)
5259 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5261 num_cont_hb(iatel_s)=0
5263 cd write (iout,*) 'Processor ',MyID,MyRank,
5264 cd & ' is sending correlation contribution to processor',MyID-1,
5265 cd & ' msglen=',msglen
5266 cd write (*,*) 'Processor ',MyID,MyRank,
5267 cd & ' is sending correlation contribution to processor',MyID-1,
5268 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5269 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5270 cd write (iout,*) 'Processor ',MyID,
5271 cd & ' has sent correlation contribution to processor',MyID-1,
5272 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5273 cd write (*,*) 'Processor ',MyID,
5274 cd & ' has sent correlation contribution to processor',MyID-1,
5275 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5277 endif ! (MyRank.gt.0)
5281 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5282 if (MyRank.lt.fgProcs-1) then
5283 C Receive correlation contributions from the next processor
5285 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5286 cd write (iout,*) 'Processor',MyID,
5287 cd & ' is receiving correlation contribution from processor',MyID+1,
5288 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5289 cd write (*,*) 'Processor',MyID,
5290 cd & ' is receiving correlation contribution from processor',MyID+1,
5291 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5293 do while (nbytes.le.0)
5294 call mp_probe(MyID+1,CorrelType,nbytes)
5296 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5297 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5298 cd write (iout,*) 'Processor',MyID,
5299 cd & ' has received correlation contribution from processor',MyID+1,
5300 cd & ' msglen=',msglen,' nbytes=',nbytes
5301 cd write (iout,*) 'The received BUFFER array:'
5303 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5305 if (msglen.eq.msglen1) then
5306 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5307 else if (msglen.eq.msglen2) then
5308 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5309 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5312 & 'ERROR!!!! message length changed while processing correlations.'
5314 & 'ERROR!!!! message length changed while processing correlations.'
5315 call mp_stopall(Error)
5316 endif ! msglen.eq.msglen1
5317 endif ! MyRank.lt.fgProcs-1
5324 write (iout,'(a)') 'Contact function values:'
5326 write (iout,'(2i3,50(1x,i2,f5.2))')
5327 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5328 & j=1,num_cont_hb(i))
5334 C Remove the loop below after debugging !!!
5341 C Calculate the dipole-dipole interaction energies
5342 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5343 do i=iatel_s,iatel_e+1
5344 num_conti=num_cont_hb(i)
5351 C Calculate the local-electrostatic correlation terms
5352 do i=iatel_s,iatel_e+1
5354 num_conti=num_cont_hb(i)
5355 num_conti1=num_cont_hb(i+1)
5360 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5361 c & ' jj=',jj,' kk=',kk
5362 if (j1.eq.j+1 .or. j1.eq.j-1) then
5363 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5364 C The system gains extra energy.
5366 sqd1=dsqrt(d_cont(jj,i))
5367 sqd2=dsqrt(d_cont(kk,i1))
5368 sred_geom = sqd1*sqd2
5369 IF (sred_geom.lt.cutoff_corr) THEN
5370 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5372 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5373 c & ' jj=',jj,' kk=',kk
5374 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5375 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5377 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5378 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5381 cd write (iout,*) 'sred_geom=',sred_geom,
5382 cd & ' ekont=',ekont,' fprim=',fprimcont
5383 call calc_eello(i,j,i+1,j1,jj,kk)
5384 if (wcorr4.gt.0.0d0)
5385 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5386 if (wcorr5.gt.0.0d0)
5387 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5388 c print *,"wcorr5",ecorr5
5389 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5390 cd write(2,*)'ijkl',i,j,i+1,j1
5391 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5392 & .or. wturn6.eq.0.0d0))then
5393 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5394 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5395 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5396 cd & 'ecorr6=',ecorr6
5397 cd write (iout,'(4e15.5)') sred_geom,
5398 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5399 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5400 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5401 else if (wturn6.gt.0.0d0
5402 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5403 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5404 eturn6=eturn6+eello_turn6(i,jj,kk)
5405 cd write (2,*) 'multibody_eello:eturn6',eturn6
5409 else if (j1.eq.j) then
5410 C Contacts I-J and I-(J+1) occur simultaneously.
5411 C The system loses extra energy.
5412 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5417 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5418 c & ' jj=',jj,' kk=',kk
5420 C Contacts I-J and (I+1)-J occur simultaneously.
5421 C The system loses extra energy.
5422 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5429 c------------------------------------------------------------------------------
5430 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5431 implicit real*8 (a-h,o-z)
5432 include 'DIMENSIONS'
5433 include 'COMMON.IOUNITS'
5434 include 'COMMON.DERIV'
5435 include 'COMMON.INTERACT'
5436 include 'COMMON.CONTACTS'
5437 double precision gx(3),gx1(3)
5447 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5448 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5449 C Following 4 lines for diagnostics.
5454 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5456 c write (iout,*)'Contacts have occurred for peptide groups',
5457 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5458 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5459 C Calculate the multi-body contribution to energy.
5460 ecorr=ecorr+ekont*ees
5462 C Calculate multi-body contributions to the gradient.
5464 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5465 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5466 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5467 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5468 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5469 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5470 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5471 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5472 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5473 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5474 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5475 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5476 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5477 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5481 gradcorr(ll,m)=gradcorr(ll,m)+
5482 & ees*ekl*gacont_hbr(ll,jj,i)-
5483 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5484 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5489 gradcorr(ll,m)=gradcorr(ll,m)+
5490 & ees*eij*gacont_hbr(ll,kk,k)-
5491 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5492 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5499 C---------------------------------------------------------------------------
5500 subroutine dipole(i,j,jj)
5501 implicit real*8 (a-h,o-z)
5502 include 'DIMENSIONS'
5503 include 'DIMENSIONS.ZSCOPT'
5504 include 'COMMON.IOUNITS'
5505 include 'COMMON.CHAIN'
5506 include 'COMMON.FFIELD'
5507 include 'COMMON.DERIV'
5508 include 'COMMON.INTERACT'
5509 include 'COMMON.CONTACTS'
5510 include 'COMMON.TORSION'
5511 include 'COMMON.VAR'
5512 include 'COMMON.GEO'
5513 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5515 iti1 = itortyp(itype(i+1))
5516 if (j.lt.nres-1) then
5517 if (itype(j).le.ntyp) then
5518 itj1 = itortyp(itype(j+1))
5526 dipi(iii,1)=Ub2(iii,i)
5527 dipderi(iii)=Ub2der(iii,i)
5528 dipi(iii,2)=b1(iii,iti1)
5529 dipj(iii,1)=Ub2(iii,j)
5530 dipderj(iii)=Ub2der(iii,j)
5531 dipj(iii,2)=b1(iii,itj1)
5535 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5538 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5541 if (.not.calc_grad) return
5546 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5550 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5555 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5556 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5558 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5560 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5562 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5566 C---------------------------------------------------------------------------
5567 subroutine calc_eello(i,j,k,l,jj,kk)
5569 C This subroutine computes matrices and vectors needed to calculate
5570 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5572 implicit real*8 (a-h,o-z)
5573 include 'DIMENSIONS'
5574 include 'DIMENSIONS.ZSCOPT'
5575 include 'COMMON.IOUNITS'
5576 include 'COMMON.CHAIN'
5577 include 'COMMON.DERIV'
5578 include 'COMMON.INTERACT'
5579 include 'COMMON.CONTACTS'
5580 include 'COMMON.TORSION'
5581 include 'COMMON.VAR'
5582 include 'COMMON.GEO'
5583 include 'COMMON.FFIELD'
5584 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5585 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5588 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5589 cd & ' jj=',jj,' kk=',kk
5590 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5593 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5594 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5597 call transpose2(aa1(1,1),aa1t(1,1))
5598 call transpose2(aa2(1,1),aa2t(1,1))
5601 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5602 & aa1tder(1,1,lll,kkk))
5603 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5604 & aa2tder(1,1,lll,kkk))
5608 C parallel orientation of the two CA-CA-CA frames.
5609 if (i.gt.1 .and. itype(i).le.ntyp) then
5610 iti=itortyp(itype(i))
5614 itk1=itortyp(itype(k+1))
5615 itj=itortyp(itype(j))
5616 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5617 itl1=itortyp(itype(l+1))
5621 C A1 kernel(j+1) A2T
5623 cd write (iout,'(3f10.5,5x,3f10.5)')
5624 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5626 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5627 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5628 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5629 C Following matrices are needed only for 6-th order cumulants
5630 IF (wcorr6.gt.0.0d0) THEN
5631 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5632 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5633 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5634 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5635 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5636 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5637 & ADtEAderx(1,1,1,1,1,1))
5639 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5640 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5641 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5642 & ADtEA1derx(1,1,1,1,1,1))
5644 C End 6-th order cumulants
5647 cd write (2,*) 'In calc_eello6'
5649 cd write (2,*) 'iii=',iii
5651 cd write (2,*) 'kkk=',kkk
5653 cd write (2,'(3(2f10.5),5x)')
5654 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5659 call transpose2(EUgder(1,1,k),auxmat(1,1))
5660 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5661 call transpose2(EUg(1,1,k),auxmat(1,1))
5662 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5663 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5667 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5668 & EAEAderx(1,1,lll,kkk,iii,1))
5672 C A1T kernel(i+1) A2
5673 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5674 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5675 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5676 C Following matrices are needed only for 6-th order cumulants
5677 IF (wcorr6.gt.0.0d0) THEN
5678 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5679 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5680 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5681 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5682 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5683 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5684 & ADtEAderx(1,1,1,1,1,2))
5685 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5686 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5687 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5688 & ADtEA1derx(1,1,1,1,1,2))
5690 C End 6-th order cumulants
5691 call transpose2(EUgder(1,1,l),auxmat(1,1))
5692 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5693 call transpose2(EUg(1,1,l),auxmat(1,1))
5694 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5695 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5699 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5700 & EAEAderx(1,1,lll,kkk,iii,2))
5705 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5706 C They are needed only when the fifth- or the sixth-order cumulants are
5708 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5709 call transpose2(AEA(1,1,1),auxmat(1,1))
5710 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5711 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5712 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5713 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5714 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5715 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5716 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5717 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5718 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5719 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5720 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5721 call transpose2(AEA(1,1,2),auxmat(1,1))
5722 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5723 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5724 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5725 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5726 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5727 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5728 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5729 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5730 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5731 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5732 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5733 C Calculate the Cartesian derivatives of the vectors.
5737 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5738 call matvec2(auxmat(1,1),b1(1,iti),
5739 & AEAb1derx(1,lll,kkk,iii,1,1))
5740 call matvec2(auxmat(1,1),Ub2(1,i),
5741 & AEAb2derx(1,lll,kkk,iii,1,1))
5742 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5743 & AEAb1derx(1,lll,kkk,iii,2,1))
5744 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5745 & AEAb2derx(1,lll,kkk,iii,2,1))
5746 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5747 call matvec2(auxmat(1,1),b1(1,itj),
5748 & AEAb1derx(1,lll,kkk,iii,1,2))
5749 call matvec2(auxmat(1,1),Ub2(1,j),
5750 & AEAb2derx(1,lll,kkk,iii,1,2))
5751 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5752 & AEAb1derx(1,lll,kkk,iii,2,2))
5753 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5754 & AEAb2derx(1,lll,kkk,iii,2,2))
5761 C Antiparallel orientation of the two CA-CA-CA frames.
5762 if (i.gt.1 .and. itype(i).le.ntyp) then
5763 iti=itortyp(itype(i))
5767 itk1=itortyp(itype(k+1))
5768 itl=itortyp(itype(l))
5769 itj=itortyp(itype(j))
5770 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5771 itj1=itortyp(itype(j+1))
5775 C A2 kernel(j-1)T A1T
5776 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5777 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5778 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5779 C Following matrices are needed only for 6-th order cumulants
5780 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5781 & j.eq.i+4 .and. l.eq.i+3)) THEN
5782 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5783 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5784 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5785 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5786 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5787 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5788 & ADtEAderx(1,1,1,1,1,1))
5789 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5790 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5791 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5792 & ADtEA1derx(1,1,1,1,1,1))
5794 C End 6-th order cumulants
5795 call transpose2(EUgder(1,1,k),auxmat(1,1))
5796 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5797 call transpose2(EUg(1,1,k),auxmat(1,1))
5798 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5799 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5803 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5804 & EAEAderx(1,1,lll,kkk,iii,1))
5808 C A2T kernel(i+1)T A1
5809 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5810 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5811 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5812 C Following matrices are needed only for 6-th order cumulants
5813 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5814 & j.eq.i+4 .and. l.eq.i+3)) THEN
5815 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5816 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5817 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5818 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5819 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5820 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5821 & ADtEAderx(1,1,1,1,1,2))
5822 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5823 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5824 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5825 & ADtEA1derx(1,1,1,1,1,2))
5827 C End 6-th order cumulants
5828 call transpose2(EUgder(1,1,j),auxmat(1,1))
5829 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5830 call transpose2(EUg(1,1,j),auxmat(1,1))
5831 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5832 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5836 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5837 & EAEAderx(1,1,lll,kkk,iii,2))
5842 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5843 C They are needed only when the fifth- or the sixth-order cumulants are
5845 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5846 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5847 call transpose2(AEA(1,1,1),auxmat(1,1))
5848 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5849 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5850 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5851 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5852 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5853 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5854 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5855 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5856 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5857 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5858 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5859 call transpose2(AEA(1,1,2),auxmat(1,1))
5860 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5861 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5862 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5863 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5864 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5865 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5866 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5867 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5868 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5869 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5870 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5871 C Calculate the Cartesian derivatives of the vectors.
5875 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5876 call matvec2(auxmat(1,1),b1(1,iti),
5877 & AEAb1derx(1,lll,kkk,iii,1,1))
5878 call matvec2(auxmat(1,1),Ub2(1,i),
5879 & AEAb2derx(1,lll,kkk,iii,1,1))
5880 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5881 & AEAb1derx(1,lll,kkk,iii,2,1))
5882 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5883 & AEAb2derx(1,lll,kkk,iii,2,1))
5884 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5885 call matvec2(auxmat(1,1),b1(1,itl),
5886 & AEAb1derx(1,lll,kkk,iii,1,2))
5887 call matvec2(auxmat(1,1),Ub2(1,l),
5888 & AEAb2derx(1,lll,kkk,iii,1,2))
5889 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5890 & AEAb1derx(1,lll,kkk,iii,2,2))
5891 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5892 & AEAb2derx(1,lll,kkk,iii,2,2))
5901 C---------------------------------------------------------------------------
5902 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5903 & KK,KKderg,AKA,AKAderg,AKAderx)
5907 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5908 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5909 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5914 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5916 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5919 cd if (lprn) write (2,*) 'In kernel'
5921 cd if (lprn) write (2,*) 'kkk=',kkk
5923 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5924 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5926 cd write (2,*) 'lll=',lll
5927 cd write (2,*) 'iii=1'
5929 cd write (2,'(3(2f10.5),5x)')
5930 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5933 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5934 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5936 cd write (2,*) 'lll=',lll
5937 cd write (2,*) 'iii=2'
5939 cd write (2,'(3(2f10.5),5x)')
5940 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5947 C---------------------------------------------------------------------------
5948 double precision function eello4(i,j,k,l,jj,kk)
5949 implicit real*8 (a-h,o-z)
5950 include 'DIMENSIONS'
5951 include 'DIMENSIONS.ZSCOPT'
5952 include 'COMMON.IOUNITS'
5953 include 'COMMON.CHAIN'
5954 include 'COMMON.DERIV'
5955 include 'COMMON.INTERACT'
5956 include 'COMMON.CONTACTS'
5957 include 'COMMON.TORSION'
5958 include 'COMMON.VAR'
5959 include 'COMMON.GEO'
5960 double precision pizda(2,2),ggg1(3),ggg2(3)
5961 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5965 cd print *,'eello4:',i,j,k,l,jj,kk
5966 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5967 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5968 cold eij=facont_hb(jj,i)
5969 cold ekl=facont_hb(kk,k)
5971 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5973 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5974 gcorr_loc(k-1)=gcorr_loc(k-1)
5975 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5977 gcorr_loc(l-1)=gcorr_loc(l-1)
5978 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5980 gcorr_loc(j-1)=gcorr_loc(j-1)
5981 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5986 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5987 & -EAEAderx(2,2,lll,kkk,iii,1)
5988 cd derx(lll,kkk,iii)=0.0d0
5992 cd gcorr_loc(l-1)=0.0d0
5993 cd gcorr_loc(j-1)=0.0d0
5994 cd gcorr_loc(k-1)=0.0d0
5996 cd write (iout,*)'Contacts have occurred for peptide groups',
5997 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5998 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5999 if (j.lt.nres-1) then
6006 if (l.lt.nres-1) then
6014 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6015 ggg1(ll)=eel4*g_contij(ll,1)
6016 ggg2(ll)=eel4*g_contij(ll,2)
6017 ghalf=0.5d0*ggg1(ll)
6019 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6020 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6021 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6022 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6023 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6024 ghalf=0.5d0*ggg2(ll)
6026 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6027 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6028 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6029 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6034 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6035 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6040 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6041 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6047 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6052 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6056 cd write (2,*) iii,gcorr_loc(iii)
6060 cd write (2,*) 'ekont',ekont
6061 cd write (iout,*) 'eello4',ekont*eel4
6064 C---------------------------------------------------------------------------
6065 double precision function eello5(i,j,k,l,jj,kk)
6066 implicit real*8 (a-h,o-z)
6067 include 'DIMENSIONS'
6068 include 'DIMENSIONS.ZSCOPT'
6069 include 'COMMON.IOUNITS'
6070 include 'COMMON.CHAIN'
6071 include 'COMMON.DERIV'
6072 include 'COMMON.INTERACT'
6073 include 'COMMON.CONTACTS'
6074 include 'COMMON.TORSION'
6075 include 'COMMON.VAR'
6076 include 'COMMON.GEO'
6077 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6078 double precision ggg1(3),ggg2(3)
6079 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6084 C /l\ / \ \ / \ / \ / C
6085 C / \ / \ \ / \ / \ / C
6086 C j| o |l1 | o | o| o | | o |o C
6087 C \ |/k\| |/ \| / |/ \| |/ \| C
6088 C \i/ \ / \ / / \ / \ C
6090 C (I) (II) (III) (IV) C
6092 C eello5_1 eello5_2 eello5_3 eello5_4 C
6094 C Antiparallel chains C
6097 C /j\ / \ \ / \ / \ / C
6098 C / \ / \ \ / \ / \ / C
6099 C j1| o |l | o | o| o | | o |o C
6100 C \ |/k\| |/ \| / |/ \| |/ \| C
6101 C \i/ \ / \ / / \ / \ C
6103 C (I) (II) (III) (IV) C
6105 C eello5_1 eello5_2 eello5_3 eello5_4 C
6107 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6109 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6110 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6115 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6117 itk=itortyp(itype(k))
6118 itl=itortyp(itype(l))
6119 itj=itortyp(itype(j))
6124 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6125 cd & eel5_3_num,eel5_4_num)
6129 derx(lll,kkk,iii)=0.0d0
6133 cd eij=facont_hb(jj,i)
6134 cd ekl=facont_hb(kk,k)
6136 cd write (iout,*)'Contacts have occurred for peptide groups',
6137 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6139 C Contribution from the graph I.
6140 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6141 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6142 call transpose2(EUg(1,1,k),auxmat(1,1))
6143 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6144 vv(1)=pizda(1,1)-pizda(2,2)
6145 vv(2)=pizda(1,2)+pizda(2,1)
6146 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6147 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6149 C Explicit gradient in virtual-dihedral angles.
6150 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6151 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6152 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6153 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6154 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6155 vv(1)=pizda(1,1)-pizda(2,2)
6156 vv(2)=pizda(1,2)+pizda(2,1)
6157 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6158 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6159 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6160 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6161 vv(1)=pizda(1,1)-pizda(2,2)
6162 vv(2)=pizda(1,2)+pizda(2,1)
6164 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6165 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6166 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6168 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6169 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6170 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6172 C Cartesian gradient
6176 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6178 vv(1)=pizda(1,1)-pizda(2,2)
6179 vv(2)=pizda(1,2)+pizda(2,1)
6180 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6181 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6182 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6189 C Contribution from graph II
6190 call transpose2(EE(1,1,itk),auxmat(1,1))
6191 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6192 vv(1)=pizda(1,1)+pizda(2,2)
6193 vv(2)=pizda(2,1)-pizda(1,2)
6194 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6195 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6197 C Explicit gradient in virtual-dihedral angles.
6198 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6199 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6200 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6201 vv(1)=pizda(1,1)+pizda(2,2)
6202 vv(2)=pizda(2,1)-pizda(1,2)
6204 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6205 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6206 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6208 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6209 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6210 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6212 C Cartesian gradient
6216 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6218 vv(1)=pizda(1,1)+pizda(2,2)
6219 vv(2)=pizda(2,1)-pizda(1,2)
6220 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6221 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6222 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6231 C Parallel orientation
6232 C Contribution from graph III
6233 call transpose2(EUg(1,1,l),auxmat(1,1))
6234 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6235 vv(1)=pizda(1,1)-pizda(2,2)
6236 vv(2)=pizda(1,2)+pizda(2,1)
6237 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6238 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6240 C Explicit gradient in virtual-dihedral angles.
6241 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6242 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6243 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6244 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6245 vv(1)=pizda(1,1)-pizda(2,2)
6246 vv(2)=pizda(1,2)+pizda(2,1)
6247 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6248 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6249 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6250 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6251 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6252 vv(1)=pizda(1,1)-pizda(2,2)
6253 vv(2)=pizda(1,2)+pizda(2,1)
6254 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6255 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6256 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6257 C Cartesian gradient
6261 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6263 vv(1)=pizda(1,1)-pizda(2,2)
6264 vv(2)=pizda(1,2)+pizda(2,1)
6265 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6266 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6267 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6273 C Contribution from graph IV
6275 call transpose2(EE(1,1,itl),auxmat(1,1))
6276 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6277 vv(1)=pizda(1,1)+pizda(2,2)
6278 vv(2)=pizda(2,1)-pizda(1,2)
6279 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6280 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6282 C Explicit gradient in virtual-dihedral angles.
6283 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6284 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6285 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6286 vv(1)=pizda(1,1)+pizda(2,2)
6287 vv(2)=pizda(2,1)-pizda(1,2)
6288 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6289 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6290 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6291 C Cartesian gradient
6295 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6297 vv(1)=pizda(1,1)+pizda(2,2)
6298 vv(2)=pizda(2,1)-pizda(1,2)
6299 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6300 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6301 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6307 C Antiparallel orientation
6308 C Contribution from graph III
6310 call transpose2(EUg(1,1,j),auxmat(1,1))
6311 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6312 vv(1)=pizda(1,1)-pizda(2,2)
6313 vv(2)=pizda(1,2)+pizda(2,1)
6314 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6315 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6317 C Explicit gradient in virtual-dihedral angles.
6318 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6319 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6320 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6321 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6322 vv(1)=pizda(1,1)-pizda(2,2)
6323 vv(2)=pizda(1,2)+pizda(2,1)
6324 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6325 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6326 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6327 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6328 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6329 vv(1)=pizda(1,1)-pizda(2,2)
6330 vv(2)=pizda(1,2)+pizda(2,1)
6331 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6332 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6333 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6334 C Cartesian gradient
6338 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6340 vv(1)=pizda(1,1)-pizda(2,2)
6341 vv(2)=pizda(1,2)+pizda(2,1)
6342 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6343 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6344 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6350 C Contribution from graph IV
6352 call transpose2(EE(1,1,itj),auxmat(1,1))
6353 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6354 vv(1)=pizda(1,1)+pizda(2,2)
6355 vv(2)=pizda(2,1)-pizda(1,2)
6356 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6357 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6359 C Explicit gradient in virtual-dihedral angles.
6360 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6361 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6362 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6363 vv(1)=pizda(1,1)+pizda(2,2)
6364 vv(2)=pizda(2,1)-pizda(1,2)
6365 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6366 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6367 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6368 C Cartesian gradient
6372 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6374 vv(1)=pizda(1,1)+pizda(2,2)
6375 vv(2)=pizda(2,1)-pizda(1,2)
6376 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6377 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6378 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6385 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6386 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6387 cd write (2,*) 'ijkl',i,j,k,l
6388 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6389 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6391 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6392 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6393 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6394 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6396 if (j.lt.nres-1) then
6403 if (l.lt.nres-1) then
6413 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6415 ggg1(ll)=eel5*g_contij(ll,1)
6416 ggg2(ll)=eel5*g_contij(ll,2)
6417 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6418 ghalf=0.5d0*ggg1(ll)
6420 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6421 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6422 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6423 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6424 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6425 ghalf=0.5d0*ggg2(ll)
6427 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6428 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6429 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6430 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6435 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6436 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6441 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6442 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6448 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6453 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6457 cd write (2,*) iii,g_corr5_loc(iii)
6461 cd write (2,*) 'ekont',ekont
6462 cd write (iout,*) 'eello5',ekont*eel5
6465 c--------------------------------------------------------------------------
6466 double precision function eello6(i,j,k,l,jj,kk)
6467 implicit real*8 (a-h,o-z)
6468 include 'DIMENSIONS'
6469 include 'DIMENSIONS.ZSCOPT'
6470 include 'COMMON.IOUNITS'
6471 include 'COMMON.CHAIN'
6472 include 'COMMON.DERIV'
6473 include 'COMMON.INTERACT'
6474 include 'COMMON.CONTACTS'
6475 include 'COMMON.TORSION'
6476 include 'COMMON.VAR'
6477 include 'COMMON.GEO'
6478 include 'COMMON.FFIELD'
6479 double precision ggg1(3),ggg2(3)
6480 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6485 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6493 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6494 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6498 derx(lll,kkk,iii)=0.0d0
6502 cd eij=facont_hb(jj,i)
6503 cd ekl=facont_hb(kk,k)
6509 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6510 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6511 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6512 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6513 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6514 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6516 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6517 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6518 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6519 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6520 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6521 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6525 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6527 C If turn contributions are considered, they will be handled separately.
6528 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6529 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6530 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6531 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6532 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6533 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6534 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6537 if (j.lt.nres-1) then
6544 if (l.lt.nres-1) then
6552 ggg1(ll)=eel6*g_contij(ll,1)
6553 ggg2(ll)=eel6*g_contij(ll,2)
6554 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6555 ghalf=0.5d0*ggg1(ll)
6557 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6558 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6559 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6560 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6561 ghalf=0.5d0*ggg2(ll)
6562 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6564 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6565 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6566 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6567 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6572 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6573 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6578 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6579 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6585 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6590 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6594 cd write (2,*) iii,g_corr6_loc(iii)
6598 cd write (2,*) 'ekont',ekont
6599 cd write (iout,*) 'eello6',ekont*eel6
6602 c--------------------------------------------------------------------------
6603 double precision function eello6_graph1(i,j,k,l,imat,swap)
6604 implicit real*8 (a-h,o-z)
6605 include 'DIMENSIONS'
6606 include 'DIMENSIONS.ZSCOPT'
6607 include 'COMMON.IOUNITS'
6608 include 'COMMON.CHAIN'
6609 include 'COMMON.DERIV'
6610 include 'COMMON.INTERACT'
6611 include 'COMMON.CONTACTS'
6612 include 'COMMON.TORSION'
6613 include 'COMMON.VAR'
6614 include 'COMMON.GEO'
6615 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6619 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6621 C Parallel Antiparallel C
6627 C \ j|/k\| / \ |/k\|l / C
6632 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6633 itk=itortyp(itype(k))
6634 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6635 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6636 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6637 call transpose2(EUgC(1,1,k),auxmat(1,1))
6638 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6639 vv1(1)=pizda1(1,1)-pizda1(2,2)
6640 vv1(2)=pizda1(1,2)+pizda1(2,1)
6641 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6642 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6643 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6644 s5=scalar2(vv(1),Dtobr2(1,i))
6645 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6646 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6647 if (.not. calc_grad) return
6648 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6649 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6650 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6651 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6652 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6653 & +scalar2(vv(1),Dtobr2der(1,i)))
6654 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6655 vv1(1)=pizda1(1,1)-pizda1(2,2)
6656 vv1(2)=pizda1(1,2)+pizda1(2,1)
6657 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6658 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6660 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6661 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6662 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6663 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6664 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6666 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6667 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6668 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6669 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6670 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6672 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6673 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6674 vv1(1)=pizda1(1,1)-pizda1(2,2)
6675 vv1(2)=pizda1(1,2)+pizda1(2,1)
6676 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6677 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6678 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6679 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6688 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6689 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6690 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6691 call transpose2(EUgC(1,1,k),auxmat(1,1))
6692 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6694 vv1(1)=pizda1(1,1)-pizda1(2,2)
6695 vv1(2)=pizda1(1,2)+pizda1(2,1)
6696 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6697 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6698 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6699 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6700 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6701 s5=scalar2(vv(1),Dtobr2(1,i))
6702 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6708 c----------------------------------------------------------------------------
6709 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6710 implicit real*8 (a-h,o-z)
6711 include 'DIMENSIONS'
6712 include 'DIMENSIONS.ZSCOPT'
6713 include 'COMMON.IOUNITS'
6714 include 'COMMON.CHAIN'
6715 include 'COMMON.DERIV'
6716 include 'COMMON.INTERACT'
6717 include 'COMMON.CONTACTS'
6718 include 'COMMON.TORSION'
6719 include 'COMMON.VAR'
6720 include 'COMMON.GEO'
6722 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6723 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6726 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6728 C Parallel Antiparallel C
6734 C \ j|/k\| \ |/k\|l C
6739 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6740 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6741 C AL 7/4/01 s1 would occur in the sixth-order moment,
6742 C but not in a cluster cumulant
6744 s1=dip(1,jj,i)*dip(1,kk,k)
6746 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6747 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6748 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6749 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6750 call transpose2(EUg(1,1,k),auxmat(1,1))
6751 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6752 vv(1)=pizda(1,1)-pizda(2,2)
6753 vv(2)=pizda(1,2)+pizda(2,1)
6754 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6755 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6757 eello6_graph2=-(s1+s2+s3+s4)
6759 eello6_graph2=-(s2+s3+s4)
6762 if (.not. calc_grad) return
6763 C Derivatives in gamma(i-1)
6766 s1=dipderg(1,jj,i)*dip(1,kk,k)
6768 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6769 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6770 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6771 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6773 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6775 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6777 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6779 C Derivatives in gamma(k-1)
6781 s1=dip(1,jj,i)*dipderg(1,kk,k)
6783 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6784 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6785 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6786 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6787 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6788 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6789 vv(1)=pizda(1,1)-pizda(2,2)
6790 vv(2)=pizda(1,2)+pizda(2,1)
6791 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6793 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6795 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6797 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6798 C Derivatives in gamma(j-1) or gamma(l-1)
6801 s1=dipderg(3,jj,i)*dip(1,kk,k)
6803 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6804 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6805 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6806 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6807 vv(1)=pizda(1,1)-pizda(2,2)
6808 vv(2)=pizda(1,2)+pizda(2,1)
6809 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6812 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6814 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6817 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6818 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6820 C Derivatives in gamma(l-1) or gamma(j-1)
6823 s1=dip(1,jj,i)*dipderg(3,kk,k)
6825 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6826 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6827 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6828 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6829 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6830 vv(1)=pizda(1,1)-pizda(2,2)
6831 vv(2)=pizda(1,2)+pizda(2,1)
6832 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6835 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6837 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6840 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6841 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6843 C Cartesian derivatives.
6845 write (2,*) 'In eello6_graph2'
6847 write (2,*) 'iii=',iii
6849 write (2,*) 'kkk=',kkk
6851 write (2,'(3(2f10.5),5x)')
6852 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6862 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6864 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6867 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6869 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6870 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6872 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6873 call transpose2(EUg(1,1,k),auxmat(1,1))
6874 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6876 vv(1)=pizda(1,1)-pizda(2,2)
6877 vv(2)=pizda(1,2)+pizda(2,1)
6878 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6879 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6881 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6883 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6886 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6888 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6895 c----------------------------------------------------------------------------
6896 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6897 implicit real*8 (a-h,o-z)
6898 include 'DIMENSIONS'
6899 include 'DIMENSIONS.ZSCOPT'
6900 include 'COMMON.IOUNITS'
6901 include 'COMMON.CHAIN'
6902 include 'COMMON.DERIV'
6903 include 'COMMON.INTERACT'
6904 include 'COMMON.CONTACTS'
6905 include 'COMMON.TORSION'
6906 include 'COMMON.VAR'
6907 include 'COMMON.GEO'
6908 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6910 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6912 C Parallel Antiparallel C
6918 C j|/k\| / |/k\|l / C
6923 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6925 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6926 C energy moment and not to the cluster cumulant.
6927 iti=itortyp(itype(i))
6928 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6929 itj1=itortyp(itype(j+1))
6933 itk=itortyp(itype(k))
6934 itk1=itortyp(itype(k+1))
6935 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6936 itl1=itortyp(itype(l+1))
6941 s1=dip(4,jj,i)*dip(4,kk,k)
6943 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6944 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6945 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6946 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6947 call transpose2(EE(1,1,itk),auxmat(1,1))
6948 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6949 vv(1)=pizda(1,1)+pizda(2,2)
6950 vv(2)=pizda(2,1)-pizda(1,2)
6951 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6952 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6954 eello6_graph3=-(s1+s2+s3+s4)
6956 eello6_graph3=-(s2+s3+s4)
6959 if (.not. calc_grad) return
6960 C Derivatives in gamma(k-1)
6961 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6962 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6963 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6964 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6965 C Derivatives in gamma(l-1)
6966 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6967 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6968 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6969 vv(1)=pizda(1,1)+pizda(2,2)
6970 vv(2)=pizda(2,1)-pizda(1,2)
6971 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6972 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6973 C Cartesian derivatives.
6979 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6981 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6984 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6986 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6987 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6989 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6990 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6992 vv(1)=pizda(1,1)+pizda(2,2)
6993 vv(2)=pizda(2,1)-pizda(1,2)
6994 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6996 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6998 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7001 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7003 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7005 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7011 c----------------------------------------------------------------------------
7012 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7013 implicit real*8 (a-h,o-z)
7014 include 'DIMENSIONS'
7015 include 'DIMENSIONS.ZSCOPT'
7016 include 'COMMON.IOUNITS'
7017 include 'COMMON.CHAIN'
7018 include 'COMMON.DERIV'
7019 include 'COMMON.INTERACT'
7020 include 'COMMON.CONTACTS'
7021 include 'COMMON.TORSION'
7022 include 'COMMON.VAR'
7023 include 'COMMON.GEO'
7024 include 'COMMON.FFIELD'
7025 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7026 & auxvec1(2),auxmat1(2,2)
7028 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7030 C Parallel Antiparallel C
7036 C \ j|/k\| \ |/k\|l C
7041 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7043 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7044 C energy moment and not to the cluster cumulant.
7045 cd write (2,*) 'eello_graph4: wturn6',wturn6
7046 iti=itortyp(itype(i))
7047 itj=itortyp(itype(j))
7048 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7049 itj1=itortyp(itype(j+1))
7053 itk=itortyp(itype(k))
7054 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7055 itk1=itortyp(itype(k+1))
7059 itl=itortyp(itype(l))
7060 if (l.lt.nres-1) then
7061 itl1=itortyp(itype(l+1))
7065 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7066 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7067 cd & ' itl',itl,' itl1',itl1
7070 s1=dip(3,jj,i)*dip(3,kk,k)
7072 s1=dip(2,jj,j)*dip(2,kk,l)
7075 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7076 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7078 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7079 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7081 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7082 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7084 call transpose2(EUg(1,1,k),auxmat(1,1))
7085 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7086 vv(1)=pizda(1,1)-pizda(2,2)
7087 vv(2)=pizda(2,1)+pizda(1,2)
7088 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7089 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7091 eello6_graph4=-(s1+s2+s3+s4)
7093 eello6_graph4=-(s2+s3+s4)
7095 if (.not. calc_grad) return
7096 C Derivatives in gamma(i-1)
7100 s1=dipderg(2,jj,i)*dip(3,kk,k)
7102 s1=dipderg(4,jj,j)*dip(2,kk,l)
7105 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7107 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7108 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7110 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7111 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7113 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7114 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7115 cd write (2,*) 'turn6 derivatives'
7117 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7119 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7123 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7125 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7129 C Derivatives in gamma(k-1)
7132 s1=dip(3,jj,i)*dipderg(2,kk,k)
7134 s1=dip(2,jj,j)*dipderg(4,kk,l)
7137 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7138 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7140 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7141 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7143 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7144 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7146 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7147 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7148 vv(1)=pizda(1,1)-pizda(2,2)
7149 vv(2)=pizda(2,1)+pizda(1,2)
7150 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7151 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7153 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7155 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7159 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7161 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7164 C Derivatives in gamma(j-1) or gamma(l-1)
7165 if (l.eq.j+1 .and. l.gt.1) then
7166 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7167 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7168 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7169 vv(1)=pizda(1,1)-pizda(2,2)
7170 vv(2)=pizda(2,1)+pizda(1,2)
7171 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7172 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7173 else if (j.gt.1) then
7174 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7175 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7176 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7177 vv(1)=pizda(1,1)-pizda(2,2)
7178 vv(2)=pizda(2,1)+pizda(1,2)
7179 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7180 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7181 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7183 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7186 C Cartesian derivatives.
7193 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7195 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7199 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7201 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7205 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7207 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7209 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7210 & b1(1,itj1),auxvec(1))
7211 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7213 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7214 & b1(1,itl1),auxvec(1))
7215 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7217 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7219 vv(1)=pizda(1,1)-pizda(2,2)
7220 vv(2)=pizda(2,1)+pizda(1,2)
7221 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7223 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7225 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7228 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7231 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7234 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7236 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7238 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7242 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7244 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7247 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7249 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7257 c----------------------------------------------------------------------------
7258 double precision function eello_turn6(i,jj,kk)
7259 implicit real*8 (a-h,o-z)
7260 include 'DIMENSIONS'
7261 include 'DIMENSIONS.ZSCOPT'
7262 include 'COMMON.IOUNITS'
7263 include 'COMMON.CHAIN'
7264 include 'COMMON.DERIV'
7265 include 'COMMON.INTERACT'
7266 include 'COMMON.CONTACTS'
7267 include 'COMMON.TORSION'
7268 include 'COMMON.VAR'
7269 include 'COMMON.GEO'
7270 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7271 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7273 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7274 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7275 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7276 C the respective energy moment and not to the cluster cumulant.
7281 iti=itortyp(itype(i))
7282 itk=itortyp(itype(k))
7283 itk1=itortyp(itype(k+1))
7284 itl=itortyp(itype(l))
7285 itj=itortyp(itype(j))
7286 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7287 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7288 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7293 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7295 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7299 derx_turn(lll,kkk,iii)=0.0d0
7306 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7308 cd write (2,*) 'eello6_5',eello6_5
7310 call transpose2(AEA(1,1,1),auxmat(1,1))
7311 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7312 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7313 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7317 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7318 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7319 s2 = scalar2(b1(1,itk),vtemp1(1))
7321 call transpose2(AEA(1,1,2),atemp(1,1))
7322 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7323 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7324 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7328 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7329 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7330 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7332 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7333 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7334 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7335 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7336 ss13 = scalar2(b1(1,itk),vtemp4(1))
7337 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7341 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7347 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7349 C Derivatives in gamma(i+2)
7351 call transpose2(AEA(1,1,1),auxmatd(1,1))
7352 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7353 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7354 call transpose2(AEAderg(1,1,2),atempd(1,1))
7355 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7356 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7360 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7361 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7362 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7368 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7369 C Derivatives in gamma(i+3)
7371 call transpose2(AEA(1,1,1),auxmatd(1,1))
7372 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7373 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7374 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7378 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7379 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7380 s2d = scalar2(b1(1,itk),vtemp1d(1))
7382 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7383 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7385 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7387 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7388 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7389 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7399 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7400 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7402 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7403 & -0.5d0*ekont*(s2d+s12d)
7405 C Derivatives in gamma(i+4)
7406 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7407 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7408 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7410 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7411 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7412 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7422 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7424 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7426 C Derivatives in gamma(i+5)
7428 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7429 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7430 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7434 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7435 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7436 s2d = scalar2(b1(1,itk),vtemp1d(1))
7438 call transpose2(AEA(1,1,2),atempd(1,1))
7439 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7440 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7444 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7445 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7447 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7448 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7449 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7459 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7460 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7462 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7463 & -0.5d0*ekont*(s2d+s12d)
7465 C Cartesian derivatives
7470 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7471 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7472 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7476 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7477 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7479 s2d = scalar2(b1(1,itk),vtemp1d(1))
7481 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7482 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7483 s8d = -(atempd(1,1)+atempd(2,2))*
7484 & scalar2(cc(1,1,itl),vtemp2(1))
7488 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7490 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7491 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7498 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7501 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7505 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7506 & - 0.5d0*(s8d+s12d)
7508 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7517 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7519 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7520 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7521 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7522 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7523 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7525 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7526 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7527 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7531 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7532 cd & 16*eel_turn6_num
7534 if (j.lt.nres-1) then
7541 if (l.lt.nres-1) then
7549 ggg1(ll)=eel_turn6*g_contij(ll,1)
7550 ggg2(ll)=eel_turn6*g_contij(ll,2)
7551 ghalf=0.5d0*ggg1(ll)
7553 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7554 & +ekont*derx_turn(ll,2,1)
7555 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7556 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7557 & +ekont*derx_turn(ll,4,1)
7558 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7559 ghalf=0.5d0*ggg2(ll)
7561 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7562 & +ekont*derx_turn(ll,2,2)
7563 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7564 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7565 & +ekont*derx_turn(ll,4,2)
7566 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7571 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7576 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7582 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7587 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7591 cd write (2,*) iii,g_corr6_loc(iii)
7594 eello_turn6=ekont*eel_turn6
7595 cd write (2,*) 'ekont',ekont
7596 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7599 crc-------------------------------------------------
7600 SUBROUTINE MATVEC2(A1,V1,V2)
7601 implicit real*8 (a-h,o-z)
7602 include 'DIMENSIONS'
7603 DIMENSION A1(2,2),V1(2),V2(2)
7607 c 3 VI=VI+A1(I,K)*V1(K)
7611 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7612 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7617 C---------------------------------------
7618 SUBROUTINE MATMAT2(A1,A2,A3)
7619 implicit real*8 (a-h,o-z)
7620 include 'DIMENSIONS'
7621 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7622 c DIMENSION AI3(2,2)
7626 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7632 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7633 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7634 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7635 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7643 c-------------------------------------------------------------------------
7644 double precision function scalar2(u,v)
7646 double precision u(2),v(2)
7649 scalar2=u(1)*v(1)+u(2)*v(2)
7653 C-----------------------------------------------------------------------------
7655 subroutine transpose2(a,at)
7657 double precision a(2,2),at(2,2)
7664 c--------------------------------------------------------------------------
7665 subroutine transpose(n,a,at)
7668 double precision a(n,n),at(n,n)
7676 C---------------------------------------------------------------------------
7677 subroutine prodmat3(a1,a2,kk,transp,prod)
7680 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7682 crc double precision auxmat(2,2),prod_(2,2)
7685 crc call transpose2(kk(1,1),auxmat(1,1))
7686 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7687 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7689 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7690 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7691 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7692 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7693 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7694 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7695 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7696 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7699 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7700 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7702 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7703 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7704 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7705 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7706 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7707 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7708 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7709 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7712 c call transpose2(a2(1,1),a2t(1,1))
7715 crc print *,((prod_(i,j),i=1,2),j=1,2)
7716 crc print *,((prod(i,j),i=1,2),j=1,2)
7720 C-----------------------------------------------------------------------------
7721 double precision function scalar(u,v)
7723 double precision u(3),v(3)
7733 C-----------------------------------------------------------------------
7734 double precision function sscale(r)
7735 double precision r,gamm
7736 include "COMMON.SPLITELE"
7737 if(r.lt.r_cut-rlamb) then
7739 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7740 gamm=(r-(r_cut-rlamb))/rlamb
7741 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7747 C-----------------------------------------------------------------------
7748 C-----------------------------------------------------------------------
7749 double precision function sscagrad(r)
7750 double precision r,gamm
7751 include "COMMON.SPLITELE"
7752 if(r.lt.r_cut-rlamb) then
7754 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7755 gamm=(r-(r_cut-rlamb))/rlamb
7756 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7762 C-----------------------------------------------------------------------