1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
70 call ebend(ebe,ethetacnstr)
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
157 energia(24)=ethetacnstr
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 c & +wsccor*fact(1)*gsccor_loc(i)
236 if (dyn_ss) call dyn_set_nss
239 C------------------------------------------------------------------------
240 subroutine enerprint(energia,fact)
241 implicit real*8 (a-h,o-z)
243 include 'sizesclu.dat'
244 include 'COMMON.IOUNITS'
245 include 'COMMON.FFIELD'
246 include 'COMMON.SBRIDGE'
247 double precision energia(0:max_ene),fact(6)
249 evdw=energia(1)+fact(6)*energia(21)
251 evdw2=energia(2)+energia(17)
263 eello_turn3=energia(8)
264 eello_turn4=energia(9)
265 eello_turn6=energia(10)
272 edihcnstr=energia(20)
274 ethetacnstr=energia(24)
276 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
278 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
279 & etors_d,wtor_d*fact(2),ehpb,wstrain,
280 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
281 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
282 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
283 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
284 10 format (/'Virtual-chain energies:'//
285 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
286 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
287 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
288 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
289 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
290 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
291 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
292 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
293 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
294 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
295 & ' (SS bridges & dist. cnstr.)'/
296 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
298 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
299 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
300 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
301 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
302 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
303 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
304 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
305 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
306 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
307 & 'ETOT= ',1pE16.6,' (total)')
309 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
310 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
311 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
312 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
313 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
314 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
315 & edihcnstr,ethetacnstr,ebr*nss,etot
316 10 format (/'Virtual-chain energies:'//
317 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
318 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
319 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
320 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
321 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
322 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
323 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
324 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
325 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
326 & ' (SS bridges & dist. cnstr.)'/
327 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
328 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
329 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
330 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
331 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
332 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
333 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
334 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
335 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
336 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
337 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
338 & 'ETOT= ',1pE16.6,' (total)')
342 C-----------------------------------------------------------------------
343 subroutine elj(evdw,evdw_t)
345 C This subroutine calculates the interaction energy of nonbonded side chains
346 C assuming the LJ potential of interaction.
348 implicit real*8 (a-h,o-z)
350 include 'sizesclu.dat'
351 include "DIMENSIONS.COMPAR"
352 parameter (accur=1.0d-10)
355 include 'COMMON.LOCAL'
356 include 'COMMON.CHAIN'
357 include 'COMMON.DERIV'
358 include 'COMMON.INTERACT'
359 include 'COMMON.TORSION'
360 include 'COMMON.SBRIDGE'
361 include 'COMMON.NAMES'
362 include 'COMMON.IOUNITS'
363 include 'COMMON.CONTACTS'
367 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 c ROZNICA DODANE Z WHAM
371 c eneps_temp(j,i)=0.0d0
380 if (itypi.eq.ntyp1) cycle
381 itypi1=iabs(itype(i+1))
388 C Calculate SC interaction energy.
391 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
392 cd & 'iend=',iend(i,iint)
393 do j=istart(i,iint),iend(i,iint)
395 if (itypj.eq.ntyp1) cycle
399 C Change 12/1/95 to calculate four-body interactions
400 rij=xj*xj+yj*yj+zj*zj
402 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
403 eps0ij=eps(itypi,itypj)
405 e1=fac*fac*aa(itypi,itypj)
406 e2=fac*bb(itypi,itypj)
408 ij=icant(itypi,itypj)
410 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
411 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
414 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
415 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
416 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
417 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
418 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
419 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
420 if (bb(itypi,itypj).gt.0.0d0) then
427 C Calculate the components of the gradient in DC and X
429 fac=-rrij*(e1+evdwij)
434 gvdwx(k,i)=gvdwx(k,i)-gg(k)
435 gvdwx(k,j)=gvdwx(k,j)+gg(k)
439 gvdwc(l,k)=gvdwc(l,k)+gg(l)
444 C 12/1/95, revised on 5/20/97
446 C Calculate the contact function. The ith column of the array JCONT will
447 C contain the numbers of atoms that make contacts with the atom I (of numbers
448 C greater than I). The arrays FACONT and GACONT will contain the values of
449 C the contact function and its derivative.
451 C Uncomment next line, if the correlation interactions include EVDW explicitly.
452 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
453 C Uncomment next line, if the correlation interactions are contact function only
454 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
456 sigij=sigma(itypi,itypj)
457 r0ij=rs0(itypi,itypj)
459 C Check whether the SC's are not too far to make a contact.
462 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
463 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
465 if (fcont.gt.0.0D0) then
466 C If the SC-SC distance if close to sigma, apply spline.
467 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
468 cAdam & fcont1,fprimcont1)
469 cAdam fcont1=1.0d0-fcont1
470 cAdam if (fcont1.gt.0.0d0) then
471 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
472 cAdam fcont=fcont*fcont1
474 C Uncomment following 4 lines to have the geometric average of the epsilon0's
475 cga eps0ij=1.0d0/dsqrt(eps0ij)
477 cga gg(k)=gg(k)*eps0ij
479 cga eps0ij=-evdwij*eps0ij
480 C Uncomment for AL's type of SC correlation interactions.
482 num_conti=num_conti+1
484 facont(num_conti,i)=fcont*eps0ij
485 fprimcont=eps0ij*fprimcont/rij
487 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
488 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
489 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
490 C Uncomment following 3 lines for Skolnick's type of SC correlation.
491 gacont(1,num_conti,i)=-fprimcont*xj
492 gacont(2,num_conti,i)=-fprimcont*yj
493 gacont(3,num_conti,i)=-fprimcont*zj
494 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
495 cd write (iout,'(2i3,3f10.5)')
496 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
502 num_cont(i)=num_conti
507 gvdwc(j,i)=expon*gvdwc(j,i)
508 gvdwx(j,i)=expon*gvdwx(j,i)
512 C******************************************************************************
516 C To save time, the factor of EXPON has been extracted from ALL components
517 C of GVDWC and GRADX. Remember to multiply them by this factor before further
520 C******************************************************************************
523 C-----------------------------------------------------------------------------
524 subroutine eljk(evdw,evdw_t)
526 C This subroutine calculates the interaction energy of nonbonded side chains
527 C assuming the LJK potential of interaction.
529 implicit real*8 (a-h,o-z)
531 include 'sizesclu.dat'
532 include "DIMENSIONS.COMPAR"
535 include 'COMMON.LOCAL'
536 include 'COMMON.CHAIN'
537 include 'COMMON.DERIV'
538 include 'COMMON.INTERACT'
539 include 'COMMON.IOUNITS'
540 include 'COMMON.NAMES'
545 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
550 if (itypi.eq.ntyp1) cycle
551 itypi1=iabs(itype(i+1))
556 C Calculate SC interaction energy.
559 do j=istart(i,iint),iend(i,iint)
561 if (itypj.eq.ntyp1) cycle
565 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
567 e_augm=augm(itypi,itypj)*fac_augm
570 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
571 fac=r_shift_inv**expon
572 e1=fac*fac*aa(itypi,itypj)
573 e2=fac*bb(itypi,itypj)
575 ij=icant(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 'sizesclu.dat'
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.IOUNITS'
637 include 'COMMON.CALC'
639 c double precision rrsave(maxdim)
645 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
646 c if (icall.eq.0) then
654 if (itypi.eq.ntyp1) cycle
655 itypi1=iabs(itype(i+1))
659 dxi=dc_norm(1,nres+i)
660 dyi=dc_norm(2,nres+i)
661 dzi=dc_norm(3,nres+i)
662 dsci_inv=vbld_inv(i+nres)
664 C Calculate SC interaction energy.
667 do j=istart(i,iint),iend(i,iint)
670 if (itypj.eq.ntyp1) cycle
671 dscj_inv=vbld_inv(j+nres)
672 chi1=chi(itypi,itypj)
673 chi2=chi(itypj,itypi)
680 alf12=0.5D0*(alf1+alf2)
681 C For diagnostics only!!!
694 dxj=dc_norm(1,nres+j)
695 dyj=dc_norm(2,nres+j)
696 dzj=dc_norm(3,nres+j)
697 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
698 cd if (icall.eq.0) then
704 C Calculate the angle-dependent terms of energy & contributions to derivatives.
706 C Calculate whole angle-dependent part of epsilon and contributions
708 fac=(rrij*sigsq)**expon2
709 e1=fac*fac*aa(itypi,itypj)
710 e2=fac*bb(itypi,itypj)
711 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
712 eps2der=evdwij*eps3rt
713 eps3der=evdwij*eps2rt
714 evdwij=evdwij*eps2rt*eps3rt
715 ij=icant(itypi,itypj)
716 aux=eps1*eps2rt**2*eps3rt**2
717 if (bb(itypi,itypj).gt.0.0d0) then
724 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
725 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
726 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
727 cd & restyp(itypi),i,restyp(itypj),j,
728 cd & epsi,sigm,chi1,chi2,chip1,chip2,
729 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
730 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
733 C Calculate gradient components.
734 e1=e1*eps1*eps2rt**2*eps3rt**2
735 fac=-expon*(e1+evdwij)
738 C Calculate radial part of the gradient
742 C Calculate the angular part of the gradient and sum add the contributions
743 C to the appropriate components of the Cartesian gradient.
752 C-----------------------------------------------------------------------------
753 subroutine egb(evdw,evdw_t)
755 C This subroutine calculates the interaction energy of nonbonded side chains
756 C assuming the Gay-Berne potential of interaction.
758 implicit real*8 (a-h,o-z)
760 include 'sizesclu.dat'
761 include "DIMENSIONS.COMPAR"
764 include 'COMMON.LOCAL'
765 include 'COMMON.CHAIN'
766 include 'COMMON.DERIV'
767 include 'COMMON.NAMES'
768 include 'COMMON.INTERACT'
769 include 'COMMON.IOUNITS'
770 include 'COMMON.CALC'
771 include 'COMMON.SBRIDGE'
776 integer xshift,yshift,zshift
777 logical energy_dec /.false./
778 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
782 c if (icall.gt.0) lprn=.true.
786 if (itypi.eq.ntyp1) cycle
787 itypi1=iabs(itype(i+1))
792 if (xi.lt.0) xi=xi+boxxsize
794 if (yi.lt.0) yi=yi+boxysize
796 if (zi.lt.0) zi=zi+boxzsize
797 dxi=dc_norm(1,nres+i)
798 dyi=dc_norm(2,nres+i)
799 dzi=dc_norm(3,nres+i)
800 dsci_inv=vbld_inv(i+nres)
802 C Calculate SC interaction energy.
805 do j=istart(i,iint),iend(i,iint)
806 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
808 c write(iout,*) "PRZED ZWYKLE", evdwij
809 call dyn_ssbond_ene(i,j,evdwij)
810 c write(iout,*) "PO ZWYKLE", evdwij
813 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
814 & 'evdw',i,j,evdwij,' ss'
815 C triple bond artifac removal
816 do k=j+1,iend(i,iint)
817 C search over all next residues
818 if (dyn_ss_mask(k)) then
819 C check if they are cysteins
820 C write(iout,*) 'k=',k
822 c write(iout,*) "PRZED TRI", evdwij
823 evdwij_przed_tri=evdwij
824 call triple_ssbond_ene(i,j,k,evdwij)
825 c if(evdwij_przed_tri.ne.evdwij) then
826 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
829 c write(iout,*) "PO TRI", evdwij
830 C call the energy function that removes the artifical triple disulfide
831 C bond the soubroutine is located in ssMD.F
833 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
834 & 'evdw',i,j,evdwij,'tss'
840 if (itypj.eq.ntyp1) cycle
841 dscj_inv=vbld_inv(j+nres)
842 sig0ij=sigma(itypi,itypj)
843 chi1=chi(itypi,itypj)
844 chi2=chi(itypj,itypi)
851 alf12=0.5D0*(alf1+alf2)
852 C For diagnostics only!!!
866 if (xj.lt.0) xj=xj+boxxsize
868 if (yj.lt.0) yj=yj+boxysize
870 if (zj.lt.0) zj=zj+boxzsize
871 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
879 xj=xj_safe+xshift*boxxsize
880 yj=yj_safe+yshift*boxysize
881 zj=zj_safe+zshift*boxzsize
882 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
883 if(dist_temp.lt.dist_init) then
893 if (subchap.eq.1) then
902 dxj=dc_norm(1,nres+j)
903 dyj=dc_norm(2,nres+j)
904 dzj=dc_norm(3,nres+j)
905 c write (iout,*) i,j,xj,yj,zj
906 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
908 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
909 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
910 if (sss.le.0.0d0) cycle
911 C Calculate angle-dependent terms of energy and contributions to their
915 sig=sig0ij*dsqrt(sigsq)
916 rij_shift=1.0D0/rij-sig+sig0ij
917 C I hate to put IF's in the loops, but here don't have another choice!!!!
918 if (rij_shift.le.0.0D0) then
923 c---------------------------------------------------------------
924 rij_shift=1.0D0/rij_shift
926 e1=fac*fac*aa(itypi,itypj)
927 e2=fac*bb(itypi,itypj)
928 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
929 eps2der=evdwij*eps3rt
930 eps3der=evdwij*eps2rt
931 evdwij=evdwij*eps2rt*eps3rt
932 if (bb(itypi,itypj).gt.0) then
935 evdw_t=evdw_t+evdwij*sss
937 ij=icant(itypi,itypj)
938 aux=eps1*eps2rt**2*eps3rt**2
939 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
940 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
941 c & aux*e2/eps(itypi,itypj)
943 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
944 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
945 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
946 c & restyp(itypi),i,restyp(itypj),j,
947 c & epsi,sigm,chi1,chi2,chip1,chip2,
948 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
949 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
951 c write (iout,*) "pratial sum", evdw,evdw_t
954 C Calculate gradient components.
955 e1=e1*eps1*eps2rt**2*eps3rt**2
956 fac=-expon*(e1+evdwij)*rij_shift
959 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
960 C Calculate the radial part of the gradient
964 C Calculate angular part of the gradient.
973 C-----------------------------------------------------------------------------
974 subroutine egbv(evdw,evdw_t)
976 C This subroutine calculates the interaction energy of nonbonded side chains
977 C assuming the Gay-Berne-Vorobjev potential of interaction.
979 implicit real*8 (a-h,o-z)
981 include 'sizesclu.dat'
982 include "DIMENSIONS.COMPAR"
985 include 'COMMON.LOCAL'
986 include 'COMMON.CHAIN'
987 include 'COMMON.DERIV'
988 include 'COMMON.NAMES'
989 include 'COMMON.INTERACT'
990 include 'COMMON.IOUNITS'
991 include 'COMMON.CALC'
998 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1001 c if (icall.gt.0) lprn=.true.
1003 do i=iatsc_s,iatsc_e
1004 itypi=iabs(itype(i))
1005 if (itypi.eq.ntyp1) cycle
1006 itypi1=iabs(itype(i+1))
1010 dxi=dc_norm(1,nres+i)
1011 dyi=dc_norm(2,nres+i)
1012 dzi=dc_norm(3,nres+i)
1013 dsci_inv=vbld_inv(i+nres)
1015 C Calculate SC interaction energy.
1017 do iint=1,nint_gr(i)
1018 do j=istart(i,iint),iend(i,iint)
1020 itypj=iabs(itype(j))
1021 if (itypj.eq.ntyp1) cycle
1022 dscj_inv=vbld_inv(j+nres)
1023 sig0ij=sigma(itypi,itypj)
1024 r0ij=r0(itypi,itypj)
1025 chi1=chi(itypi,itypj)
1026 chi2=chi(itypj,itypi)
1033 alf12=0.5D0*(alf1+alf2)
1034 C For diagnostics only!!!
1047 dxj=dc_norm(1,nres+j)
1048 dyj=dc_norm(2,nres+j)
1049 dzj=dc_norm(3,nres+j)
1050 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1052 C Calculate angle-dependent terms of energy and contributions to their
1056 sig=sig0ij*dsqrt(sigsq)
1057 rij_shift=1.0D0/rij-sig+r0ij
1058 C I hate to put IF's in the loops, but here don't have another choice!!!!
1059 if (rij_shift.le.0.0D0) then
1064 c---------------------------------------------------------------
1065 rij_shift=1.0D0/rij_shift
1066 fac=rij_shift**expon
1067 e1=fac*fac*aa(itypi,itypj)
1068 e2=fac*bb(itypi,itypj)
1069 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1070 eps2der=evdwij*eps3rt
1071 eps3der=evdwij*eps2rt
1072 fac_augm=rrij**expon
1073 e_augm=augm(itypi,itypj)*fac_augm
1074 evdwij=evdwij*eps2rt*eps3rt
1075 if (bb(itypi,itypj).gt.0.0d0) then
1076 evdw=evdw+evdwij+e_augm
1078 evdw_t=evdw_t+evdwij+e_augm
1080 ij=icant(itypi,itypj)
1081 aux=eps1*eps2rt**2*eps3rt**2
1083 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1084 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1085 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1086 c & restyp(itypi),i,restyp(itypj),j,
1087 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1088 c & chi1,chi2,chip1,chip2,
1089 c & eps1,eps2rt**2,eps3rt**2,
1090 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1094 C Calculate gradient components.
1095 e1=e1*eps1*eps2rt**2*eps3rt**2
1096 fac=-expon*(e1+evdwij)*rij_shift
1098 fac=rij*fac-2*expon*rrij*e_augm
1099 C Calculate the radial part of the gradient
1103 C Calculate angular part of the gradient.
1111 C-----------------------------------------------------------------------------
1112 subroutine sc_angular
1113 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1114 C om12. Called by ebp, egb, and egbv.
1116 include 'COMMON.CALC'
1120 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1121 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1122 om12=dxi*dxj+dyi*dyj+dzi*dzj
1124 C Calculate eps1(om12) and its derivative in om12
1125 faceps1=1.0D0-om12*chiom12
1126 faceps1_inv=1.0D0/faceps1
1127 eps1=dsqrt(faceps1_inv)
1128 C Following variable is eps1*deps1/dom12
1129 eps1_om12=faceps1_inv*chiom12
1130 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1135 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1136 sigsq=1.0D0-facsig*faceps1_inv
1137 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1138 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1139 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1140 C Calculate eps2 and its derivatives in om1, om2, and om12.
1143 chipom12=chip12*om12
1144 facp=1.0D0-om12*chipom12
1146 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1147 C Following variable is the square root of eps2
1148 eps2rt=1.0D0-facp1*facp_inv
1149 C Following three variables are the derivatives of the square root of eps
1150 C in om1, om2, and om12.
1151 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1152 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1153 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1154 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1155 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1156 C Calculate whole angle-dependent part of epsilon and contributions
1157 C to its derivatives
1160 C----------------------------------------------------------------------------
1162 implicit real*8 (a-h,o-z)
1163 include 'DIMENSIONS'
1164 include 'sizesclu.dat'
1165 include 'COMMON.CHAIN'
1166 include 'COMMON.DERIV'
1167 include 'COMMON.CALC'
1168 double precision dcosom1(3),dcosom2(3)
1169 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1170 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1171 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1172 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1174 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1175 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1178 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1181 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1182 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1183 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1184 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1185 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1186 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1189 C Calculate the components of the gradient in DC and X
1193 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1198 c------------------------------------------------------------------------------
1199 subroutine vec_and_deriv
1200 implicit real*8 (a-h,o-z)
1201 include 'DIMENSIONS'
1202 include 'sizesclu.dat'
1203 include 'COMMON.IOUNITS'
1204 include 'COMMON.GEO'
1205 include 'COMMON.VAR'
1206 include 'COMMON.LOCAL'
1207 include 'COMMON.CHAIN'
1208 include 'COMMON.VECTORS'
1209 include 'COMMON.DERIV'
1210 include 'COMMON.INTERACT'
1211 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1212 C Compute the local reference systems. For reference system (i), the
1213 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1214 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1216 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1217 if (i.eq.nres-1) then
1218 C Case of the last full residue
1219 C Compute the Z-axis
1220 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1221 costh=dcos(pi-theta(nres))
1222 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1227 C Compute the derivatives of uz
1229 uzder(2,1,1)=-dc_norm(3,i-1)
1230 uzder(3,1,1)= dc_norm(2,i-1)
1231 uzder(1,2,1)= dc_norm(3,i-1)
1233 uzder(3,2,1)=-dc_norm(1,i-1)
1234 uzder(1,3,1)=-dc_norm(2,i-1)
1235 uzder(2,3,1)= dc_norm(1,i-1)
1238 uzder(2,1,2)= dc_norm(3,i)
1239 uzder(3,1,2)=-dc_norm(2,i)
1240 uzder(1,2,2)=-dc_norm(3,i)
1242 uzder(3,2,2)= dc_norm(1,i)
1243 uzder(1,3,2)= dc_norm(2,i)
1244 uzder(2,3,2)=-dc_norm(1,i)
1247 C Compute the Y-axis
1250 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1253 C Compute the derivatives of uy
1256 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1257 & -dc_norm(k,i)*dc_norm(j,i-1)
1258 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1260 uyder(j,j,1)=uyder(j,j,1)-costh
1261 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1266 uygrad(l,k,j,i)=uyder(l,k,j)
1267 uzgrad(l,k,j,i)=uzder(l,k,j)
1271 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1272 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1273 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1274 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1278 C Compute the Z-axis
1279 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1280 costh=dcos(pi-theta(i+2))
1281 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1286 C Compute the derivatives of uz
1288 uzder(2,1,1)=-dc_norm(3,i+1)
1289 uzder(3,1,1)= dc_norm(2,i+1)
1290 uzder(1,2,1)= dc_norm(3,i+1)
1292 uzder(3,2,1)=-dc_norm(1,i+1)
1293 uzder(1,3,1)=-dc_norm(2,i+1)
1294 uzder(2,3,1)= dc_norm(1,i+1)
1297 uzder(2,1,2)= dc_norm(3,i)
1298 uzder(3,1,2)=-dc_norm(2,i)
1299 uzder(1,2,2)=-dc_norm(3,i)
1301 uzder(3,2,2)= dc_norm(1,i)
1302 uzder(1,3,2)= dc_norm(2,i)
1303 uzder(2,3,2)=-dc_norm(1,i)
1306 C Compute the Y-axis
1309 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1312 C Compute the derivatives of uy
1315 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1316 & -dc_norm(k,i)*dc_norm(j,i+1)
1317 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1319 uyder(j,j,1)=uyder(j,j,1)-costh
1320 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1325 uygrad(l,k,j,i)=uyder(l,k,j)
1326 uzgrad(l,k,j,i)=uzder(l,k,j)
1330 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1331 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1332 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1333 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1339 vbld_inv_temp(1)=vbld_inv(i+1)
1340 if (i.lt.nres-1) then
1341 vbld_inv_temp(2)=vbld_inv(i+2)
1343 vbld_inv_temp(2)=vbld_inv(i)
1348 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1349 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1357 C-----------------------------------------------------------------------------
1358 subroutine vec_and_deriv_test
1359 implicit real*8 (a-h,o-z)
1360 include 'DIMENSIONS'
1361 include 'sizesclu.dat'
1362 include 'COMMON.IOUNITS'
1363 include 'COMMON.GEO'
1364 include 'COMMON.VAR'
1365 include 'COMMON.LOCAL'
1366 include 'COMMON.CHAIN'
1367 include 'COMMON.VECTORS'
1368 dimension uyder(3,3,2),uzder(3,3,2)
1369 C Compute the local reference systems. For reference system (i), the
1370 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1371 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1373 if (i.eq.nres-1) then
1374 C Case of the last full residue
1375 C Compute the Z-axis
1376 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1377 costh=dcos(pi-theta(nres))
1378 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1379 c write (iout,*) 'fac',fac,
1380 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1381 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1385 C Compute the derivatives of uz
1387 uzder(2,1,1)=-dc_norm(3,i-1)
1388 uzder(3,1,1)= dc_norm(2,i-1)
1389 uzder(1,2,1)= dc_norm(3,i-1)
1391 uzder(3,2,1)=-dc_norm(1,i-1)
1392 uzder(1,3,1)=-dc_norm(2,i-1)
1393 uzder(2,3,1)= dc_norm(1,i-1)
1396 uzder(2,1,2)= dc_norm(3,i)
1397 uzder(3,1,2)=-dc_norm(2,i)
1398 uzder(1,2,2)=-dc_norm(3,i)
1400 uzder(3,2,2)= dc_norm(1,i)
1401 uzder(1,3,2)= dc_norm(2,i)
1402 uzder(2,3,2)=-dc_norm(1,i)
1404 C Compute the Y-axis
1406 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1409 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1410 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1411 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1413 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1416 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1417 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1420 c write (iout,*) 'facy',facy,
1421 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1422 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1424 uy(k,i)=facy*uy(k,i)
1426 C Compute the derivatives of uy
1429 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1430 & -dc_norm(k,i)*dc_norm(j,i-1)
1431 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1433 c uyder(j,j,1)=uyder(j,j,1)-costh
1434 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1435 uyder(j,j,1)=uyder(j,j,1)
1436 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1437 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1443 uygrad(l,k,j,i)=uyder(l,k,j)
1444 uzgrad(l,k,j,i)=uzder(l,k,j)
1448 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1449 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1450 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1451 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1454 C Compute the Z-axis
1455 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1456 costh=dcos(pi-theta(i+2))
1457 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1458 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1462 C Compute the derivatives of uz
1464 uzder(2,1,1)=-dc_norm(3,i+1)
1465 uzder(3,1,1)= dc_norm(2,i+1)
1466 uzder(1,2,1)= dc_norm(3,i+1)
1468 uzder(3,2,1)=-dc_norm(1,i+1)
1469 uzder(1,3,1)=-dc_norm(2,i+1)
1470 uzder(2,3,1)= dc_norm(1,i+1)
1473 uzder(2,1,2)= dc_norm(3,i)
1474 uzder(3,1,2)=-dc_norm(2,i)
1475 uzder(1,2,2)=-dc_norm(3,i)
1477 uzder(3,2,2)= dc_norm(1,i)
1478 uzder(1,3,2)= dc_norm(2,i)
1479 uzder(2,3,2)=-dc_norm(1,i)
1481 C Compute the Y-axis
1483 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1484 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1485 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1487 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1490 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1491 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1494 c write (iout,*) 'facy',facy,
1495 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1496 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1498 uy(k,i)=facy*uy(k,i)
1500 C Compute the derivatives of uy
1503 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1504 & -dc_norm(k,i)*dc_norm(j,i+1)
1505 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1507 c uyder(j,j,1)=uyder(j,j,1)-costh
1508 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1509 uyder(j,j,1)=uyder(j,j,1)
1510 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1511 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1517 uygrad(l,k,j,i)=uyder(l,k,j)
1518 uzgrad(l,k,j,i)=uzder(l,k,j)
1522 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1523 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1524 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1525 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1532 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1533 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1540 C-----------------------------------------------------------------------------
1541 subroutine check_vecgrad
1542 implicit real*8 (a-h,o-z)
1543 include 'DIMENSIONS'
1544 include 'sizesclu.dat'
1545 include 'COMMON.IOUNITS'
1546 include 'COMMON.GEO'
1547 include 'COMMON.VAR'
1548 include 'COMMON.LOCAL'
1549 include 'COMMON.CHAIN'
1550 include 'COMMON.VECTORS'
1551 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1552 dimension uyt(3,maxres),uzt(3,maxres)
1553 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1554 double precision delta /1.0d-7/
1557 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1558 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1559 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1560 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1561 cd & (dc_norm(if90,i),if90=1,3)
1562 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1563 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1564 cd write(iout,'(a)')
1570 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1571 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1584 cd write (iout,*) 'i=',i
1586 erij(k)=dc_norm(k,i)
1590 dc_norm(k,i)=erij(k)
1592 dc_norm(j,i)=dc_norm(j,i)+delta
1593 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1595 c dc_norm(k,i)=dc_norm(k,i)/fac
1597 c write (iout,*) (dc_norm(k,i),k=1,3)
1598 c write (iout,*) (erij(k),k=1,3)
1601 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1602 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1603 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1604 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1606 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1607 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1608 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1611 dc_norm(k,i)=erij(k)
1614 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1615 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1616 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1617 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1618 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1619 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1620 cd write (iout,'(a)')
1625 C--------------------------------------------------------------------------
1626 subroutine set_matrices
1627 implicit real*8 (a-h,o-z)
1628 include 'DIMENSIONS'
1629 include 'sizesclu.dat'
1630 include 'COMMON.IOUNITS'
1631 include 'COMMON.GEO'
1632 include 'COMMON.VAR'
1633 include 'COMMON.LOCAL'
1634 include 'COMMON.CHAIN'
1635 include 'COMMON.DERIV'
1636 include 'COMMON.INTERACT'
1637 include 'COMMON.CONTACTS'
1638 include 'COMMON.TORSION'
1639 include 'COMMON.VECTORS'
1640 include 'COMMON.FFIELD'
1641 double precision auxvec(2),auxmat(2,2)
1643 C Compute the virtual-bond-torsional-angle dependent quantities needed
1644 C to calculate the el-loc multibody terms of various order.
1647 if (i .lt. nres+1) then
1684 if (i .gt. 3 .and. i .lt. nres+1) then
1685 obrot_der(1,i-2)=-sin1
1686 obrot_der(2,i-2)= cos1
1687 Ugder(1,1,i-2)= sin1
1688 Ugder(1,2,i-2)=-cos1
1689 Ugder(2,1,i-2)=-cos1
1690 Ugder(2,2,i-2)=-sin1
1693 obrot2_der(1,i-2)=-dwasin2
1694 obrot2_der(2,i-2)= dwacos2
1695 Ug2der(1,1,i-2)= dwasin2
1696 Ug2der(1,2,i-2)=-dwacos2
1697 Ug2der(2,1,i-2)=-dwacos2
1698 Ug2der(2,2,i-2)=-dwasin2
1700 obrot_der(1,i-2)=0.0d0
1701 obrot_der(2,i-2)=0.0d0
1702 Ugder(1,1,i-2)=0.0d0
1703 Ugder(1,2,i-2)=0.0d0
1704 Ugder(2,1,i-2)=0.0d0
1705 Ugder(2,2,i-2)=0.0d0
1706 obrot2_der(1,i-2)=0.0d0
1707 obrot2_der(2,i-2)=0.0d0
1708 Ug2der(1,1,i-2)=0.0d0
1709 Ug2der(1,2,i-2)=0.0d0
1710 Ug2der(2,1,i-2)=0.0d0
1711 Ug2der(2,2,i-2)=0.0d0
1713 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1714 if (itype(i-2).le.ntyp) then
1715 iti = itortyp(itype(i-2))
1722 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1723 if (itype(i-1).le.ntyp) then
1724 iti1 = itortyp(itype(i-1))
1731 cd write (iout,*) '*******i',i,' iti1',iti
1732 cd write (iout,*) 'b1',b1(:,iti)
1733 cd write (iout,*) 'b2',b2(:,iti)
1734 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1735 c print *,"itilde1 i iti iti1",i,iti,iti1
1736 if (i .gt. iatel_s+2) then
1737 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1738 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1739 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1740 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1741 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1742 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1743 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1753 DtUg2(l,k,i-2)=0.0d0
1757 c print *,"itilde2 i iti iti1",i,iti,iti1
1758 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1759 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1760 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1761 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1762 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1763 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1764 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1765 c print *,"itilde3 i iti iti1",i,iti,iti1
1767 muder(k,i-2)=Ub2der(k,i-2)
1769 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1770 if (itype(i-1).le.ntyp) then
1771 iti1 = itortyp(itype(i-1))
1779 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1781 C Vectors and matrices dependent on a single virtual-bond dihedral.
1782 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1783 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1784 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1785 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1786 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1787 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1788 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1789 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1790 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1791 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1792 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1794 C Matrices dependent on two consecutive virtual-bond dihedrals.
1795 C The order of matrices is from left to right.
1797 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1798 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1799 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1800 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1801 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1802 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1803 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1804 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1807 cd iti = itortyp(itype(i))
1810 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1811 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1816 C--------------------------------------------------------------------------
1817 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1819 C This subroutine calculates the average interaction energy and its gradient
1820 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1821 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1822 C The potential depends both on the distance of peptide-group centers and on
1823 C the orientation of the CA-CA virtual bonds.
1825 implicit real*8 (a-h,o-z)
1826 include 'DIMENSIONS'
1827 include 'sizesclu.dat'
1828 include 'COMMON.CONTROL'
1829 include 'COMMON.IOUNITS'
1830 include 'COMMON.GEO'
1831 include 'COMMON.VAR'
1832 include 'COMMON.LOCAL'
1833 include 'COMMON.CHAIN'
1834 include 'COMMON.DERIV'
1835 include 'COMMON.INTERACT'
1836 include 'COMMON.CONTACTS'
1837 include 'COMMON.TORSION'
1838 include 'COMMON.VECTORS'
1839 include 'COMMON.FFIELD'
1840 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1841 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1842 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1843 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1844 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1845 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1846 double precision scal_el /0.5d0/
1848 C 13-go grudnia roku pamietnego...
1849 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1850 & 0.0d0,1.0d0,0.0d0,
1851 & 0.0d0,0.0d0,1.0d0/
1852 cd write(iout,*) 'In EELEC'
1854 cd write(iout,*) 'Type',i
1855 cd write(iout,*) 'B1',B1(:,i)
1856 cd write(iout,*) 'B2',B2(:,i)
1857 cd write(iout,*) 'CC',CC(:,:,i)
1858 cd write(iout,*) 'DD',DD(:,:,i)
1859 cd write(iout,*) 'EE',EE(:,:,i)
1861 cd call check_vecgrad
1863 if (icheckgrad.eq.1) then
1865 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1867 dc_norm(k,i)=dc(k,i)*fac
1869 c write (iout,*) 'i',i,' fac',fac
1872 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1873 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1874 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1875 cd if (wel_loc.gt.0.0d0) then
1876 if (icheckgrad.eq.1) then
1877 call vec_and_deriv_test
1884 cd write (iout,*) 'i=',i
1886 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1889 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1890 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1903 cd print '(a)','Enter EELEC'
1904 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1906 gel_loc_loc(i)=0.0d0
1909 do i=iatel_s,iatel_e
1911 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
1912 & .or. itype(i+2).eq.ntyp1) cycle
1914 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1915 & .or. itype(i+2).eq.ntyp1
1916 & .or. itype(i-1).eq.ntyp1
1919 if (itel(i).eq.0) goto 1215
1923 dx_normi=dc_norm(1,i)
1924 dy_normi=dc_norm(2,i)
1925 dz_normi=dc_norm(3,i)
1926 xmedi=c(1,i)+0.5d0*dxi
1927 ymedi=c(2,i)+0.5d0*dyi
1928 zmedi=c(3,i)+0.5d0*dzi
1929 xmedi=mod(xmedi,boxxsize)
1930 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1931 ymedi=mod(ymedi,boxysize)
1932 if (ymedi.lt.0) ymedi=ymedi+boxysize
1933 zmedi=mod(zmedi,boxzsize)
1934 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1936 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1937 do j=ielstart(i),ielend(i)
1939 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1940 & .or.itype(j+2).eq.ntyp1
1943 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1944 & .or.itype(j+2).eq.ntyp1
1945 & .or.itype(j-1).eq.ntyp1
1948 if (itel(j).eq.0) goto 1216
1952 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1953 aaa=app(iteli,itelj)
1954 bbb=bpp(iteli,itelj)
1955 C Diagnostics only!!!
1961 ael6i=ael6(iteli,itelj)
1962 ael3i=ael3(iteli,itelj)
1966 dx_normj=dc_norm(1,j)
1967 dy_normj=dc_norm(2,j)
1968 dz_normj=dc_norm(3,j)
1973 if (xj.lt.0) xj=xj+boxxsize
1975 if (yj.lt.0) yj=yj+boxysize
1977 if (zj.lt.0) zj=zj+boxzsize
1978 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1986 xj=xj_safe+xshift*boxxsize
1987 yj=yj_safe+yshift*boxysize
1988 zj=zj_safe+zshift*boxzsize
1989 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1990 if(dist_temp.lt.dist_init) then
2000 if (isubchap.eq.1) then
2010 rij=xj*xj+yj*yj+zj*zj
2011 sss=sscale(sqrt(rij))
2012 sssgrad=sscagrad(sqrt(rij))
2018 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2019 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2020 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2021 fac=cosa-3.0D0*cosb*cosg
2023 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2024 if (j.eq.i+2) ev1=scal_el*ev1
2029 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2032 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2033 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2034 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2036 evdw1=evdw1+evdwij*sss
2037 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2038 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2039 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2040 cd & xmedi,ymedi,zmedi,xj,yj,zj
2042 C Calculate contributions to the Cartesian gradient.
2045 facvdw=-6*rrmij*(ev1+evdwij)*sss
2046 facel=-3*rrmij*(el1+eesij)
2053 * Radial derivatives. First process both termini of the fragment (i,j)
2060 gelc(k,i)=gelc(k,i)+ghalf
2061 gelc(k,j)=gelc(k,j)+ghalf
2064 * Loop over residues i+1 thru j-1.
2068 gelc(l,k)=gelc(l,k)+ggg(l)
2074 if (sss.gt.0.0) then
2075 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2076 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2077 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2085 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2086 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2089 * Loop over residues i+1 thru j-1.
2093 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2097 facvdw=(ev1+evdwij)*sss
2100 fac=-3*rrmij*(facvdw+facvdw+facel)
2106 * Radial derivatives. First process both termini of the fragment (i,j)
2113 gelc(k,i)=gelc(k,i)+ghalf
2114 gelc(k,j)=gelc(k,j)+ghalf
2117 * Loop over residues i+1 thru j-1.
2121 gelc(l,k)=gelc(l,k)+ggg(l)
2128 ecosa=2.0D0*fac3*fac1+fac4
2131 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2132 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2134 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2135 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2137 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2138 cd & (dcosg(k),k=1,3)
2140 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2144 gelc(k,i)=gelc(k,i)+ghalf
2145 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2146 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2147 gelc(k,j)=gelc(k,j)+ghalf
2148 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2149 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2153 gelc(l,k)=gelc(l,k)+ggg(l)
2158 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2159 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2160 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2162 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2163 C energy of a peptide unit is assumed in the form of a second-order
2164 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2165 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2166 C are computed for EVERY pair of non-contiguous peptide groups.
2168 if (j.lt.nres-1) then
2179 muij(kkk)=mu(k,i)*mu(l,j)
2182 cd write (iout,*) 'EELEC: i',i,' j',j
2183 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2184 cd write(iout,*) 'muij',muij
2185 ury=scalar(uy(1,i),erij)
2186 urz=scalar(uz(1,i),erij)
2187 vry=scalar(uy(1,j),erij)
2188 vrz=scalar(uz(1,j),erij)
2189 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2190 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2191 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2192 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2193 C For diagnostics only
2198 fac=dsqrt(-ael6i)*r3ij
2199 cd write (2,*) 'fac=',fac
2200 C For diagnostics only
2206 cd write (iout,'(4i5,4f10.5)')
2207 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2208 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2209 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2210 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2211 cd write (iout,'(4f10.5)')
2212 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2213 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2214 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2215 cd write (iout,'(2i3,9f10.5/)') i,j,
2216 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2218 C Derivatives of the elements of A in virtual-bond vectors
2219 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2226 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2227 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2228 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2229 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2230 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2231 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2232 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2233 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2234 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2235 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2236 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2237 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2247 C Compute radial contributions to the gradient
2269 C Add the contributions coming from er
2272 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2273 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2274 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2275 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2278 C Derivatives in DC(i)
2279 ghalf1=0.5d0*agg(k,1)
2280 ghalf2=0.5d0*agg(k,2)
2281 ghalf3=0.5d0*agg(k,3)
2282 ghalf4=0.5d0*agg(k,4)
2283 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2284 & -3.0d0*uryg(k,2)*vry)+ghalf1
2285 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2286 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2287 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2288 & -3.0d0*urzg(k,2)*vry)+ghalf3
2289 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2290 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2291 C Derivatives in DC(i+1)
2292 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2293 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2294 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2295 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2296 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2297 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2298 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2299 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2300 C Derivatives in DC(j)
2301 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2302 & -3.0d0*vryg(k,2)*ury)+ghalf1
2303 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2304 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2305 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2306 & -3.0d0*vryg(k,2)*urz)+ghalf3
2307 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2308 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2309 C Derivatives in DC(j+1) or DC(nres-1)
2310 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2311 & -3.0d0*vryg(k,3)*ury)
2312 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2313 & -3.0d0*vrzg(k,3)*ury)
2314 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2315 & -3.0d0*vryg(k,3)*urz)
2316 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2317 & -3.0d0*vrzg(k,3)*urz)
2322 C Derivatives in DC(i+1)
2323 cd aggi1(k,1)=agg(k,1)
2324 cd aggi1(k,2)=agg(k,2)
2325 cd aggi1(k,3)=agg(k,3)
2326 cd aggi1(k,4)=agg(k,4)
2327 C Derivatives in DC(j)
2332 C Derivatives in DC(j+1)
2337 if (j.eq.nres-1 .and. i.lt.j-2) then
2339 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2340 cd aggj1(k,l)=agg(k,l)
2346 C Check the loc-el terms by numerical integration
2356 aggi(k,l)=-aggi(k,l)
2357 aggi1(k,l)=-aggi1(k,l)
2358 aggj(k,l)=-aggj(k,l)
2359 aggj1(k,l)=-aggj1(k,l)
2362 if (j.lt.nres-1) then
2368 aggi(k,l)=-aggi(k,l)
2369 aggi1(k,l)=-aggi1(k,l)
2370 aggj(k,l)=-aggj(k,l)
2371 aggj1(k,l)=-aggj1(k,l)
2382 aggi(k,l)=-aggi(k,l)
2383 aggi1(k,l)=-aggi1(k,l)
2384 aggj(k,l)=-aggj(k,l)
2385 aggj1(k,l)=-aggj1(k,l)
2391 IF (wel_loc.gt.0.0d0) THEN
2392 C Contribution to the local-electrostatic energy coming from the i-j pair
2393 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2395 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2396 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2397 eel_loc=eel_loc+eel_loc_ij
2398 C Partial derivatives in virtual-bond dihedral angles gamma
2401 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2402 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2403 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2404 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2405 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2406 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2407 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2408 cd write(iout,*) 'agg ',agg
2409 cd write(iout,*) 'aggi ',aggi
2410 cd write(iout,*) 'aggi1',aggi1
2411 cd write(iout,*) 'aggj ',aggj
2412 cd write(iout,*) 'aggj1',aggj1
2414 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2416 ggg(l)=agg(l,1)*muij(1)+
2417 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2421 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2424 C Remaining derivatives of eello
2426 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2427 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2428 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2429 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2430 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2431 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2432 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2433 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2437 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2438 C Contributions from turns
2443 call eturn34(i,j,eello_turn3,eello_turn4)
2445 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2446 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2448 C Calculate the contact function. The ith column of the array JCONT will
2449 C contain the numbers of atoms that make contacts with the atom I (of numbers
2450 C greater than I). The arrays FACONT and GACONT will contain the values of
2451 C the contact function and its derivative.
2452 c r0ij=1.02D0*rpp(iteli,itelj)
2453 c r0ij=1.11D0*rpp(iteli,itelj)
2454 r0ij=2.20D0*rpp(iteli,itelj)
2455 c r0ij=1.55D0*rpp(iteli,itelj)
2456 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2457 if (fcont.gt.0.0D0) then
2458 num_conti=num_conti+1
2459 if (num_conti.gt.maxconts) then
2460 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2461 & ' will skip next contacts for this conf.'
2463 jcont_hb(num_conti,i)=j
2464 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2465 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2466 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2468 d_cont(num_conti,i)=rij
2469 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2470 C --- Electrostatic-interaction matrix ---
2471 a_chuj(1,1,num_conti,i)=a22
2472 a_chuj(1,2,num_conti,i)=a23
2473 a_chuj(2,1,num_conti,i)=a32
2474 a_chuj(2,2,num_conti,i)=a33
2475 C --- Gradient of rij
2477 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2480 c a_chuj(1,1,num_conti,i)=-0.61d0
2481 c a_chuj(1,2,num_conti,i)= 0.4d0
2482 c a_chuj(2,1,num_conti,i)= 0.65d0
2483 c a_chuj(2,2,num_conti,i)= 0.50d0
2484 c else if (i.eq.2) then
2485 c a_chuj(1,1,num_conti,i)= 0.0d0
2486 c a_chuj(1,2,num_conti,i)= 0.0d0
2487 c a_chuj(2,1,num_conti,i)= 0.0d0
2488 c a_chuj(2,2,num_conti,i)= 0.0d0
2490 C --- and its gradients
2491 cd write (iout,*) 'i',i,' j',j
2493 cd write (iout,*) 'iii 1 kkk',kkk
2494 cd write (iout,*) agg(kkk,:)
2497 cd write (iout,*) 'iii 2 kkk',kkk
2498 cd write (iout,*) aggi(kkk,:)
2501 cd write (iout,*) 'iii 3 kkk',kkk
2502 cd write (iout,*) aggi1(kkk,:)
2505 cd write (iout,*) 'iii 4 kkk',kkk
2506 cd write (iout,*) aggj(kkk,:)
2509 cd write (iout,*) 'iii 5 kkk',kkk
2510 cd write (iout,*) aggj1(kkk,:)
2517 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2518 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2519 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2520 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2521 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2523 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2529 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2530 C Calculate contact energies
2532 wij=cosa-3.0D0*cosb*cosg
2535 c fac3=dsqrt(-ael6i)/r0ij**3
2536 fac3=dsqrt(-ael6i)*r3ij
2537 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2538 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2540 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2541 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2542 C Diagnostics. Comment out or remove after debugging!
2543 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2544 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2545 c ees0m(num_conti,i)=0.0D0
2547 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2548 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2549 facont_hb(num_conti,i)=fcont
2551 C Angular derivatives of the contact function
2552 ees0pij1=fac3/ees0pij
2553 ees0mij1=fac3/ees0mij
2554 fac3p=-3.0D0*fac3*rrmij
2555 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2556 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2558 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2559 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2560 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2561 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2562 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2563 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2564 ecosap=ecosa1+ecosa2
2565 ecosbp=ecosb1+ecosb2
2566 ecosgp=ecosg1+ecosg2
2567 ecosam=ecosa1-ecosa2
2568 ecosbm=ecosb1-ecosb2
2569 ecosgm=ecosg1-ecosg2
2578 fprimcont=fprimcont/rij
2579 cd facont_hb(num_conti,i)=1.0D0
2580 C Following line is for diagnostics.
2583 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2584 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2587 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2588 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2590 gggp(1)=gggp(1)+ees0pijp*xj
2591 gggp(2)=gggp(2)+ees0pijp*yj
2592 gggp(3)=gggp(3)+ees0pijp*zj
2593 gggm(1)=gggm(1)+ees0mijp*xj
2594 gggm(2)=gggm(2)+ees0mijp*yj
2595 gggm(3)=gggm(3)+ees0mijp*zj
2596 C Derivatives due to the contact function
2597 gacont_hbr(1,num_conti,i)=fprimcont*xj
2598 gacont_hbr(2,num_conti,i)=fprimcont*yj
2599 gacont_hbr(3,num_conti,i)=fprimcont*zj
2601 ghalfp=0.5D0*gggp(k)
2602 ghalfm=0.5D0*gggm(k)
2603 gacontp_hb1(k,num_conti,i)=ghalfp
2604 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2605 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2606 gacontp_hb2(k,num_conti,i)=ghalfp
2607 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2608 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2609 gacontp_hb3(k,num_conti,i)=gggp(k)
2610 gacontm_hb1(k,num_conti,i)=ghalfm
2611 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2612 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2613 gacontm_hb2(k,num_conti,i)=ghalfm
2614 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2615 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2616 gacontm_hb3(k,num_conti,i)=gggm(k)
2619 C Diagnostics. Comment out or remove after debugging!
2621 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2622 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2623 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2624 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2625 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2626 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2629 endif ! num_conti.le.maxconts
2634 num_cont_hb(i)=num_conti
2638 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2639 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2641 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2642 ccc eel_loc=eel_loc+eello_turn3
2645 C-----------------------------------------------------------------------------
2646 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2647 C Third- and fourth-order contributions from turns
2648 implicit real*8 (a-h,o-z)
2649 include 'DIMENSIONS'
2650 include 'sizesclu.dat'
2651 include 'COMMON.IOUNITS'
2652 include 'COMMON.GEO'
2653 include 'COMMON.VAR'
2654 include 'COMMON.LOCAL'
2655 include 'COMMON.CHAIN'
2656 include 'COMMON.DERIV'
2657 include 'COMMON.INTERACT'
2658 include 'COMMON.CONTACTS'
2659 include 'COMMON.TORSION'
2660 include 'COMMON.VECTORS'
2661 include 'COMMON.FFIELD'
2663 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2664 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2665 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2666 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2667 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2668 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2670 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2672 C Third-order contributions
2679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2680 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2681 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2682 call transpose2(auxmat(1,1),auxmat1(1,1))
2683 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2684 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2685 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2686 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2687 cd & ' eello_turn3_num',4*eello_turn3_num
2689 C Derivatives in gamma(i)
2690 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2691 call transpose2(auxmat2(1,1),pizda(1,1))
2692 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2693 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2694 C Derivatives in gamma(i+1)
2695 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2696 call transpose2(auxmat2(1,1),pizda(1,1))
2697 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2698 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2699 & +0.5d0*(pizda(1,1)+pizda(2,2))
2700 C Cartesian derivatives
2702 a_temp(1,1)=aggi(l,1)
2703 a_temp(1,2)=aggi(l,2)
2704 a_temp(2,1)=aggi(l,3)
2705 a_temp(2,2)=aggi(l,4)
2706 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2707 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2708 & +0.5d0*(pizda(1,1)+pizda(2,2))
2709 a_temp(1,1)=aggi1(l,1)
2710 a_temp(1,2)=aggi1(l,2)
2711 a_temp(2,1)=aggi1(l,3)
2712 a_temp(2,2)=aggi1(l,4)
2713 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2714 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2715 & +0.5d0*(pizda(1,1)+pizda(2,2))
2716 a_temp(1,1)=aggj(l,1)
2717 a_temp(1,2)=aggj(l,2)
2718 a_temp(2,1)=aggj(l,3)
2719 a_temp(2,2)=aggj(l,4)
2720 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2721 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2722 & +0.5d0*(pizda(1,1)+pizda(2,2))
2723 a_temp(1,1)=aggj1(l,1)
2724 a_temp(1,2)=aggj1(l,2)
2725 a_temp(2,1)=aggj1(l,3)
2726 a_temp(2,2)=aggj1(l,4)
2727 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2728 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2729 & +0.5d0*(pizda(1,1)+pizda(2,2))
2732 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2733 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2735 C Fourth-order contributions
2743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2744 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2745 iti1=itortyp(itype(i+1))
2746 iti2=itortyp(itype(i+2))
2747 iti3=itortyp(itype(i+3))
2748 call transpose2(EUg(1,1,i+1),e1t(1,1))
2749 call transpose2(Eug(1,1,i+2),e2t(1,1))
2750 call transpose2(Eug(1,1,i+3),e3t(1,1))
2751 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2752 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2753 s1=scalar2(b1(1,iti2),auxvec(1))
2754 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2755 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2756 s2=scalar2(b1(1,iti1),auxvec(1))
2757 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2758 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2759 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2760 eello_turn4=eello_turn4-(s1+s2+s3)
2761 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2762 cd & ' eello_turn4_num',8*eello_turn4_num
2763 C Derivatives in gamma(i)
2765 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2766 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2767 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2768 s1=scalar2(b1(1,iti2),auxvec(1))
2769 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2770 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2771 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2772 C Derivatives in gamma(i+1)
2773 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2774 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2775 s2=scalar2(b1(1,iti1),auxvec(1))
2776 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2777 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2779 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2780 C Derivatives in gamma(i+2)
2781 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2782 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2783 s1=scalar2(b1(1,iti2),auxvec(1))
2784 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2785 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2786 s2=scalar2(b1(1,iti1),auxvec(1))
2787 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2788 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2790 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2791 C Cartesian derivatives
2792 C Derivatives of this turn contributions in DC(i+2)
2793 if (j.lt.nres-1) then
2795 a_temp(1,1)=agg(l,1)
2796 a_temp(1,2)=agg(l,2)
2797 a_temp(2,1)=agg(l,3)
2798 a_temp(2,2)=agg(l,4)
2799 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2800 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2801 s1=scalar2(b1(1,iti2),auxvec(1))
2802 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2803 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2804 s2=scalar2(b1(1,iti1),auxvec(1))
2805 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2806 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2807 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2809 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2812 C Remaining derivatives of this turn contribution
2814 a_temp(1,1)=aggi(l,1)
2815 a_temp(1,2)=aggi(l,2)
2816 a_temp(2,1)=aggi(l,3)
2817 a_temp(2,2)=aggi(l,4)
2818 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2819 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2820 s1=scalar2(b1(1,iti2),auxvec(1))
2821 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2822 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2823 s2=scalar2(b1(1,iti1),auxvec(1))
2824 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2825 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2826 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2827 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2828 a_temp(1,1)=aggi1(l,1)
2829 a_temp(1,2)=aggi1(l,2)
2830 a_temp(2,1)=aggi1(l,3)
2831 a_temp(2,2)=aggi1(l,4)
2832 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2833 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2834 s1=scalar2(b1(1,iti2),auxvec(1))
2835 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2836 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2837 s2=scalar2(b1(1,iti1),auxvec(1))
2838 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2839 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2840 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2841 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2842 a_temp(1,1)=aggj(l,1)
2843 a_temp(1,2)=aggj(l,2)
2844 a_temp(2,1)=aggj(l,3)
2845 a_temp(2,2)=aggj(l,4)
2846 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2847 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2848 s1=scalar2(b1(1,iti2),auxvec(1))
2849 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2850 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2851 s2=scalar2(b1(1,iti1),auxvec(1))
2852 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2853 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2854 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2855 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2856 a_temp(1,1)=aggj1(l,1)
2857 a_temp(1,2)=aggj1(l,2)
2858 a_temp(2,1)=aggj1(l,3)
2859 a_temp(2,2)=aggj1(l,4)
2860 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2861 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2862 s1=scalar2(b1(1,iti2),auxvec(1))
2863 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2864 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2865 s2=scalar2(b1(1,iti1),auxvec(1))
2866 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2867 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2868 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2869 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2875 C-----------------------------------------------------------------------------
2876 subroutine vecpr(u,v,w)
2877 implicit real*8(a-h,o-z)
2878 dimension u(3),v(3),w(3)
2879 w(1)=u(2)*v(3)-u(3)*v(2)
2880 w(2)=-u(1)*v(3)+u(3)*v(1)
2881 w(3)=u(1)*v(2)-u(2)*v(1)
2884 C-----------------------------------------------------------------------------
2885 subroutine unormderiv(u,ugrad,unorm,ungrad)
2886 C This subroutine computes the derivatives of a normalized vector u, given
2887 C the derivatives computed without normalization conditions, ugrad. Returns
2890 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2891 double precision vec(3)
2892 double precision scalar
2894 c write (2,*) 'ugrad',ugrad
2897 vec(i)=scalar(ugrad(1,i),u(1))
2899 c write (2,*) 'vec',vec
2902 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2905 c write (2,*) 'ungrad',ungrad
2908 C-----------------------------------------------------------------------------
2909 subroutine escp(evdw2,evdw2_14)
2911 C This subroutine calculates the excluded-volume interaction energy between
2912 C peptide-group centers and side chains and its gradient in virtual-bond and
2913 C side-chain vectors.
2915 implicit real*8 (a-h,o-z)
2916 include 'DIMENSIONS'
2917 include 'sizesclu.dat'
2918 include 'COMMON.GEO'
2919 include 'COMMON.VAR'
2920 include 'COMMON.LOCAL'
2921 include 'COMMON.CHAIN'
2922 include 'COMMON.DERIV'
2923 include 'COMMON.INTERACT'
2924 include 'COMMON.FFIELD'
2925 include 'COMMON.IOUNITS'
2929 cd print '(a)','Enter ESCP'
2930 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2931 c & ' scal14',scal14
2932 do i=iatscp_s,iatscp_e
2933 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2935 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2936 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2937 if (iteli.eq.0) goto 1225
2938 xi=0.5D0*(c(1,i)+c(1,i+1))
2939 yi=0.5D0*(c(2,i)+c(2,i+1))
2940 zi=0.5D0*(c(3,i)+c(3,i+1))
2941 C Returning the ith atom to box
2943 if (xi.lt.0) xi=xi+boxxsize
2945 if (yi.lt.0) yi=yi+boxysize
2947 if (zi.lt.0) zi=zi+boxzsize
2949 do iint=1,nscp_gr(i)
2951 do j=iscpstart(i,iint),iscpend(i,iint)
2952 itypj=iabs(itype(j))
2953 if (itypj.eq.ntyp1) cycle
2954 C Uncomment following three lines for SC-p interactions
2958 C Uncomment following three lines for Ca-p interactions
2962 C returning the jth atom to box
2964 if (xj.lt.0) xj=xj+boxxsize
2966 if (yj.lt.0) yj=yj+boxysize
2968 if (zj.lt.0) zj=zj+boxzsize
2969 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2974 C Finding the closest jth atom
2978 xj=xj_safe+xshift*boxxsize
2979 yj=yj_safe+yshift*boxysize
2980 zj=zj_safe+zshift*boxzsize
2981 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2982 if(dist_temp.lt.dist_init) then
2992 if (subchap.eq.1) then
3002 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3003 C sss is scaling function for smoothing the cutoff gradient otherwise
3004 C the gradient would not be continuouse
3005 sss=sscale(1.0d0/(dsqrt(rrij)))
3006 if (sss.le.0.0d0) cycle
3007 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3009 e1=fac*fac*aad(itypj,iteli)
3010 e2=fac*bad(itypj,iteli)
3011 if (iabs(j-i) .le. 2) then
3014 evdw2_14=evdw2_14+(e1+e2)*sss
3017 c write (iout,*) i,j,evdwij
3018 evdw2=evdw2+evdwij*sss
3021 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3023 fac=-(evdwij+e1)*rrij*sss
3024 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3029 cd write (iout,*) 'j<i'
3030 C Uncomment following three lines for SC-p interactions
3032 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3035 cd write (iout,*) 'j>i'
3038 C Uncomment following line for SC-p interactions
3039 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3043 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3047 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3048 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3051 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3061 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3062 gradx_scp(j,i)=expon*gradx_scp(j,i)
3065 C******************************************************************************
3069 C To save time the factor EXPON has been extracted from ALL components
3070 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3073 C******************************************************************************
3076 C--------------------------------------------------------------------------
3077 subroutine edis(ehpb)
3079 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3081 implicit real*8 (a-h,o-z)
3082 include 'DIMENSIONS'
3083 include 'sizesclu.dat'
3084 include 'COMMON.SBRIDGE'
3085 include 'COMMON.CHAIN'
3086 include 'COMMON.DERIV'
3087 include 'COMMON.VAR'
3088 include 'COMMON.INTERACT'
3089 include 'COMMON.CONTROL'
3092 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3093 cd print *,'link_start=',link_start,' link_end=',link_end
3094 if (link_end.eq.0) return
3095 do i=link_start,link_end
3096 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3097 C CA-CA distance used in regularization of structure.
3100 C iii and jjj point to the residues for which the distance is assigned.
3101 if (ii.gt.nres) then
3108 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3109 C distance and angle dependent SS bond potential.
3110 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3111 C & iabs(itype(jjj)).eq.1) then
3112 C call ssbond_ene(iii,jjj,eij)
3115 if (.not.dyn_ss .and. i.le.nss) then
3116 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3117 & iabs(itype(jjj)).eq.1) then
3118 call ssbond_ene(iii,jjj,eij)
3121 else if (ii.gt.nres .and. jj.gt.nres) then
3122 c Restraints from contact prediction
3124 if (constr_dist.eq.11) then
3125 C ehpb=ehpb+fordepth(i)**4.0d0
3126 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3127 ehpb=ehpb+fordepth(i)**4.0d0
3128 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3129 fac=fordepth(i)**4.0d0
3130 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3131 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3132 C & ehpb,fordepth(i),dd
3134 C write(iout,*) ehpb,"atu?"
3136 C fac=fordepth(i)**4.0d0
3137 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3138 else !constr_dist.eq.11
3139 if (dhpb1(i).gt.0.0d0) then
3140 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3141 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3142 c write (iout,*) "beta nmr",
3143 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3144 else !dhpb(i).gt.0.00
3146 C Calculate the distance between the two points and its difference from the
3150 C Get the force constant corresponding to this distance.
3152 C Calculate the contribution to energy.
3153 ehpb=ehpb+waga*rdis*rdis
3155 C Evaluate gradient.
3160 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3161 cd & ' waga=',waga,' fac=',fac
3163 ggg(j)=fac*(c(j,jj)-c(j,ii))
3165 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3166 C If this is a SC-SC distance, we need to calculate the contributions to the
3167 C Cartesian gradient in the SC vectors (ghpbx).
3170 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3171 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3175 C write(iout,*) "before"
3177 C write(iout,*) "after",dd
3178 if (constr_dist.eq.11) then
3179 ehpb=ehpb+fordepth(i)**4.0d0
3180 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3181 fac=fordepth(i)**4.0d0
3182 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3183 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3184 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3185 C print *,ehpb,"tu?"
3186 C write(iout,*) ehpb,"btu?",
3187 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3188 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3189 C & ehpb,fordepth(i),dd
3191 if (dhpb1(i).gt.0.0d0) then
3192 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3193 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3194 c write (iout,*) "alph nmr",
3195 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3198 C Get the force constant corresponding to this distance.
3200 C Calculate the contribution to energy.
3201 ehpb=ehpb+waga*rdis*rdis
3202 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3204 C Evaluate gradient.
3210 ggg(j)=fac*(c(j,jj)-c(j,ii))
3212 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3213 C If this is a SC-SC distance, we need to calculate the contributions to the
3214 C Cartesian gradient in the SC vectors (ghpbx).
3217 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3218 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3223 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3228 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3231 C--------------------------------------------------------------------------
3232 subroutine ssbond_ene(i,j,eij)
3234 C Calculate the distance and angle dependent SS-bond potential energy
3235 C using a free-energy function derived based on RHF/6-31G** ab initio
3236 C calculations of diethyl disulfide.
3238 C A. Liwo and U. Kozlowska, 11/24/03
3240 implicit real*8 (a-h,o-z)
3241 include 'DIMENSIONS'
3242 include 'sizesclu.dat'
3243 include 'COMMON.SBRIDGE'
3244 include 'COMMON.CHAIN'
3245 include 'COMMON.DERIV'
3246 include 'COMMON.LOCAL'
3247 include 'COMMON.INTERACT'
3248 include 'COMMON.VAR'
3249 include 'COMMON.IOUNITS'
3250 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3251 itypi=iabs(itype(i))
3255 dxi=dc_norm(1,nres+i)
3256 dyi=dc_norm(2,nres+i)
3257 dzi=dc_norm(3,nres+i)
3258 dsci_inv=dsc_inv(itypi)
3259 itypj=iabs(itype(j))
3260 dscj_inv=dsc_inv(itypj)
3264 dxj=dc_norm(1,nres+j)
3265 dyj=dc_norm(2,nres+j)
3266 dzj=dc_norm(3,nres+j)
3267 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3272 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3273 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3274 om12=dxi*dxj+dyi*dyj+dzi*dzj
3276 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3277 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3283 deltat12=om2-om1+2.0d0
3285 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3286 & +akct*deltad*deltat12
3287 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3288 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3289 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3290 c & " deltat12",deltat12," eij",eij
3291 ed=2*akcm*deltad+akct*deltat12
3293 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3294 eom1=-2*akth*deltat1-pom1-om2*pom2
3295 eom2= 2*akth*deltat2+pom1-om1*pom2
3298 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3301 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3302 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3303 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3304 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3307 C Calculate the components of the gradient in DC and X
3311 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3316 C--------------------------------------------------------------------------
3317 subroutine ebond(estr)
3319 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3321 implicit real*8 (a-h,o-z)
3322 include 'DIMENSIONS'
3323 include 'sizesclu.dat'
3324 include 'COMMON.LOCAL'
3325 include 'COMMON.GEO'
3326 include 'COMMON.INTERACT'
3327 include 'COMMON.DERIV'
3328 include 'COMMON.VAR'
3329 include 'COMMON.CHAIN'
3330 include 'COMMON.IOUNITS'
3331 include 'COMMON.NAMES'
3332 include 'COMMON.FFIELD'
3333 include 'COMMON.CONTROL'
3334 logical energy_dec /.false./
3335 double precision u(3),ud(3)
3339 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3340 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3342 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3343 C & *dc(j,i-1)/vbld(i)
3345 C if (energy_dec) write(iout,*)
3346 C & "estr1",i,vbld(i),distchainmax,
3347 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3349 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3350 diff = vbld(i)-vbldpDUM
3352 diff = vbld(i)-vbldp0
3353 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3357 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3360 C write (iout,'(a7,i5,4f7.3)')
3361 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3363 estr=0.5d0*AKP*estr+estr1
3365 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3369 if (iti.ne.10 .and. iti.ne.ntyp1) then
3372 diff=vbld(i+nres)-vbldsc0(1,iti)
3373 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3374 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3375 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3377 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3381 diff=vbld(i+nres)-vbldsc0(j,iti)
3382 ud(j)=aksc(j,iti)*diff
3383 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3397 uprod2=uprod2*u(k)*u(k)
3401 usumsqder=usumsqder+ud(j)*uprod2
3403 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3404 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3405 estr=estr+uprod/usum
3407 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3415 C--------------------------------------------------------------------------
3416 subroutine ebend(etheta,ethetacnstr)
3418 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3419 C angles gamma and its derivatives in consecutive thetas and gammas.
3421 implicit real*8 (a-h,o-z)
3422 include 'DIMENSIONS'
3423 include 'sizesclu.dat'
3424 include 'COMMON.LOCAL'
3425 include 'COMMON.GEO'
3426 include 'COMMON.INTERACT'
3427 include 'COMMON.DERIV'
3428 include 'COMMON.VAR'
3429 include 'COMMON.CHAIN'
3430 include 'COMMON.IOUNITS'
3431 include 'COMMON.NAMES'
3432 include 'COMMON.FFIELD'
3433 include 'COMMON.TORCNSTR'
3434 common /calcthet/ term1,term2,termm,diffak,ratak,
3435 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3436 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3437 double precision y(2),z(2)
3439 c time11=dexp(-2*time)
3442 c write (iout,*) "nres",nres
3443 c write (*,'(a,i2)') 'EBEND ICG=',icg
3444 c write (iout,*) ithet_start,ithet_end
3445 do i=ithet_start,ithet_end
3447 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3448 & .or.itype(i).eq.ntyp1) cycle
3449 C Zero the energy function and its derivative at 0 or pi.
3450 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3452 ichir1=isign(1,itype(i-2))
3453 ichir2=isign(1,itype(i))
3454 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3455 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3456 if (itype(i-1).eq.10) then
3457 itype1=isign(10,itype(i-2))
3458 ichir11=isign(1,itype(i-2))
3459 ichir12=isign(1,itype(i-2))
3460 itype2=isign(10,itype(i))
3461 ichir21=isign(1,itype(i))
3462 ichir22=isign(1,itype(i))
3468 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3472 c call proc_proc(phii,icrc)
3473 if (icrc.eq.1) phii=150.0
3484 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3488 c call proc_proc(phii1,icrc)
3489 if (icrc.eq.1) phii1=150.0
3501 C Calculate the "mean" value of theta from the part of the distribution
3502 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3503 C In following comments this theta will be referred to as t_c.
3504 thet_pred_mean=0.0d0
3506 athetk=athet(k,it,ichir1,ichir2)
3507 bthetk=bthet(k,it,ichir1,ichir2)
3509 athetk=athet(k,itype1,ichir11,ichir12)
3510 bthetk=bthet(k,itype2,ichir21,ichir22)
3512 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3514 c write (iout,*) "thet_pred_mean",thet_pred_mean
3515 dthett=thet_pred_mean*ssd
3516 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3517 c write (iout,*) "thet_pred_mean",thet_pred_mean
3518 C Derivatives of the "mean" values in gamma1 and gamma2.
3519 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3520 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3521 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3522 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3524 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3525 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3526 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3527 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3529 if (theta(i).gt.pi-delta) then
3530 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3532 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3533 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3534 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3536 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3538 else if (theta(i).lt.delta) then
3539 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3540 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3541 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3543 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3544 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3547 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3550 etheta=etheta+ethetai
3551 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3552 c & rad2deg*phii,rad2deg*phii1,ethetai
3553 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3554 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3555 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3558 C Ufff.... We've done all this!!!
3561 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3562 do i=1,ntheta_constr
3563 itheta=itheta_constr(i)
3564 thetiii=theta(itheta)
3565 difi=pinorm(thetiii-theta_constr0(i))
3566 if (difi.gt.theta_drange(i)) then
3567 difi=difi-theta_drange(i)
3568 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3569 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3570 & +for_thet_constr(i)*difi**3
3571 else if (difi.lt.-drange(i)) then
3573 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3574 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3575 & +for_thet_constr(i)*difi**3
3579 C if (energy_dec) then
3580 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3581 C & i,itheta,rad2deg*thetiii,
3582 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3583 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3584 C & gloc(itheta+nphi-2,icg)
3589 C---------------------------------------------------------------------------
3590 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3592 implicit real*8 (a-h,o-z)
3593 include 'DIMENSIONS'
3594 include 'COMMON.LOCAL'
3595 include 'COMMON.IOUNITS'
3596 common /calcthet/ term1,term2,termm,diffak,ratak,
3597 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3598 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3599 C Calculate the contributions to both Gaussian lobes.
3600 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3601 C The "polynomial part" of the "standard deviation" of this part of
3605 sig=sig*thet_pred_mean+polthet(j,it)
3607 C Derivative of the "interior part" of the "standard deviation of the"
3608 C gamma-dependent Gaussian lobe in t_c.
3609 sigtc=3*polthet(3,it)
3611 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3614 C Set the parameters of both Gaussian lobes of the distribution.
3615 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3616 fac=sig*sig+sigc0(it)
3619 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3620 sigsqtc=-4.0D0*sigcsq*sigtc
3621 c print *,i,sig,sigtc,sigsqtc
3622 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3623 sigtc=-sigtc/(fac*fac)
3624 C Following variable is sigma(t_c)**(-2)
3625 sigcsq=sigcsq*sigcsq
3627 sig0inv=1.0D0/sig0i**2
3628 delthec=thetai-thet_pred_mean
3629 delthe0=thetai-theta0i
3630 term1=-0.5D0*sigcsq*delthec*delthec
3631 term2=-0.5D0*sig0inv*delthe0*delthe0
3632 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3633 C NaNs in taking the logarithm. We extract the largest exponent which is added
3634 C to the energy (this being the log of the distribution) at the end of energy
3635 C term evaluation for this virtual-bond angle.
3636 if (term1.gt.term2) then
3638 term2=dexp(term2-termm)
3642 term1=dexp(term1-termm)
3645 C The ratio between the gamma-independent and gamma-dependent lobes of
3646 C the distribution is a Gaussian function of thet_pred_mean too.
3647 diffak=gthet(2,it)-thet_pred_mean
3648 ratak=diffak/gthet(3,it)**2
3649 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3650 C Let's differentiate it in thet_pred_mean NOW.
3652 C Now put together the distribution terms to make complete distribution.
3653 termexp=term1+ak*term2
3654 termpre=sigc+ak*sig0i
3655 C Contribution of the bending energy from this theta is just the -log of
3656 C the sum of the contributions from the two lobes and the pre-exponential
3657 C factor. Simple enough, isn't it?
3658 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3659 C NOW the derivatives!!!
3660 C 6/6/97 Take into account the deformation.
3661 E_theta=(delthec*sigcsq*term1
3662 & +ak*delthe0*sig0inv*term2)/termexp
3663 E_tc=((sigtc+aktc*sig0i)/termpre
3664 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3665 & aktc*term2)/termexp)
3668 c-----------------------------------------------------------------------------
3669 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3670 implicit real*8 (a-h,o-z)
3671 include 'DIMENSIONS'
3672 include 'COMMON.LOCAL'
3673 include 'COMMON.IOUNITS'
3674 common /calcthet/ term1,term2,termm,diffak,ratak,
3675 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3676 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3677 delthec=thetai-thet_pred_mean
3678 delthe0=thetai-theta0i
3679 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3680 t3 = thetai-thet_pred_mean
3684 t14 = t12+t6*sigsqtc
3686 t21 = thetai-theta0i
3692 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3693 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3694 & *(-t12*t9-ak*sig0inv*t27)
3698 C--------------------------------------------------------------------------
3699 subroutine ebend(etheta,ethetacnstr)
3701 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3702 C angles gamma and its derivatives in consecutive thetas and gammas.
3703 C ab initio-derived potentials from
3704 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3706 implicit real*8 (a-h,o-z)
3707 include 'DIMENSIONS'
3708 include 'sizesclu.dat'
3709 include 'COMMON.LOCAL'
3710 include 'COMMON.GEO'
3711 include 'COMMON.INTERACT'
3712 include 'COMMON.DERIV'
3713 include 'COMMON.VAR'
3714 include 'COMMON.CHAIN'
3715 include 'COMMON.IOUNITS'
3716 include 'COMMON.NAMES'
3717 include 'COMMON.FFIELD'
3718 include 'COMMON.CONTROL'
3719 include 'COMMON.TORCNSTR'
3720 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3721 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3722 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3723 & sinph1ph2(maxdouble,maxdouble)
3724 logical lprn /.false./, lprn1 /.false./
3726 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3727 do i=ithet_start,ithet_end
3729 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3730 & .or.itype(i).eq.ntyp1) cycle
3731 c if (itype(i-1).eq.ntyp1) cycle
3732 if (iabs(itype(i+1)).eq.20) iblock=2
3733 if (iabs(itype(i+1)).ne.20) iblock=1
3737 theti2=0.5d0*theta(i)
3738 ityp2=ithetyp((itype(i-1)))
3740 coskt(k)=dcos(k*theti2)
3741 sinkt(k)=dsin(k*theti2)
3751 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3754 if (phii.ne.phii) phii=150.0
3758 ityp1=ithetyp((itype(i-2)))
3760 cosph1(k)=dcos(k*phii)
3761 sinph1(k)=dsin(k*phii)
3767 ityp1=ithetyp((itype(i-2)))
3773 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3776 if (phii1.ne.phii1) phii1=150.0
3781 ityp3=ithetyp((itype(i)))
3783 cosph2(k)=dcos(k*phii1)
3784 sinph2(k)=dsin(k*phii1)
3789 ityp3=ithetyp((itype(i)))
3795 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3796 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3798 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3801 ccl=cosph1(l)*cosph2(k-l)
3802 ssl=sinph1(l)*sinph2(k-l)
3803 scl=sinph1(l)*cosph2(k-l)
3804 csl=cosph1(l)*sinph2(k-l)
3805 cosph1ph2(l,k)=ccl-ssl
3806 cosph1ph2(k,l)=ccl+ssl
3807 sinph1ph2(l,k)=scl+csl
3808 sinph1ph2(k,l)=scl-csl
3812 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3813 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3814 write (iout,*) "coskt and sinkt"
3816 write (iout,*) k,coskt(k),sinkt(k)
3820 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3821 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3824 & write (iout,*) "k",k," aathet",
3825 & aathet(k,ityp1,ityp2,ityp3,iblock),
3826 & " ethetai",ethetai
3829 write (iout,*) "cosph and sinph"
3831 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3833 write (iout,*) "cosph1ph2 and sinph2ph2"
3836 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3837 & sinph1ph2(l,k),sinph1ph2(k,l)
3840 write(iout,*) "ethetai",ethetai
3844 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3845 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3846 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3847 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3848 ethetai=ethetai+sinkt(m)*aux
3849 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3850 dephii=dephii+k*sinkt(m)*(
3851 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3852 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3853 dephii1=dephii1+k*sinkt(m)*(
3854 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3855 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3857 & write (iout,*) "m",m," k",k," bbthet",
3858 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3859 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3860 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3861 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3865 & write(iout,*) "ethetai",ethetai
3869 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3870 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3871 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3872 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3873 ethetai=ethetai+sinkt(m)*aux
3874 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3875 dephii=dephii+l*sinkt(m)*(
3876 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3877 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3878 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3879 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3880 dephii1=dephii1+(k-l)*sinkt(m)*(
3881 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3882 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3883 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3884 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3886 write (iout,*) "m",m," k",k," l",l," ffthet",
3887 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3888 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3889 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3890 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3891 & " ethetai",ethetai
3892 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3893 & cosph1ph2(k,l)*sinkt(m),
3894 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3900 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3901 & i,theta(i)*rad2deg,phii*rad2deg,
3902 & phii1*rad2deg,ethetai
3903 etheta=etheta+ethetai
3904 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3905 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3906 c gloc(nphi+i-2,icg)=wang*dethetai
3907 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3911 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3912 do i=1,ntheta_constr
3913 itheta=itheta_constr(i)
3914 thetiii=theta(itheta)
3915 difi=pinorm(thetiii-theta_constr0(i))
3916 if (difi.gt.theta_drange(i)) then
3917 difi=difi-theta_drange(i)
3918 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3919 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3920 & +for_thet_constr(i)*difi**3
3921 else if (difi.lt.-drange(i)) then
3923 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3924 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3925 & +for_thet_constr(i)*difi**3
3929 C if (energy_dec) then
3930 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3931 C & i,itheta,rad2deg*thetiii,
3932 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3933 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3934 C & gloc(itheta+nphi-2,icg)
3941 c-----------------------------------------------------------------------------
3942 subroutine esc(escloc)
3943 C Calculate the local energy of a side chain and its derivatives in the
3944 C corresponding virtual-bond valence angles THETA and the spherical angles
3946 implicit real*8 (a-h,o-z)
3947 include 'DIMENSIONS'
3948 include 'sizesclu.dat'
3949 include 'COMMON.GEO'
3950 include 'COMMON.LOCAL'
3951 include 'COMMON.VAR'
3952 include 'COMMON.INTERACT'
3953 include 'COMMON.DERIV'
3954 include 'COMMON.CHAIN'
3955 include 'COMMON.IOUNITS'
3956 include 'COMMON.NAMES'
3957 include 'COMMON.FFIELD'
3958 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3959 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3960 common /sccalc/ time11,time12,time112,theti,it,nlobit
3963 c write (iout,'(a)') 'ESC'
3964 do i=loc_start,loc_end
3966 if (it.eq.ntyp1) cycle
3967 if (it.eq.10) goto 1
3968 nlobit=nlob(iabs(it))
3969 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3970 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3971 theti=theta(i+1)-pipol
3975 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3977 if (x(2).gt.pi-delta) then
3981 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3983 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3984 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3986 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3987 & ddersc0(1),dersc(1))
3988 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3989 & ddersc0(3),dersc(3))
3991 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3993 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3994 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3995 & dersc0(2),esclocbi,dersc02)
3996 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3998 call splinthet(x(2),0.5d0*delta,ss,ssd)
4003 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4005 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4006 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4008 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4010 c write (iout,*) escloci
4011 else if (x(2).lt.delta) then
4015 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4017 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4018 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4020 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4021 & ddersc0(1),dersc(1))
4022 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4023 & ddersc0(3),dersc(3))
4025 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4027 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4028 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4029 & dersc0(2),esclocbi,dersc02)
4030 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4035 call splinthet(x(2),0.5d0*delta,ss,ssd)
4037 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4039 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4040 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4042 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4043 c write (iout,*) escloci
4045 call enesc(x,escloci,dersc,ddummy,.false.)
4048 escloc=escloc+escloci
4049 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4051 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4053 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4054 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4059 C---------------------------------------------------------------------------
4060 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4061 implicit real*8 (a-h,o-z)
4062 include 'DIMENSIONS'
4063 include 'COMMON.GEO'
4064 include 'COMMON.LOCAL'
4065 include 'COMMON.IOUNITS'
4066 common /sccalc/ time11,time12,time112,theti,it,nlobit
4067 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4068 double precision contr(maxlob,-1:1)
4070 c write (iout,*) 'it=',it,' nlobit=',nlobit
4074 if (mixed) ddersc(j)=0.0d0
4078 C Because of periodicity of the dependence of the SC energy in omega we have
4079 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4080 C To avoid underflows, first compute & store the exponents.
4088 z(k)=x(k)-censc(k,j,it)
4093 Axk=Axk+gaussc(l,k,j,it)*z(l)
4099 expfac=expfac+Ax(k,j,iii)*z(k)
4107 C As in the case of ebend, we want to avoid underflows in exponentiation and
4108 C subsequent NaNs and INFs in energy calculation.
4109 C Find the largest exponent
4113 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4117 cd print *,'it=',it,' emin=',emin
4119 C Compute the contribution to SC energy and derivatives
4123 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4124 cd print *,'j=',j,' expfac=',expfac
4125 escloc_i=escloc_i+expfac
4127 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4131 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4132 & +gaussc(k,2,j,it))*expfac
4139 dersc(1)=dersc(1)/cos(theti)**2
4140 ddersc(1)=ddersc(1)/cos(theti)**2
4143 escloci=-(dlog(escloc_i)-emin)
4145 dersc(j)=dersc(j)/escloc_i
4149 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4154 C------------------------------------------------------------------------------
4155 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4156 implicit real*8 (a-h,o-z)
4157 include 'DIMENSIONS'
4158 include 'COMMON.GEO'
4159 include 'COMMON.LOCAL'
4160 include 'COMMON.IOUNITS'
4161 common /sccalc/ time11,time12,time112,theti,it,nlobit
4162 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4163 double precision contr(maxlob)
4174 z(k)=x(k)-censc(k,j,it)
4180 Axk=Axk+gaussc(l,k,j,it)*z(l)
4186 expfac=expfac+Ax(k,j)*z(k)
4191 C As in the case of ebend, we want to avoid underflows in exponentiation and
4192 C subsequent NaNs and INFs in energy calculation.
4193 C Find the largest exponent
4196 if (emin.gt.contr(j)) emin=contr(j)
4200 C Compute the contribution to SC energy and derivatives
4204 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4205 escloc_i=escloc_i+expfac
4207 dersc(k)=dersc(k)+Ax(k,j)*expfac
4209 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4210 & +gaussc(1,2,j,it))*expfac
4214 dersc(1)=dersc(1)/cos(theti)**2
4215 dersc12=dersc12/cos(theti)**2
4216 escloci=-(dlog(escloc_i)-emin)
4218 dersc(j)=dersc(j)/escloc_i
4220 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4224 c----------------------------------------------------------------------------------
4225 subroutine esc(escloc)
4226 C Calculate the local energy of a side chain and its derivatives in the
4227 C corresponding virtual-bond valence angles THETA and the spherical angles
4228 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4229 C added by Urszula Kozlowska. 07/11/2007
4231 implicit real*8 (a-h,o-z)
4232 include 'DIMENSIONS'
4233 include 'sizesclu.dat'
4234 include 'COMMON.GEO'
4235 include 'COMMON.LOCAL'
4236 include 'COMMON.VAR'
4237 include 'COMMON.SCROT'
4238 include 'COMMON.INTERACT'
4239 include 'COMMON.DERIV'
4240 include 'COMMON.CHAIN'
4241 include 'COMMON.IOUNITS'
4242 include 'COMMON.NAMES'
4243 include 'COMMON.FFIELD'
4244 include 'COMMON.CONTROL'
4245 include 'COMMON.VECTORS'
4246 double precision x_prime(3),y_prime(3),z_prime(3)
4247 & , sumene,dsc_i,dp2_i,x(65),
4248 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4249 & de_dxx,de_dyy,de_dzz,de_dt
4250 double precision s1_t,s1_6_t,s2_t,s2_6_t
4252 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4253 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4254 & dt_dCi(3),dt_dCi1(3)
4255 common /sccalc/ time11,time12,time112,theti,it,nlobit
4258 do i=loc_start,loc_end
4259 if (itype(i).eq.ntyp1) cycle
4260 costtab(i+1) =dcos(theta(i+1))
4261 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4262 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4263 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4264 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4265 cosfac=dsqrt(cosfac2)
4266 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4267 sinfac=dsqrt(sinfac2)
4269 if (it.eq.10) goto 1
4271 C Compute the axes of tghe local cartesian coordinates system; store in
4272 c x_prime, y_prime and z_prime
4279 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4280 C & dc_norm(3,i+nres)
4282 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4283 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4286 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4289 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4290 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4291 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4292 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4293 c & " xy",scalar(x_prime(1),y_prime(1)),
4294 c & " xz",scalar(x_prime(1),z_prime(1)),
4295 c & " yy",scalar(y_prime(1),y_prime(1)),
4296 c & " yz",scalar(y_prime(1),z_prime(1)),
4297 c & " zz",scalar(z_prime(1),z_prime(1))
4299 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4300 C to local coordinate system. Store in xx, yy, zz.
4306 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4307 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4308 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4315 C Compute the energy of the ith side cbain
4317 c write (2,*) "xx",xx," yy",yy," zz",zz
4320 x(j) = sc_parmin(j,it)
4323 Cc diagnostics - remove later
4325 yy1 = dsin(alph(2))*dcos(omeg(2))
4326 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4327 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4328 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4329 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4331 C," --- ", xx_w,yy_w,zz_w
4334 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4335 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4337 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4338 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4340 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4341 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4342 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4343 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4344 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4346 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4347 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4348 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4349 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4350 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4352 dsc_i = 0.743d0+x(61)
4354 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4355 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4356 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4357 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4358 s1=(1+x(63))/(0.1d0 + dscp1)
4359 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4360 s2=(1+x(65))/(0.1d0 + dscp2)
4361 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4362 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4363 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4364 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4366 c & dscp1,dscp2,sumene
4367 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4368 escloc = escloc + sumene
4369 c write (2,*) "escloc",escloc
4370 if (.not. calc_grad) goto 1
4373 C This section to check the numerical derivatives of the energy of ith side
4374 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4375 C #define DEBUG in the code to turn it on.
4377 write (2,*) "sumene =",sumene
4381 write (2,*) xx,yy,zz
4382 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4383 de_dxx_num=(sumenep-sumene)/aincr
4385 write (2,*) "xx+ sumene from enesc=",sumenep
4388 write (2,*) xx,yy,zz
4389 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4390 de_dyy_num=(sumenep-sumene)/aincr
4392 write (2,*) "yy+ sumene from enesc=",sumenep
4395 write (2,*) xx,yy,zz
4396 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4397 de_dzz_num=(sumenep-sumene)/aincr
4399 write (2,*) "zz+ sumene from enesc=",sumenep
4400 costsave=cost2tab(i+1)
4401 sintsave=sint2tab(i+1)
4402 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4403 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4404 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4405 de_dt_num=(sumenep-sumene)/aincr
4406 write (2,*) " t+ sumene from enesc=",sumenep
4407 cost2tab(i+1)=costsave
4408 sint2tab(i+1)=sintsave
4409 C End of diagnostics section.
4412 C Compute the gradient of esc
4414 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4415 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4416 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4417 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4418 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4419 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4420 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4421 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4422 pom1=(sumene3*sint2tab(i+1)+sumene1)
4423 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4424 pom2=(sumene4*cost2tab(i+1)+sumene2)
4425 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4426 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4427 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4428 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4430 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4431 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4432 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4434 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4435 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4436 & +(pom1+pom2)*pom_dx
4438 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4441 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4442 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4443 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4445 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4446 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4447 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4448 & +x(59)*zz**2 +x(60)*xx*zz
4449 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4450 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4451 & +(pom1-pom2)*pom_dy
4453 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4456 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4457 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4458 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4459 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4460 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4461 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4462 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4463 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4465 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4468 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4469 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4470 & +pom1*pom_dt1+pom2*pom_dt2
4472 write(2,*), "de_dt = ", de_dt,de_dt_num
4476 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4477 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4478 cosfac2xx=cosfac2*xx
4479 sinfac2yy=sinfac2*yy
4481 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4483 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4485 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4486 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4487 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4488 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4489 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4490 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4491 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4492 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4493 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4494 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4498 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4499 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4500 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4501 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4504 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4505 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4506 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4508 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4509 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4513 dXX_Ctab(k,i)=dXX_Ci(k)
4514 dXX_C1tab(k,i)=dXX_Ci1(k)
4515 dYY_Ctab(k,i)=dYY_Ci(k)
4516 dYY_C1tab(k,i)=dYY_Ci1(k)
4517 dZZ_Ctab(k,i)=dZZ_Ci(k)
4518 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4519 dXX_XYZtab(k,i)=dXX_XYZ(k)
4520 dYY_XYZtab(k,i)=dYY_XYZ(k)
4521 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4525 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4526 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4527 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4528 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4529 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4531 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4532 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4533 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4534 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4535 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4536 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4537 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4538 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4540 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4541 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4543 C to check gradient call subroutine check_grad
4550 c------------------------------------------------------------------------------
4551 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4553 C This procedure calculates two-body contact function g(rij) and its derivative:
4556 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4559 C where x=(rij-r0ij)/delta
4561 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4564 double precision rij,r0ij,eps0ij,fcont,fprimcont
4565 double precision x,x2,x4,delta
4569 if (x.lt.-1.0D0) then
4572 else if (x.le.1.0D0) then
4575 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4576 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4583 c------------------------------------------------------------------------------
4584 subroutine splinthet(theti,delta,ss,ssder)
4585 implicit real*8 (a-h,o-z)
4586 include 'DIMENSIONS'
4587 include 'sizesclu.dat'
4588 include 'COMMON.VAR'
4589 include 'COMMON.GEO'
4592 if (theti.gt.pipol) then
4593 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4595 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4600 c------------------------------------------------------------------------------
4601 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4603 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4604 double precision ksi,ksi2,ksi3,a1,a2,a3
4605 a1=fprim0*delta/(f1-f0)
4611 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4612 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4615 c------------------------------------------------------------------------------
4616 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4618 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4619 double precision ksi,ksi2,ksi3,a1,a2,a3
4624 a2=3*(f1x-f0x)-2*fprim0x*delta
4625 a3=fprim0x*delta-2*(f1x-f0x)
4626 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4629 C-----------------------------------------------------------------------------
4631 C-----------------------------------------------------------------------------
4632 subroutine etor(etors,edihcnstr,fact)
4633 implicit real*8 (a-h,o-z)
4634 include 'DIMENSIONS'
4635 include 'sizesclu.dat'
4636 include 'COMMON.VAR'
4637 include 'COMMON.GEO'
4638 include 'COMMON.LOCAL'
4639 include 'COMMON.TORSION'
4640 include 'COMMON.INTERACT'
4641 include 'COMMON.DERIV'
4642 include 'COMMON.CHAIN'
4643 include 'COMMON.NAMES'
4644 include 'COMMON.IOUNITS'
4645 include 'COMMON.FFIELD'
4646 include 'COMMON.TORCNSTR'
4648 C Set lprn=.true. for debugging
4652 do i=iphi_start,iphi_end
4653 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4654 & .or. itype(i).eq.ntyp1) cycle
4655 itori=itortyp(itype(i-2))
4656 itori1=itortyp(itype(i-1))
4659 C Proline-Proline pair is a special case...
4660 if (itori.eq.3 .and. itori1.eq.3) then
4661 if (phii.gt.-dwapi3) then
4663 fac=1.0D0/(1.0D0-cosphi)
4664 etorsi=v1(1,3,3)*fac
4665 etorsi=etorsi+etorsi
4666 etors=etors+etorsi-v1(1,3,3)
4667 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4670 v1ij=v1(j+1,itori,itori1)
4671 v2ij=v2(j+1,itori,itori1)
4674 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4675 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4679 v1ij=v1(j,itori,itori1)
4680 v2ij=v2(j,itori,itori1)
4683 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4684 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4688 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4689 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4690 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4691 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4692 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4694 ! 6/20/98 - dihedral angle constraints
4697 itori=idih_constr(i)
4700 if (difi.gt.drange(i)) then
4702 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4703 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4704 else if (difi.lt.-drange(i)) then
4706 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4707 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4709 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4710 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4712 ! write (iout,*) 'edihcnstr',edihcnstr
4715 c------------------------------------------------------------------------------
4717 subroutine etor(etors,edihcnstr,fact)
4718 implicit real*8 (a-h,o-z)
4719 include 'DIMENSIONS'
4720 include 'sizesclu.dat'
4721 include 'COMMON.VAR'
4722 include 'COMMON.GEO'
4723 include 'COMMON.LOCAL'
4724 include 'COMMON.TORSION'
4725 include 'COMMON.INTERACT'
4726 include 'COMMON.DERIV'
4727 include 'COMMON.CHAIN'
4728 include 'COMMON.NAMES'
4729 include 'COMMON.IOUNITS'
4730 include 'COMMON.FFIELD'
4731 include 'COMMON.TORCNSTR'
4733 C Set lprn=.true. for debugging
4737 do i=iphi_start,iphi_end
4739 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4740 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4741 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4742 if (iabs(itype(i)).eq.20) then
4747 itori=itortyp(itype(i-2))
4748 itori1=itortyp(itype(i-1))
4751 C Regular cosine and sine terms
4752 do j=1,nterm(itori,itori1,iblock)
4753 v1ij=v1(j,itori,itori1,iblock)
4754 v2ij=v2(j,itori,itori1,iblock)
4757 etors=etors+v1ij*cosphi+v2ij*sinphi
4758 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4762 C E = SUM ----------------------------------- - v1
4763 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4765 cosphi=dcos(0.5d0*phii)
4766 sinphi=dsin(0.5d0*phii)
4767 do j=1,nlor(itori,itori1,iblock)
4768 vl1ij=vlor1(j,itori,itori1)
4769 vl2ij=vlor2(j,itori,itori1)
4770 vl3ij=vlor3(j,itori,itori1)
4771 pom=vl2ij*cosphi+vl3ij*sinphi
4772 pom1=1.0d0/(pom*pom+1.0d0)
4773 etors=etors+vl1ij*pom1
4775 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4777 C Subtract the constant term
4778 etors=etors-v0(itori,itori1,iblock)
4780 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4781 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4782 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4783 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4784 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4787 ! 6/20/98 - dihedral angle constraints
4790 itori=idih_constr(i)
4792 difi=pinorm(phii-phi0(i))
4794 if (difi.gt.drange(i)) then
4796 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4797 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4798 edihi=0.25d0*ftors(i)*difi**4
4799 else if (difi.lt.-drange(i)) then
4801 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4802 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4803 edihi=0.25d0*ftors(i)*difi**4
4807 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4809 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4810 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4812 ! write (iout,*) 'edihcnstr',edihcnstr
4815 c----------------------------------------------------------------------------
4816 subroutine etor_d(etors_d,fact2)
4817 C 6/23/01 Compute double torsional energy
4818 implicit real*8 (a-h,o-z)
4819 include 'DIMENSIONS'
4820 include 'sizesclu.dat'
4821 include 'COMMON.VAR'
4822 include 'COMMON.GEO'
4823 include 'COMMON.LOCAL'
4824 include 'COMMON.TORSION'
4825 include 'COMMON.INTERACT'
4826 include 'COMMON.DERIV'
4827 include 'COMMON.CHAIN'
4828 include 'COMMON.NAMES'
4829 include 'COMMON.IOUNITS'
4830 include 'COMMON.FFIELD'
4831 include 'COMMON.TORCNSTR'
4833 C Set lprn=.true. for debugging
4837 do i=iphi_start,iphi_end-1
4839 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4840 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4841 & (itype(i+1).eq.ntyp1)) cycle
4842 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4844 itori=itortyp(itype(i-2))
4845 itori1=itortyp(itype(i-1))
4846 itori2=itortyp(itype(i))
4852 if (iabs(itype(i+1)).eq.20) iblock=2
4853 C Regular cosine and sine terms
4854 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4855 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4856 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4857 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4858 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4859 cosphi1=dcos(j*phii)
4860 sinphi1=dsin(j*phii)
4861 cosphi2=dcos(j*phii1)
4862 sinphi2=dsin(j*phii1)
4863 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4864 & v2cij*cosphi2+v2sij*sinphi2
4865 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4866 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4868 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4870 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4871 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4872 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4873 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4874 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4875 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4876 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4877 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4878 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4879 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4880 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4881 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4882 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4883 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4886 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4887 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4893 c------------------------------------------------------------------------------
4894 subroutine eback_sc_corr(esccor)
4895 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4896 c conformational states; temporarily implemented as differences
4897 c between UNRES torsional potentials (dependent on three types of
4898 c residues) and the torsional potentials dependent on all 20 types
4899 c of residues computed from AM1 energy surfaces of terminally-blocked
4900 c amino-acid residues.
4901 implicit real*8 (a-h,o-z)
4902 include 'DIMENSIONS'
4903 include 'sizesclu.dat'
4904 include 'COMMON.VAR'
4905 include 'COMMON.GEO'
4906 include 'COMMON.LOCAL'
4907 include 'COMMON.TORSION'
4908 include 'COMMON.SCCOR'
4909 include 'COMMON.INTERACT'
4910 include 'COMMON.DERIV'
4911 include 'COMMON.CHAIN'
4912 include 'COMMON.NAMES'
4913 include 'COMMON.IOUNITS'
4914 include 'COMMON.FFIELD'
4915 include 'COMMON.CONTROL'
4917 C Set lprn=.true. for debugging
4920 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4922 do i=itau_start,itau_end
4923 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4925 isccori=isccortyp(itype(i-2))
4926 isccori1=isccortyp(itype(i-1))
4928 do intertyp=1,3 !intertyp
4929 cc Added 09 May 2012 (Adasko)
4930 cc Intertyp means interaction type of backbone mainchain correlation:
4931 c 1 = SC...Ca...Ca...Ca
4932 c 2 = Ca...Ca...Ca...SC
4933 c 3 = SC...Ca...Ca...SCi
4935 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4936 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4937 & (itype(i-1).eq.ntyp1)))
4938 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4939 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4940 & .or.(itype(i).eq.ntyp1)))
4941 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4942 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4943 & (itype(i-3).eq.ntyp1)))) cycle
4944 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4945 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4947 do j=1,nterm_sccor(isccori,isccori1)
4948 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4949 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4950 cosphi=dcos(j*tauangle(intertyp,i))
4951 sinphi=dsin(j*tauangle(intertyp,i))
4952 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4953 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4955 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4956 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4958 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4959 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4960 & (v1sccor(j,1,itori,itori1),j=1,6),
4961 & (v2sccor(j,1,itori,itori1),j=1,6)
4962 gsccor_loc(i-3)=gloci
4967 c------------------------------------------------------------------------------
4968 subroutine multibody(ecorr)
4969 C This subroutine calculates multi-body contributions to energy following
4970 C the idea of Skolnick et al. If side chains I and J make a contact and
4971 C at the same time side chains I+1 and J+1 make a contact, an extra
4972 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4973 implicit real*8 (a-h,o-z)
4974 include 'DIMENSIONS'
4975 include 'COMMON.IOUNITS'
4976 include 'COMMON.DERIV'
4977 include 'COMMON.INTERACT'
4978 include 'COMMON.CONTACTS'
4979 double precision gx(3),gx1(3)
4982 C Set lprn=.true. for debugging
4986 write (iout,'(a)') 'Contact function values:'
4988 write (iout,'(i2,20(1x,i2,f10.5))')
4989 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5004 num_conti=num_cont(i)
5005 num_conti1=num_cont(i1)
5010 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5011 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5012 cd & ' ishift=',ishift
5013 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5014 C The system gains extra energy.
5015 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5016 endif ! j1==j+-ishift
5025 c------------------------------------------------------------------------------
5026 double precision function esccorr(i,j,k,l,jj,kk)
5027 implicit real*8 (a-h,o-z)
5028 include 'DIMENSIONS'
5029 include 'COMMON.IOUNITS'
5030 include 'COMMON.DERIV'
5031 include 'COMMON.INTERACT'
5032 include 'COMMON.CONTACTS'
5033 double precision gx(3),gx1(3)
5038 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5039 C Calculate the multi-body contribution to energy.
5040 C Calculate multi-body contributions to the gradient.
5041 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5042 cd & k,l,(gacont(m,kk,k),m=1,3)
5044 gx(m) =ekl*gacont(m,jj,i)
5045 gx1(m)=eij*gacont(m,kk,k)
5046 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5047 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5048 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5049 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5053 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5058 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5064 c------------------------------------------------------------------------------
5066 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5067 implicit real*8 (a-h,o-z)
5068 include 'DIMENSIONS'
5069 integer dimen1,dimen2,atom,indx
5070 double precision buffer(dimen1,dimen2)
5071 double precision zapas
5072 common /contacts_hb/ zapas(3,20,maxres,7),
5073 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5074 & num_cont_hb(maxres),jcont_hb(20,maxres)
5075 num_kont=num_cont_hb(atom)
5079 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5082 buffer(i,indx+22)=facont_hb(i,atom)
5083 buffer(i,indx+23)=ees0p(i,atom)
5084 buffer(i,indx+24)=ees0m(i,atom)
5085 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5087 buffer(1,indx+26)=dfloat(num_kont)
5090 c------------------------------------------------------------------------------
5091 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5092 implicit real*8 (a-h,o-z)
5093 include 'DIMENSIONS'
5094 integer dimen1,dimen2,atom,indx
5095 double precision buffer(dimen1,dimen2)
5096 double precision zapas
5097 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5098 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5099 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5100 num_kont=buffer(1,indx+26)
5101 num_kont_old=num_cont_hb(atom)
5102 num_cont_hb(atom)=num_kont+num_kont_old
5107 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5110 facont_hb(ii,atom)=buffer(i,indx+22)
5111 ees0p(ii,atom)=buffer(i,indx+23)
5112 ees0m(ii,atom)=buffer(i,indx+24)
5113 jcont_hb(ii,atom)=buffer(i,indx+25)
5117 c------------------------------------------------------------------------------
5119 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5120 C This subroutine calculates multi-body contributions to hydrogen-bonding
5121 implicit real*8 (a-h,o-z)
5122 include 'DIMENSIONS'
5123 include 'sizesclu.dat'
5124 include 'COMMON.IOUNITS'
5126 include 'COMMON.INFO'
5128 include 'COMMON.FFIELD'
5129 include 'COMMON.DERIV'
5130 include 'COMMON.INTERACT'
5131 include 'COMMON.CONTACTS'
5133 parameter (max_cont=maxconts)
5134 parameter (max_dim=2*(8*3+2))
5135 parameter (msglen1=max_cont*max_dim*4)
5136 parameter (msglen2=2*msglen1)
5137 integer source,CorrelType,CorrelID,Error
5138 double precision buffer(max_cont,max_dim)
5140 double precision gx(3),gx1(3)
5143 C Set lprn=.true. for debugging
5148 if (fgProcs.le.1) goto 30
5150 write (iout,'(a)') 'Contact function values:'
5152 write (iout,'(2i3,50(1x,i2,f5.2))')
5153 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5154 & j=1,num_cont_hb(i))
5157 C Caution! Following code assumes that electrostatic interactions concerning
5158 C a given atom are split among at most two processors!
5168 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5171 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5172 if (MyRank.gt.0) then
5173 C Send correlation contributions to the preceding processor
5175 nn=num_cont_hb(iatel_s)
5176 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5177 cd write (iout,*) 'The BUFFER array:'
5179 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5181 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5183 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5184 C Clear the contacts of the atom passed to the neighboring processor
5185 nn=num_cont_hb(iatel_s+1)
5187 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5189 num_cont_hb(iatel_s)=0
5191 cd write (iout,*) 'Processor ',MyID,MyRank,
5192 cd & ' is sending correlation contribution to processor',MyID-1,
5193 cd & ' msglen=',msglen
5194 cd write (*,*) 'Processor ',MyID,MyRank,
5195 cd & ' is sending correlation contribution to processor',MyID-1,
5196 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5197 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5198 cd write (iout,*) 'Processor ',MyID,
5199 cd & ' has sent correlation contribution to processor',MyID-1,
5200 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5201 cd write (*,*) 'Processor ',MyID,
5202 cd & ' has sent correlation contribution to processor',MyID-1,
5203 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5205 endif ! (MyRank.gt.0)
5209 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5210 if (MyRank.lt.fgProcs-1) then
5211 C Receive correlation contributions from the next processor
5213 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5214 cd write (iout,*) 'Processor',MyID,
5215 cd & ' is receiving correlation contribution from processor',MyID+1,
5216 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5217 cd write (*,*) 'Processor',MyID,
5218 cd & ' is receiving correlation contribution from processor',MyID+1,
5219 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5221 do while (nbytes.le.0)
5222 call mp_probe(MyID+1,CorrelType,nbytes)
5224 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5225 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5226 cd write (iout,*) 'Processor',MyID,
5227 cd & ' has received correlation contribution from processor',MyID+1,
5228 cd & ' msglen=',msglen,' nbytes=',nbytes
5229 cd write (iout,*) 'The received BUFFER array:'
5231 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5233 if (msglen.eq.msglen1) then
5234 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5235 else if (msglen.eq.msglen2) then
5236 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5237 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5240 & 'ERROR!!!! message length changed while processing correlations.'
5242 & 'ERROR!!!! message length changed while processing correlations.'
5243 call mp_stopall(Error)
5244 endif ! msglen.eq.msglen1
5245 endif ! MyRank.lt.fgProcs-1
5252 write (iout,'(a)') 'Contact function values:'
5254 write (iout,'(2i3,50(1x,i2,f5.2))')
5255 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5256 & j=1,num_cont_hb(i))
5260 C Remove the loop below after debugging !!!
5267 C Calculate the local-electrostatic correlation terms
5268 do i=iatel_s,iatel_e+1
5270 num_conti=num_cont_hb(i)
5271 num_conti1=num_cont_hb(i+1)
5276 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5277 c & ' jj=',jj,' kk=',kk
5278 if (j1.eq.j+1 .or. j1.eq.j-1) then
5279 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5280 C The system gains extra energy.
5281 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5283 else if (j1.eq.j) then
5284 C Contacts I-J and I-(J+1) occur simultaneously.
5285 C The system loses extra energy.
5286 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5291 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5292 c & ' jj=',jj,' kk=',kk
5294 C Contacts I-J and (I+1)-J occur simultaneously.
5295 C The system loses extra energy.
5296 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5303 c------------------------------------------------------------------------------
5304 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5306 C This subroutine calculates multi-body contributions to hydrogen-bonding
5307 implicit real*8 (a-h,o-z)
5308 include 'DIMENSIONS'
5309 include 'sizesclu.dat'
5310 include 'COMMON.IOUNITS'
5312 include 'COMMON.INFO'
5314 include 'COMMON.FFIELD'
5315 include 'COMMON.DERIV'
5316 include 'COMMON.INTERACT'
5317 include 'COMMON.CONTACTS'
5319 parameter (max_cont=maxconts)
5320 parameter (max_dim=2*(8*3+2))
5321 parameter (msglen1=max_cont*max_dim*4)
5322 parameter (msglen2=2*msglen1)
5323 integer source,CorrelType,CorrelID,Error
5324 double precision buffer(max_cont,max_dim)
5326 double precision gx(3),gx1(3)
5329 C Set lprn=.true. for debugging
5335 if (fgProcs.le.1) goto 30
5337 write (iout,'(a)') 'Contact function values:'
5339 write (iout,'(2i3,50(1x,i2,f5.2))')
5340 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5341 & j=1,num_cont_hb(i))
5344 C Caution! Following code assumes that electrostatic interactions concerning
5345 C a given atom are split among at most two processors!
5355 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5358 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5359 if (MyRank.gt.0) then
5360 C Send correlation contributions to the preceding processor
5362 nn=num_cont_hb(iatel_s)
5363 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5364 cd write (iout,*) 'The BUFFER array:'
5366 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5368 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5370 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5371 C Clear the contacts of the atom passed to the neighboring processor
5372 nn=num_cont_hb(iatel_s+1)
5374 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5376 num_cont_hb(iatel_s)=0
5378 cd write (iout,*) 'Processor ',MyID,MyRank,
5379 cd & ' is sending correlation contribution to processor',MyID-1,
5380 cd & ' msglen=',msglen
5381 cd write (*,*) 'Processor ',MyID,MyRank,
5382 cd & ' is sending correlation contribution to processor',MyID-1,
5383 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5384 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5385 cd write (iout,*) 'Processor ',MyID,
5386 cd & ' has sent correlation contribution to processor',MyID-1,
5387 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5388 cd write (*,*) 'Processor ',MyID,
5389 cd & ' has sent correlation contribution to processor',MyID-1,
5390 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5392 endif ! (MyRank.gt.0)
5396 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5397 if (MyRank.lt.fgProcs-1) then
5398 C Receive correlation contributions from the next processor
5400 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5401 cd write (iout,*) 'Processor',MyID,
5402 cd & ' is receiving correlation contribution from processor',MyID+1,
5403 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5404 cd write (*,*) 'Processor',MyID,
5405 cd & ' is receiving correlation contribution from processor',MyID+1,
5406 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5408 do while (nbytes.le.0)
5409 call mp_probe(MyID+1,CorrelType,nbytes)
5411 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5412 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5413 cd write (iout,*) 'Processor',MyID,
5414 cd & ' has received correlation contribution from processor',MyID+1,
5415 cd & ' msglen=',msglen,' nbytes=',nbytes
5416 cd write (iout,*) 'The received BUFFER array:'
5418 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5420 if (msglen.eq.msglen1) then
5421 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5422 else if (msglen.eq.msglen2) then
5423 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5424 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5427 & 'ERROR!!!! message length changed while processing correlations.'
5429 & 'ERROR!!!! message length changed while processing correlations.'
5430 call mp_stopall(Error)
5431 endif ! msglen.eq.msglen1
5432 endif ! MyRank.lt.fgProcs-1
5439 write (iout,'(a)') 'Contact function values:'
5441 write (iout,'(2i3,50(1x,i2,f5.2))')
5442 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5443 & j=1,num_cont_hb(i))
5449 C Remove the loop below after debugging !!!
5456 C Calculate the dipole-dipole interaction energies
5457 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5458 do i=iatel_s,iatel_e+1
5459 num_conti=num_cont_hb(i)
5466 C Calculate the local-electrostatic correlation terms
5467 do i=iatel_s,iatel_e+1
5469 num_conti=num_cont_hb(i)
5470 num_conti1=num_cont_hb(i+1)
5475 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5476 c & ' jj=',jj,' kk=',kk
5477 if (j1.eq.j+1 .or. j1.eq.j-1) then
5478 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5479 C The system gains extra energy.
5481 sqd1=dsqrt(d_cont(jj,i))
5482 sqd2=dsqrt(d_cont(kk,i1))
5483 sred_geom = sqd1*sqd2
5484 IF (sred_geom.lt.cutoff_corr) THEN
5485 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5487 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5488 c & ' jj=',jj,' kk=',kk
5489 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5490 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5492 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5493 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5496 cd write (iout,*) 'sred_geom=',sred_geom,
5497 cd & ' ekont=',ekont,' fprim=',fprimcont
5498 call calc_eello(i,j,i+1,j1,jj,kk)
5499 if (wcorr4.gt.0.0d0)
5500 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5501 if (wcorr5.gt.0.0d0)
5502 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5503 c print *,"wcorr5",ecorr5
5504 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5505 cd write(2,*)'ijkl',i,j,i+1,j1
5506 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5507 & .or. wturn6.eq.0.0d0))then
5508 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5509 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5510 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5511 cd & 'ecorr6=',ecorr6
5512 cd write (iout,'(4e15.5)') sred_geom,
5513 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5514 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5515 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5516 else if (wturn6.gt.0.0d0
5517 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5518 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5519 eturn6=eturn6+eello_turn6(i,jj,kk)
5520 cd write (2,*) 'multibody_eello:eturn6',eturn6
5524 else if (j1.eq.j) then
5525 C Contacts I-J and I-(J+1) occur simultaneously.
5526 C The system loses extra energy.
5527 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5532 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5533 c & ' jj=',jj,' kk=',kk
5535 C Contacts I-J and (I+1)-J occur simultaneously.
5536 C The system loses extra energy.
5537 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5544 c------------------------------------------------------------------------------
5545 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5546 implicit real*8 (a-h,o-z)
5547 include 'DIMENSIONS'
5548 include 'COMMON.IOUNITS'
5549 include 'COMMON.DERIV'
5550 include 'COMMON.INTERACT'
5551 include 'COMMON.CONTACTS'
5552 double precision gx(3),gx1(3)
5562 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5563 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5564 C Following 4 lines for diagnostics.
5569 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5571 c write (iout,*)'Contacts have occurred for peptide groups',
5572 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5573 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5574 C Calculate the multi-body contribution to energy.
5575 ecorr=ecorr+ekont*ees
5577 C Calculate multi-body contributions to the gradient.
5579 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5580 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5581 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5582 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5583 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5584 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5585 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5586 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5587 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5588 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5589 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5590 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5591 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5592 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5596 gradcorr(ll,m)=gradcorr(ll,m)+
5597 & ees*ekl*gacont_hbr(ll,jj,i)-
5598 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5599 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5604 gradcorr(ll,m)=gradcorr(ll,m)+
5605 & ees*eij*gacont_hbr(ll,kk,k)-
5606 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5607 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5614 C---------------------------------------------------------------------------
5615 subroutine dipole(i,j,jj)
5616 implicit real*8 (a-h,o-z)
5617 include 'DIMENSIONS'
5618 include 'sizesclu.dat'
5619 include 'COMMON.IOUNITS'
5620 include 'COMMON.CHAIN'
5621 include 'COMMON.FFIELD'
5622 include 'COMMON.DERIV'
5623 include 'COMMON.INTERACT'
5624 include 'COMMON.CONTACTS'
5625 include 'COMMON.TORSION'
5626 include 'COMMON.VAR'
5627 include 'COMMON.GEO'
5628 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5630 iti1 = itortyp(itype(i+1))
5631 if (j.lt.nres-1) then
5632 if (itype(j).le.ntyp) then
5633 itj1 = itortyp(itype(j+1))
5641 dipi(iii,1)=Ub2(iii,i)
5642 dipderi(iii)=Ub2der(iii,i)
5643 dipi(iii,2)=b1(iii,iti1)
5644 dipj(iii,1)=Ub2(iii,j)
5645 dipderj(iii)=Ub2der(iii,j)
5646 dipj(iii,2)=b1(iii,itj1)
5650 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5653 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5656 if (.not.calc_grad) return
5661 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5665 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5670 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5671 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5673 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5675 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5677 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5681 C---------------------------------------------------------------------------
5682 subroutine calc_eello(i,j,k,l,jj,kk)
5684 C This subroutine computes matrices and vectors needed to calculate
5685 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5687 implicit real*8 (a-h,o-z)
5688 include 'DIMENSIONS'
5689 include 'sizesclu.dat'
5690 include 'COMMON.IOUNITS'
5691 include 'COMMON.CHAIN'
5692 include 'COMMON.DERIV'
5693 include 'COMMON.INTERACT'
5694 include 'COMMON.CONTACTS'
5695 include 'COMMON.TORSION'
5696 include 'COMMON.VAR'
5697 include 'COMMON.GEO'
5698 include 'COMMON.FFIELD'
5699 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5700 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5703 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5704 cd & ' jj=',jj,' kk=',kk
5705 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5708 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5709 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5712 call transpose2(aa1(1,1),aa1t(1,1))
5713 call transpose2(aa2(1,1),aa2t(1,1))
5716 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5717 & aa1tder(1,1,lll,kkk))
5718 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5719 & aa2tder(1,1,lll,kkk))
5723 C parallel orientation of the two CA-CA-CA frames.
5725 if (i.gt.1 .and. itype(i).le.ntyp) then
5726 iti=itortyp(itype(i))
5730 itk1=itortyp(itype(k+1))
5731 itj=itortyp(itype(j))
5732 c if (l.lt.nres-1) then
5733 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5734 itl1=itortyp(itype(l+1))
5738 C A1 kernel(j+1) A2T
5740 cd write (iout,'(3f10.5,5x,3f10.5)')
5741 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5743 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5744 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5745 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5746 C Following matrices are needed only for 6-th order cumulants
5747 IF (wcorr6.gt.0.0d0) THEN
5748 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5749 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5750 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5751 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5752 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5753 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5754 & ADtEAderx(1,1,1,1,1,1))
5756 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5757 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5758 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5759 & ADtEA1derx(1,1,1,1,1,1))
5761 C End 6-th order cumulants
5764 cd write (2,*) 'In calc_eello6'
5766 cd write (2,*) 'iii=',iii
5768 cd write (2,*) 'kkk=',kkk
5770 cd write (2,'(3(2f10.5),5x)')
5771 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5776 call transpose2(EUgder(1,1,k),auxmat(1,1))
5777 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5778 call transpose2(EUg(1,1,k),auxmat(1,1))
5779 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5780 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5784 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5785 & EAEAderx(1,1,lll,kkk,iii,1))
5789 C A1T kernel(i+1) A2
5790 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5791 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5792 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5793 C Following matrices are needed only for 6-th order cumulants
5794 IF (wcorr6.gt.0.0d0) THEN
5795 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5796 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5797 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5798 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5799 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5800 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5801 & ADtEAderx(1,1,1,1,1,2))
5802 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5803 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5804 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5805 & ADtEA1derx(1,1,1,1,1,2))
5807 C End 6-th order cumulants
5808 call transpose2(EUgder(1,1,l),auxmat(1,1))
5809 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5810 call transpose2(EUg(1,1,l),auxmat(1,1))
5811 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5812 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5816 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5817 & EAEAderx(1,1,lll,kkk,iii,2))
5822 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5823 C They are needed only when the fifth- or the sixth-order cumulants are
5825 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5826 call transpose2(AEA(1,1,1),auxmat(1,1))
5827 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5828 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5829 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5830 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5831 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5832 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5833 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5834 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5835 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5836 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5837 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5838 call transpose2(AEA(1,1,2),auxmat(1,1))
5839 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5840 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5841 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5842 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5843 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5844 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5845 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5846 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5847 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5848 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5849 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5850 C Calculate the Cartesian derivatives of the vectors.
5854 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5855 call matvec2(auxmat(1,1),b1(1,iti),
5856 & AEAb1derx(1,lll,kkk,iii,1,1))
5857 call matvec2(auxmat(1,1),Ub2(1,i),
5858 & AEAb2derx(1,lll,kkk,iii,1,1))
5859 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5860 & AEAb1derx(1,lll,kkk,iii,2,1))
5861 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5862 & AEAb2derx(1,lll,kkk,iii,2,1))
5863 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5864 call matvec2(auxmat(1,1),b1(1,itj),
5865 & AEAb1derx(1,lll,kkk,iii,1,2))
5866 call matvec2(auxmat(1,1),Ub2(1,j),
5867 & AEAb2derx(1,lll,kkk,iii,1,2))
5868 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5869 & AEAb1derx(1,lll,kkk,iii,2,2))
5870 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5871 & AEAb2derx(1,lll,kkk,iii,2,2))
5878 C Antiparallel orientation of the two CA-CA-CA frames.
5880 if (i.gt.1 .and. itype(i).le.ntyp) then
5881 iti=itortyp(itype(i))
5885 itk1=itortyp(itype(k+1))
5886 itl=itortyp(itype(l))
5887 itj=itortyp(itype(j))
5888 c if (j.lt.nres-1) then
5889 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5890 itj1=itortyp(itype(j+1))
5894 C A2 kernel(j-1)T A1T
5895 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5896 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5897 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5898 C Following matrices are needed only for 6-th order cumulants
5899 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5900 & j.eq.i+4 .and. l.eq.i+3)) THEN
5901 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5902 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5903 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5904 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5905 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5906 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5907 & ADtEAderx(1,1,1,1,1,1))
5908 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5909 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5910 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5911 & ADtEA1derx(1,1,1,1,1,1))
5913 C End 6-th order cumulants
5914 call transpose2(EUgder(1,1,k),auxmat(1,1))
5915 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5916 call transpose2(EUg(1,1,k),auxmat(1,1))
5917 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5918 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5922 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5923 & EAEAderx(1,1,lll,kkk,iii,1))
5927 C A2T kernel(i+1)T A1
5928 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5929 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5930 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5931 C Following matrices are needed only for 6-th order cumulants
5932 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5933 & j.eq.i+4 .and. l.eq.i+3)) THEN
5934 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5935 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5936 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5937 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5938 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5939 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5940 & ADtEAderx(1,1,1,1,1,2))
5941 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5942 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5943 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5944 & ADtEA1derx(1,1,1,1,1,2))
5946 C End 6-th order cumulants
5947 call transpose2(EUgder(1,1,j),auxmat(1,1))
5948 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5949 call transpose2(EUg(1,1,j),auxmat(1,1))
5950 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5951 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5955 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5956 & EAEAderx(1,1,lll,kkk,iii,2))
5961 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5962 C They are needed only when the fifth- or the sixth-order cumulants are
5964 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5965 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5966 call transpose2(AEA(1,1,1),auxmat(1,1))
5967 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5968 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5969 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5970 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5971 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5972 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5973 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5974 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5975 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5976 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5977 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5978 call transpose2(AEA(1,1,2),auxmat(1,1))
5979 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5980 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5981 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5982 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5983 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5984 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5985 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5986 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5987 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5988 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5989 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5990 C Calculate the Cartesian derivatives of the vectors.
5994 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5995 call matvec2(auxmat(1,1),b1(1,iti),
5996 & AEAb1derx(1,lll,kkk,iii,1,1))
5997 call matvec2(auxmat(1,1),Ub2(1,i),
5998 & AEAb2derx(1,lll,kkk,iii,1,1))
5999 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6000 & AEAb1derx(1,lll,kkk,iii,2,1))
6001 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6002 & AEAb2derx(1,lll,kkk,iii,2,1))
6003 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6004 call matvec2(auxmat(1,1),b1(1,itl),
6005 & AEAb1derx(1,lll,kkk,iii,1,2))
6006 call matvec2(auxmat(1,1),Ub2(1,l),
6007 & AEAb2derx(1,lll,kkk,iii,1,2))
6008 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6009 & AEAb1derx(1,lll,kkk,iii,2,2))
6010 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6011 & AEAb2derx(1,lll,kkk,iii,2,2))
6020 C---------------------------------------------------------------------------
6021 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6022 & KK,KKderg,AKA,AKAderg,AKAderx)
6026 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6027 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6028 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6033 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6035 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6038 cd if (lprn) write (2,*) 'In kernel'
6040 cd if (lprn) write (2,*) 'kkk=',kkk
6042 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6043 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6045 cd write (2,*) 'lll=',lll
6046 cd write (2,*) 'iii=1'
6048 cd write (2,'(3(2f10.5),5x)')
6049 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6052 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6053 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6055 cd write (2,*) 'lll=',lll
6056 cd write (2,*) 'iii=2'
6058 cd write (2,'(3(2f10.5),5x)')
6059 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6066 C---------------------------------------------------------------------------
6067 double precision function eello4(i,j,k,l,jj,kk)
6068 implicit real*8 (a-h,o-z)
6069 include 'DIMENSIONS'
6070 include 'sizesclu.dat'
6071 include 'COMMON.IOUNITS'
6072 include 'COMMON.CHAIN'
6073 include 'COMMON.DERIV'
6074 include 'COMMON.INTERACT'
6075 include 'COMMON.CONTACTS'
6076 include 'COMMON.TORSION'
6077 include 'COMMON.VAR'
6078 include 'COMMON.GEO'
6079 double precision pizda(2,2),ggg1(3),ggg2(3)
6080 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6084 cd print *,'eello4:',i,j,k,l,jj,kk
6085 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6086 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6087 cold eij=facont_hb(jj,i)
6088 cold ekl=facont_hb(kk,k)
6090 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6092 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6093 gcorr_loc(k-1)=gcorr_loc(k-1)
6094 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6096 gcorr_loc(l-1)=gcorr_loc(l-1)
6097 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6099 gcorr_loc(j-1)=gcorr_loc(j-1)
6100 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6105 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6106 & -EAEAderx(2,2,lll,kkk,iii,1)
6107 cd derx(lll,kkk,iii)=0.0d0
6111 cd gcorr_loc(l-1)=0.0d0
6112 cd gcorr_loc(j-1)=0.0d0
6113 cd gcorr_loc(k-1)=0.0d0
6115 cd write (iout,*)'Contacts have occurred for peptide groups',
6116 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6117 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6118 if (j.lt.nres-1) then
6125 if (l.lt.nres-1) then
6133 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6134 ggg1(ll)=eel4*g_contij(ll,1)
6135 ggg2(ll)=eel4*g_contij(ll,2)
6136 ghalf=0.5d0*ggg1(ll)
6138 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6139 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6140 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6141 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6142 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6143 ghalf=0.5d0*ggg2(ll)
6145 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6146 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6147 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6148 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6153 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6154 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6159 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6160 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6166 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6171 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6175 cd write (2,*) iii,gcorr_loc(iii)
6179 cd write (2,*) 'ekont',ekont
6180 cd write (iout,*) 'eello4',ekont*eel4
6183 C---------------------------------------------------------------------------
6184 double precision function eello5(i,j,k,l,jj,kk)
6185 implicit real*8 (a-h,o-z)
6186 include 'DIMENSIONS'
6187 include 'sizesclu.dat'
6188 include 'COMMON.IOUNITS'
6189 include 'COMMON.CHAIN'
6190 include 'COMMON.DERIV'
6191 include 'COMMON.INTERACT'
6192 include 'COMMON.CONTACTS'
6193 include 'COMMON.TORSION'
6194 include 'COMMON.VAR'
6195 include 'COMMON.GEO'
6196 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6197 double precision ggg1(3),ggg2(3)
6198 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6203 C /l\ / \ \ / \ / \ / C
6204 C / \ / \ \ / \ / \ / C
6205 C j| o |l1 | o | o| o | | o |o C
6206 C \ |/k\| |/ \| / |/ \| |/ \| C
6207 C \i/ \ / \ / / \ / \ C
6209 C (I) (II) (III) (IV) C
6211 C eello5_1 eello5_2 eello5_3 eello5_4 C
6213 C Antiparallel chains C
6216 C /j\ / \ \ / \ / \ / C
6217 C / \ / \ \ / \ / \ / C
6218 C j1| o |l | o | o| o | | o |o C
6219 C \ |/k\| |/ \| / |/ \| |/ \| C
6220 C \i/ \ / \ / / \ / \ C
6222 C (I) (II) (III) (IV) C
6224 C eello5_1 eello5_2 eello5_3 eello5_4 C
6226 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6228 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6229 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6234 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6236 itk=itortyp(itype(k))
6237 itl=itortyp(itype(l))
6238 itj=itortyp(itype(j))
6243 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6244 cd & eel5_3_num,eel5_4_num)
6248 derx(lll,kkk,iii)=0.0d0
6252 cd eij=facont_hb(jj,i)
6253 cd ekl=facont_hb(kk,k)
6255 cd write (iout,*)'Contacts have occurred for peptide groups',
6256 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6258 C Contribution from the graph I.
6259 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6260 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6261 call transpose2(EUg(1,1,k),auxmat(1,1))
6262 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6263 vv(1)=pizda(1,1)-pizda(2,2)
6264 vv(2)=pizda(1,2)+pizda(2,1)
6265 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6266 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6268 C Explicit gradient in virtual-dihedral angles.
6269 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6270 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6271 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6272 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6273 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6274 vv(1)=pizda(1,1)-pizda(2,2)
6275 vv(2)=pizda(1,2)+pizda(2,1)
6276 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6277 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6278 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6279 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6280 vv(1)=pizda(1,1)-pizda(2,2)
6281 vv(2)=pizda(1,2)+pizda(2,1)
6283 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6284 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6285 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6287 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6288 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6289 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6291 C Cartesian gradient
6295 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6297 vv(1)=pizda(1,1)-pizda(2,2)
6298 vv(2)=pizda(1,2)+pizda(2,1)
6299 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6300 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6301 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6308 C Contribution from graph II
6309 call transpose2(EE(1,1,itk),auxmat(1,1))
6310 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6311 vv(1)=pizda(1,1)+pizda(2,2)
6312 vv(2)=pizda(2,1)-pizda(1,2)
6313 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6314 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6316 C Explicit gradient in virtual-dihedral angles.
6317 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6318 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6319 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6320 vv(1)=pizda(1,1)+pizda(2,2)
6321 vv(2)=pizda(2,1)-pizda(1,2)
6323 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6324 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6325 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6327 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6328 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6329 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6331 C Cartesian gradient
6335 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6337 vv(1)=pizda(1,1)+pizda(2,2)
6338 vv(2)=pizda(2,1)-pizda(1,2)
6339 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6340 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6341 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6350 C Parallel orientation
6351 C Contribution from graph III
6352 call transpose2(EUg(1,1,l),auxmat(1,1))
6353 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6354 vv(1)=pizda(1,1)-pizda(2,2)
6355 vv(2)=pizda(1,2)+pizda(2,1)
6356 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6357 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6359 C Explicit gradient in virtual-dihedral angles.
6360 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6361 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6362 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6363 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6364 vv(1)=pizda(1,1)-pizda(2,2)
6365 vv(2)=pizda(1,2)+pizda(2,1)
6366 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6367 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6368 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6369 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6370 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6371 vv(1)=pizda(1,1)-pizda(2,2)
6372 vv(2)=pizda(1,2)+pizda(2,1)
6373 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6374 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6375 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6376 C Cartesian gradient
6380 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6382 vv(1)=pizda(1,1)-pizda(2,2)
6383 vv(2)=pizda(1,2)+pizda(2,1)
6384 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6385 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6386 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6392 C Contribution from graph IV
6394 call transpose2(EE(1,1,itl),auxmat(1,1))
6395 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6396 vv(1)=pizda(1,1)+pizda(2,2)
6397 vv(2)=pizda(2,1)-pizda(1,2)
6398 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6399 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6401 C Explicit gradient in virtual-dihedral angles.
6402 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6403 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6404 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6405 vv(1)=pizda(1,1)+pizda(2,2)
6406 vv(2)=pizda(2,1)-pizda(1,2)
6407 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6408 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6409 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6410 C Cartesian gradient
6414 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6416 vv(1)=pizda(1,1)+pizda(2,2)
6417 vv(2)=pizda(2,1)-pizda(1,2)
6418 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6419 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6420 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6426 C Antiparallel orientation
6427 C Contribution from graph III
6429 call transpose2(EUg(1,1,j),auxmat(1,1))
6430 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6431 vv(1)=pizda(1,1)-pizda(2,2)
6432 vv(2)=pizda(1,2)+pizda(2,1)
6433 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6434 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6436 C Explicit gradient in virtual-dihedral angles.
6437 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6438 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6439 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6440 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6441 vv(1)=pizda(1,1)-pizda(2,2)
6442 vv(2)=pizda(1,2)+pizda(2,1)
6443 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6444 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6445 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6446 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6447 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6448 vv(1)=pizda(1,1)-pizda(2,2)
6449 vv(2)=pizda(1,2)+pizda(2,1)
6450 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6451 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6452 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6453 C Cartesian gradient
6457 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6459 vv(1)=pizda(1,1)-pizda(2,2)
6460 vv(2)=pizda(1,2)+pizda(2,1)
6461 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6462 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6463 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6469 C Contribution from graph IV
6471 call transpose2(EE(1,1,itj),auxmat(1,1))
6472 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6473 vv(1)=pizda(1,1)+pizda(2,2)
6474 vv(2)=pizda(2,1)-pizda(1,2)
6475 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6476 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6478 C Explicit gradient in virtual-dihedral angles.
6479 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6480 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6481 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6482 vv(1)=pizda(1,1)+pizda(2,2)
6483 vv(2)=pizda(2,1)-pizda(1,2)
6484 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6485 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6486 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6487 C Cartesian gradient
6491 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6493 vv(1)=pizda(1,1)+pizda(2,2)
6494 vv(2)=pizda(2,1)-pizda(1,2)
6495 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6496 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6497 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6504 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6505 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6506 cd write (2,*) 'ijkl',i,j,k,l
6507 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6508 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6510 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6511 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6512 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6513 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6515 if (j.lt.nres-1) then
6522 if (l.lt.nres-1) then
6532 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6534 ggg1(ll)=eel5*g_contij(ll,1)
6535 ggg2(ll)=eel5*g_contij(ll,2)
6536 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6537 ghalf=0.5d0*ggg1(ll)
6539 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6540 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6541 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6542 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6543 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6544 ghalf=0.5d0*ggg2(ll)
6546 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6547 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6548 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6549 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6554 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6555 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6560 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6561 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6567 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6572 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6576 cd write (2,*) iii,g_corr5_loc(iii)
6580 cd write (2,*) 'ekont',ekont
6581 cd write (iout,*) 'eello5',ekont*eel5
6584 c--------------------------------------------------------------------------
6585 double precision function eello6(i,j,k,l,jj,kk)
6586 implicit real*8 (a-h,o-z)
6587 include 'DIMENSIONS'
6588 include 'sizesclu.dat'
6589 include 'COMMON.IOUNITS'
6590 include 'COMMON.CHAIN'
6591 include 'COMMON.DERIV'
6592 include 'COMMON.INTERACT'
6593 include 'COMMON.CONTACTS'
6594 include 'COMMON.TORSION'
6595 include 'COMMON.VAR'
6596 include 'COMMON.GEO'
6597 include 'COMMON.FFIELD'
6598 double precision ggg1(3),ggg2(3)
6599 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6604 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6612 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6613 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6617 derx(lll,kkk,iii)=0.0d0
6621 cd eij=facont_hb(jj,i)
6622 cd ekl=facont_hb(kk,k)
6628 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6629 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6630 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6631 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6632 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6633 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6635 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6636 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6637 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6638 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6639 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6640 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6644 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6646 C If turn contributions are considered, they will be handled separately.
6647 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6648 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6649 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6650 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6651 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6652 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6653 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6656 if (j.lt.nres-1) then
6663 if (l.lt.nres-1) then
6671 ggg1(ll)=eel6*g_contij(ll,1)
6672 ggg2(ll)=eel6*g_contij(ll,2)
6673 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6674 ghalf=0.5d0*ggg1(ll)
6676 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6677 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6678 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6679 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6680 ghalf=0.5d0*ggg2(ll)
6681 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6683 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6684 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6685 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6686 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6691 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6692 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6697 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6698 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6704 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6709 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6713 cd write (2,*) iii,g_corr6_loc(iii)
6717 cd write (2,*) 'ekont',ekont
6718 cd write (iout,*) 'eello6',ekont*eel6
6721 c--------------------------------------------------------------------------
6722 double precision function eello6_graph1(i,j,k,l,imat,swap)
6723 implicit real*8 (a-h,o-z)
6724 include 'DIMENSIONS'
6725 include 'sizesclu.dat'
6726 include 'COMMON.IOUNITS'
6727 include 'COMMON.CHAIN'
6728 include 'COMMON.DERIV'
6729 include 'COMMON.INTERACT'
6730 include 'COMMON.CONTACTS'
6731 include 'COMMON.TORSION'
6732 include 'COMMON.VAR'
6733 include 'COMMON.GEO'
6734 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6738 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6740 C Parallel Antiparallel C
6746 C \ j|/k\| / \ |/k\|l / C
6751 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6752 itk=itortyp(itype(k))
6753 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6754 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6755 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6756 call transpose2(EUgC(1,1,k),auxmat(1,1))
6757 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6758 vv1(1)=pizda1(1,1)-pizda1(2,2)
6759 vv1(2)=pizda1(1,2)+pizda1(2,1)
6760 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6761 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6762 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6763 s5=scalar2(vv(1),Dtobr2(1,i))
6764 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6765 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6766 if (.not. calc_grad) return
6767 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6768 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6769 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6770 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6771 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6772 & +scalar2(vv(1),Dtobr2der(1,i)))
6773 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6774 vv1(1)=pizda1(1,1)-pizda1(2,2)
6775 vv1(2)=pizda1(1,2)+pizda1(2,1)
6776 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6777 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6779 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6780 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6781 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6782 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6783 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6785 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6786 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6787 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6788 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6789 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6791 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6792 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6793 vv1(1)=pizda1(1,1)-pizda1(2,2)
6794 vv1(2)=pizda1(1,2)+pizda1(2,1)
6795 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6796 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6797 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6798 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6807 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6808 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6809 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6810 call transpose2(EUgC(1,1,k),auxmat(1,1))
6811 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6813 vv1(1)=pizda1(1,1)-pizda1(2,2)
6814 vv1(2)=pizda1(1,2)+pizda1(2,1)
6815 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6816 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6817 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6818 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6819 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6820 s5=scalar2(vv(1),Dtobr2(1,i))
6821 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6827 c----------------------------------------------------------------------------
6828 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6829 implicit real*8 (a-h,o-z)
6830 include 'DIMENSIONS'
6831 include 'sizesclu.dat'
6832 include 'COMMON.IOUNITS'
6833 include 'COMMON.CHAIN'
6834 include 'COMMON.DERIV'
6835 include 'COMMON.INTERACT'
6836 include 'COMMON.CONTACTS'
6837 include 'COMMON.TORSION'
6838 include 'COMMON.VAR'
6839 include 'COMMON.GEO'
6841 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6842 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6847 C Parallel Antiparallel C
6853 C \ j|/k\| \ |/k\|l C
6858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6859 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6860 C AL 7/4/01 s1 would occur in the sixth-order moment,
6861 C but not in a cluster cumulant
6863 s1=dip(1,jj,i)*dip(1,kk,k)
6865 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6866 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6867 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6868 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6869 call transpose2(EUg(1,1,k),auxmat(1,1))
6870 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6871 vv(1)=pizda(1,1)-pizda(2,2)
6872 vv(2)=pizda(1,2)+pizda(2,1)
6873 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6874 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6876 eello6_graph2=-(s1+s2+s3+s4)
6878 eello6_graph2=-(s2+s3+s4)
6881 if (.not. calc_grad) return
6882 C Derivatives in gamma(i-1)
6885 s1=dipderg(1,jj,i)*dip(1,kk,k)
6887 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6888 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6889 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6890 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6892 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6894 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6896 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6898 C Derivatives in gamma(k-1)
6900 s1=dip(1,jj,i)*dipderg(1,kk,k)
6902 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6903 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6904 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6905 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6906 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6907 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6908 vv(1)=pizda(1,1)-pizda(2,2)
6909 vv(2)=pizda(1,2)+pizda(2,1)
6910 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6912 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6914 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6916 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6917 C Derivatives in gamma(j-1) or gamma(l-1)
6920 s1=dipderg(3,jj,i)*dip(1,kk,k)
6922 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6923 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6924 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6925 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6926 vv(1)=pizda(1,1)-pizda(2,2)
6927 vv(2)=pizda(1,2)+pizda(2,1)
6928 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6931 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6933 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6936 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6937 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6939 C Derivatives in gamma(l-1) or gamma(j-1)
6942 s1=dip(1,jj,i)*dipderg(3,kk,k)
6944 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6945 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6946 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6947 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6948 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6949 vv(1)=pizda(1,1)-pizda(2,2)
6950 vv(2)=pizda(1,2)+pizda(2,1)
6951 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6954 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6956 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6959 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6960 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6962 C Cartesian derivatives.
6964 write (2,*) 'In eello6_graph2'
6966 write (2,*) 'iii=',iii
6968 write (2,*) 'kkk=',kkk
6970 write (2,'(3(2f10.5),5x)')
6971 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6981 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6983 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6986 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6988 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6989 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6991 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6992 call transpose2(EUg(1,1,k),auxmat(1,1))
6993 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6995 vv(1)=pizda(1,1)-pizda(2,2)
6996 vv(2)=pizda(1,2)+pizda(2,1)
6997 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6998 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7000 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7002 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7005 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7007 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7014 c----------------------------------------------------------------------------
7015 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7016 implicit real*8 (a-h,o-z)
7017 include 'DIMENSIONS'
7018 include 'sizesclu.dat'
7019 include 'COMMON.IOUNITS'
7020 include 'COMMON.CHAIN'
7021 include 'COMMON.DERIV'
7022 include 'COMMON.INTERACT'
7023 include 'COMMON.CONTACTS'
7024 include 'COMMON.TORSION'
7025 include 'COMMON.VAR'
7026 include 'COMMON.GEO'
7027 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7031 C Parallel Antiparallel C
7037 C j|/k\| / |/k\|l / C
7042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7044 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7045 C energy moment and not to the cluster cumulant.
7046 iti=itortyp(itype(i))
7047 c if (j.lt.nres-1) then
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 itk1=itortyp(itype(k+1))
7055 c if (l.lt.nres-1) then
7056 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7057 itl1=itortyp(itype(l+1))
7062 s1=dip(4,jj,i)*dip(4,kk,k)
7064 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7065 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7066 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7067 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7068 call transpose2(EE(1,1,itk),auxmat(1,1))
7069 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7070 vv(1)=pizda(1,1)+pizda(2,2)
7071 vv(2)=pizda(2,1)-pizda(1,2)
7072 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7073 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7075 eello6_graph3=-(s1+s2+s3+s4)
7077 eello6_graph3=-(s2+s3+s4)
7080 if (.not. calc_grad) return
7081 C Derivatives in gamma(k-1)
7082 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7083 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7084 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7085 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7086 C Derivatives in gamma(l-1)
7087 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7088 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7089 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7090 vv(1)=pizda(1,1)+pizda(2,2)
7091 vv(2)=pizda(2,1)-pizda(1,2)
7092 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7093 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7094 C Cartesian derivatives.
7100 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7102 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7105 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7107 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7108 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7110 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7111 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7113 vv(1)=pizda(1,1)+pizda(2,2)
7114 vv(2)=pizda(2,1)-pizda(1,2)
7115 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7117 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7119 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7122 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7124 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7126 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7132 c----------------------------------------------------------------------------
7133 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7134 implicit real*8 (a-h,o-z)
7135 include 'DIMENSIONS'
7136 include 'sizesclu.dat'
7137 include 'COMMON.IOUNITS'
7138 include 'COMMON.CHAIN'
7139 include 'COMMON.DERIV'
7140 include 'COMMON.INTERACT'
7141 include 'COMMON.CONTACTS'
7142 include 'COMMON.TORSION'
7143 include 'COMMON.VAR'
7144 include 'COMMON.GEO'
7145 include 'COMMON.FFIELD'
7146 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7147 & auxvec1(2),auxmat1(2,2)
7149 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7151 C Parallel Antiparallel C
7157 C \ j|/k\| \ |/k\|l C
7162 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7164 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7165 C energy moment and not to the cluster cumulant.
7166 cd write (2,*) 'eello_graph4: wturn6',wturn6
7167 iti=itortyp(itype(i))
7168 itj=itortyp(itype(j))
7169 c if (j.lt.nres-1) then
7170 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7171 itj1=itortyp(itype(j+1))
7175 itk=itortyp(itype(k))
7176 c if (k.lt.nres-1) then
7177 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7178 itk1=itortyp(itype(k+1))
7182 itl=itortyp(itype(l))
7183 if (l.lt.nres-1) then
7184 itl1=itortyp(itype(l+1))
7188 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7189 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7190 cd & ' itl',itl,' itl1',itl1
7193 s1=dip(3,jj,i)*dip(3,kk,k)
7195 s1=dip(2,jj,j)*dip(2,kk,l)
7198 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7199 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7201 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7202 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7204 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7205 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7207 call transpose2(EUg(1,1,k),auxmat(1,1))
7208 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7209 vv(1)=pizda(1,1)-pizda(2,2)
7210 vv(2)=pizda(2,1)+pizda(1,2)
7211 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7212 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7214 eello6_graph4=-(s1+s2+s3+s4)
7216 eello6_graph4=-(s2+s3+s4)
7218 if (.not. calc_grad) return
7219 C Derivatives in gamma(i-1)
7223 s1=dipderg(2,jj,i)*dip(3,kk,k)
7225 s1=dipderg(4,jj,j)*dip(2,kk,l)
7228 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7230 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7231 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7233 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7234 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7236 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7237 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7238 cd write (2,*) 'turn6 derivatives'
7240 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7242 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7246 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7248 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7252 C Derivatives in gamma(k-1)
7255 s1=dip(3,jj,i)*dipderg(2,kk,k)
7257 s1=dip(2,jj,j)*dipderg(4,kk,l)
7260 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7261 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7263 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7264 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7266 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7267 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7269 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7270 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7271 vv(1)=pizda(1,1)-pizda(2,2)
7272 vv(2)=pizda(2,1)+pizda(1,2)
7273 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7274 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7276 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7278 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7282 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7284 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7287 C Derivatives in gamma(j-1) or gamma(l-1)
7288 if (l.eq.j+1 .and. l.gt.1) then
7289 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7290 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7291 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7292 vv(1)=pizda(1,1)-pizda(2,2)
7293 vv(2)=pizda(2,1)+pizda(1,2)
7294 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7295 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7296 else if (j.gt.1) then
7297 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7298 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7299 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7300 vv(1)=pizda(1,1)-pizda(2,2)
7301 vv(2)=pizda(2,1)+pizda(1,2)
7302 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7303 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7304 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7306 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7309 C Cartesian derivatives.
7316 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7318 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7322 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7324 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7328 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7330 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7332 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7333 & b1(1,itj1),auxvec(1))
7334 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7336 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7337 & b1(1,itl1),auxvec(1))
7338 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7340 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7342 vv(1)=pizda(1,1)-pizda(2,2)
7343 vv(2)=pizda(2,1)+pizda(1,2)
7344 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7346 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7348 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7351 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7354 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7357 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7359 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7361 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7367 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7370 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7372 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7380 c----------------------------------------------------------------------------
7381 double precision function eello_turn6(i,jj,kk)
7382 implicit real*8 (a-h,o-z)
7383 include 'DIMENSIONS'
7384 include 'sizesclu.dat'
7385 include 'COMMON.IOUNITS'
7386 include 'COMMON.CHAIN'
7387 include 'COMMON.DERIV'
7388 include 'COMMON.INTERACT'
7389 include 'COMMON.CONTACTS'
7390 include 'COMMON.TORSION'
7391 include 'COMMON.VAR'
7392 include 'COMMON.GEO'
7393 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7394 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7396 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7397 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7398 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7399 C the respective energy moment and not to the cluster cumulant.
7404 iti=itortyp(itype(i))
7405 itk=itortyp(itype(k))
7406 itk1=itortyp(itype(k+1))
7407 itl=itortyp(itype(l))
7408 itj=itortyp(itype(j))
7409 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7410 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7411 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7416 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7418 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7422 derx_turn(lll,kkk,iii)=0.0d0
7429 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7431 cd write (2,*) 'eello6_5',eello6_5
7433 call transpose2(AEA(1,1,1),auxmat(1,1))
7434 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7435 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7436 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7440 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7441 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7442 s2 = scalar2(b1(1,itk),vtemp1(1))
7444 call transpose2(AEA(1,1,2),atemp(1,1))
7445 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7446 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7447 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7451 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7452 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7453 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7455 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7456 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7457 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7458 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7459 ss13 = scalar2(b1(1,itk),vtemp4(1))
7460 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7464 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7470 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7472 C Derivatives in gamma(i+2)
7474 call transpose2(AEA(1,1,1),auxmatd(1,1))
7475 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7476 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7477 call transpose2(AEAderg(1,1,2),atempd(1,1))
7478 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7479 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7483 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7484 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7485 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7491 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7492 C Derivatives in gamma(i+3)
7494 call transpose2(AEA(1,1,1),auxmatd(1,1))
7495 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7496 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7497 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7501 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7502 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7503 s2d = scalar2(b1(1,itk),vtemp1d(1))
7505 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7506 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7508 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7510 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7511 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7512 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7522 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7523 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7525 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7526 & -0.5d0*ekont*(s2d+s12d)
7528 C Derivatives in gamma(i+4)
7529 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7530 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7531 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7533 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7534 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7535 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7545 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7547 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7549 C Derivatives in gamma(i+5)
7551 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7552 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7553 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7557 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7558 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7559 s2d = scalar2(b1(1,itk),vtemp1d(1))
7561 call transpose2(AEA(1,1,2),atempd(1,1))
7562 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7563 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7567 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7568 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7570 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7571 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7572 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7582 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7583 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7585 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7586 & -0.5d0*ekont*(s2d+s12d)
7588 C Cartesian derivatives
7593 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7594 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7595 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7599 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7600 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7602 s2d = scalar2(b1(1,itk),vtemp1d(1))
7604 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7605 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7606 s8d = -(atempd(1,1)+atempd(2,2))*
7607 & scalar2(cc(1,1,itl),vtemp2(1))
7611 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7613 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7614 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7621 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7624 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7628 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7629 & - 0.5d0*(s8d+s12d)
7631 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7640 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7642 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7643 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7644 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7645 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7646 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7648 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7649 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7650 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7654 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7655 cd & 16*eel_turn6_num
7657 if (j.lt.nres-1) then
7664 if (l.lt.nres-1) then
7672 ggg1(ll)=eel_turn6*g_contij(ll,1)
7673 ggg2(ll)=eel_turn6*g_contij(ll,2)
7674 ghalf=0.5d0*ggg1(ll)
7676 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7677 & +ekont*derx_turn(ll,2,1)
7678 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7679 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7680 & +ekont*derx_turn(ll,4,1)
7681 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7682 ghalf=0.5d0*ggg2(ll)
7684 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7685 & +ekont*derx_turn(ll,2,2)
7686 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7687 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7688 & +ekont*derx_turn(ll,4,2)
7689 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7694 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7699 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7705 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7710 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7714 cd write (2,*) iii,g_corr6_loc(iii)
7717 eello_turn6=ekont*eel_turn6
7718 cd write (2,*) 'ekont',ekont
7719 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7722 crc-------------------------------------------------
7723 SUBROUTINE MATVEC2(A1,V1,V2)
7724 implicit real*8 (a-h,o-z)
7725 include 'DIMENSIONS'
7726 DIMENSION A1(2,2),V1(2),V2(2)
7730 c 3 VI=VI+A1(I,K)*V1(K)
7734 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7735 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7740 C---------------------------------------
7741 SUBROUTINE MATMAT2(A1,A2,A3)
7742 implicit real*8 (a-h,o-z)
7743 include 'DIMENSIONS'
7744 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7745 c DIMENSION AI3(2,2)
7749 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7755 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7756 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7757 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7758 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7766 c-------------------------------------------------------------------------
7767 double precision function scalar2(u,v)
7769 double precision u(2),v(2)
7772 scalar2=u(1)*v(1)+u(2)*v(2)
7776 C-----------------------------------------------------------------------------
7778 subroutine transpose2(a,at)
7780 double precision a(2,2),at(2,2)
7787 c--------------------------------------------------------------------------
7788 subroutine transpose(n,a,at)
7791 double precision a(n,n),at(n,n)
7799 C---------------------------------------------------------------------------
7800 subroutine prodmat3(a1,a2,kk,transp,prod)
7803 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7805 crc double precision auxmat(2,2),prod_(2,2)
7808 crc call transpose2(kk(1,1),auxmat(1,1))
7809 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7810 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7812 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7813 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7814 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7815 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7816 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7817 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7818 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7819 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7822 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7823 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7825 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7826 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7827 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7828 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7829 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7830 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7831 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7832 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7835 c call transpose2(a2(1,1),a2t(1,1))
7838 crc print *,((prod_(i,j),i=1,2),j=1,2)
7839 crc print *,((prod(i,j),i=1,2),j=1,2)
7843 C-----------------------------------------------------------------------------
7844 double precision function scalar(u,v)
7846 double precision u(3),v(3)
7856 C-----------------------------------------------------------------------
7857 double precision function sscale(r)
7858 double precision r,gamm
7859 include "COMMON.SPLITELE"
7860 if(r.lt.r_cut-rlamb) then
7862 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7863 gamm=(r-(r_cut-rlamb))/rlamb
7864 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7870 C-----------------------------------------------------------------------
7871 C-----------------------------------------------------------------------
7872 double precision function sscagrad(r)
7873 double precision r,gamm
7874 include "COMMON.SPLITELE"
7875 if(r.lt.r_cut-rlamb) then
7877 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7878 gamm=(r-(r_cut-rlamb))/rlamb
7879 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7885 C-----------------------------------------------------------------------