1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C write(iout,*) 'po eelec'
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
63 C write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
73 C print *,'Bend energy finished.'
74 call ebend(ebe,ethetacnstr)
75 cd print *,'Bend energy finished.'
77 C Calculate the SC local energy.
80 C print *,'SCLOC energy finished.'
82 C Calculate the virtual-bond torsional energy.
84 cd print *,'nterm=',nterm
85 call etor(etors,edihcnstr,fact(1))
87 C 6/23/01 Calculate double-torsional energy
89 call etor_d(etors_d,fact(2))
91 C 21/5/07 Calculate local sicdechain correlation energy
93 call eback_sc_corr(esccor)
95 C 12/1/95 Multi-body terms
99 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
100 & .or. wturn6.gt.0.0d0) then
101 c print *,"calling multibody_eello"
102 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
103 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
104 c print *,ecorr,ecorr5,ecorr6,eturn6
106 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
107 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
109 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
111 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
113 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
114 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
115 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
116 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
117 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
118 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
120 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
121 & +welec*fact(1)*(ees+evdw1)
122 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
123 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
124 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
125 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
126 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
127 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
132 energia(2)=evdw2-evdw2_14
149 energia(8)=eello_turn3
150 energia(9)=eello_turn4
159 energia(20)=edihcnstr
161 energia(24)=ethetacnstr
165 if (isnan(etot).ne.0) energia(0)=1.0d+99
167 if (isnan(etot)) energia(0)=1.0d+99
172 idumm=proc_proc(etot,i)
174 call proc_proc(etot,i)
176 if(i.eq.1)energia(0)=1.0d+99
183 C Sum up the components of the Cartesian gradient.
188 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
189 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
191 & wstrain*ghpbc(j,i)+
192 & wcorr*fact(3)*gradcorr(j,i)+
193 & wel_loc*fact(2)*gel_loc(j,i)+
194 & wturn3*fact(2)*gcorr3_turn(j,i)+
195 & wturn4*fact(3)*gcorr4_turn(j,i)+
196 & wcorr5*fact(4)*gradcorr5(j,i)+
197 & wcorr6*fact(5)*gradcorr6(j,i)+
198 & wturn6*fact(5)*gcorr6_turn(j,i)+
199 & wsccor*fact(2)*gsccorc(j,i)
200 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
202 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
203 & wsccor*fact(2)*gsccorx(j,i)
208 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
209 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
211 & wcorr*fact(3)*gradcorr(j,i)+
212 & wel_loc*fact(2)*gel_loc(j,i)+
213 & wturn3*fact(2)*gcorr3_turn(j,i)+
214 & wturn4*fact(3)*gcorr4_turn(j,i)+
215 & wcorr5*fact(4)*gradcorr5(j,i)+
216 & wcorr6*fact(5)*gradcorr6(j,i)+
217 & wturn6*fact(5)*gcorr6_turn(j,i)+
218 & wsccor*fact(2)*gsccorc(j,i)
219 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
221 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
222 & wsccor*fact(1)*gsccorx(j,i)
229 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
230 & +wcorr5*fact(4)*g_corr5_loc(i)
231 & +wcorr6*fact(5)*g_corr6_loc(i)
232 & +wturn4*fact(3)*gel_loc_turn4(i)
233 & +wturn3*fact(2)*gel_loc_turn3(i)
234 & +wturn6*fact(5)*gel_loc_turn6(i)
235 & +wel_loc*fact(2)*gel_loc_loc(i)
236 c & +wsccor*fact(1)*gsccor_loc(i)
237 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
240 if (dyn_ss) call dyn_set_nss
243 C------------------------------------------------------------------------
244 subroutine enerprint(energia,fact)
245 implicit real*8 (a-h,o-z)
247 include 'DIMENSIONS.ZSCOPT'
248 include 'COMMON.IOUNITS'
249 include 'COMMON.FFIELD'
250 include 'COMMON.SBRIDGE'
251 double precision energia(0:max_ene),fact(6)
253 evdw=energia(1)+fact(6)*energia(21)
255 evdw2=energia(2)+energia(17)
267 eello_turn3=energia(8)
268 eello_turn4=energia(9)
269 eello_turn6=energia(10)
276 edihcnstr=energia(20)
278 ethetacnstr=energia(24)
280 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
282 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
283 & etors_d,wtor_d*fact(2),ehpb,wstrain,
284 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
285 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
286 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
287 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
288 10 format (/'Virtual-chain energies:'//
289 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
290 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
291 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
292 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
293 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
294 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
295 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
296 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
297 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
298 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
299 & ' (SS bridges & dist. cnstr.)'/
300 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
301 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
302 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
303 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
304 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
305 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
306 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
307 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
308 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
309 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
310 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
311 & 'ETOT= ',1pE16.6,' (total)')
313 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
314 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
315 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
316 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
317 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
318 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
319 & edihcnstr,ethetacnstr,ebr*nss,etot
320 10 format (/'Virtual-chain energies:'//
321 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
322 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
323 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
324 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
325 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
326 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
327 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
328 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
329 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
330 & ' (SS bridges & dist. cnstr.)'/
331 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
332 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
333 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
334 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
335 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
336 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
337 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
338 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
339 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
340 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
341 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
342 & 'ETOT= ',1pE16.6,' (total)')
346 C-----------------------------------------------------------------------
347 subroutine elj(evdw,evdw_t)
349 C This subroutine calculates the interaction energy of nonbonded side chains
350 C assuming the LJ potential of interaction.
352 implicit real*8 (a-h,o-z)
354 include 'DIMENSIONS.ZSCOPT'
355 include "DIMENSIONS.COMPAR"
356 parameter (accur=1.0d-10)
359 include 'COMMON.LOCAL'
360 include 'COMMON.CHAIN'
361 include 'COMMON.DERIV'
362 include 'COMMON.INTERACT'
363 include 'COMMON.TORSION'
364 include 'COMMON.ENEPS'
365 include 'COMMON.SBRIDGE'
366 include 'COMMON.NAMES'
367 include 'COMMON.IOUNITS'
368 include 'COMMON.CONTACTS'
372 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
376 eneps_temp(j,i)=0.0d0
385 if (itypi.eq.ntyp1) cycle
386 itypi1=iabs(itype(i+1))
393 C Calculate SC interaction energy.
396 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
397 cd & 'iend=',iend(i,iint)
398 do j=istart(i,iint),iend(i,iint)
400 if (itypj.eq.ntyp1) cycle
404 C Change 12/1/95 to calculate four-body interactions
405 rij=xj*xj+yj*yj+zj*zj
407 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
408 eps0ij=eps(itypi,itypj)
410 e1=fac*fac*aa(itypi,itypj)
411 e2=fac*bb(itypi,itypj)
413 ij=icant(itypi,itypj)
415 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
416 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
419 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
420 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
421 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
422 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
423 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
424 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
425 if (bb(itypi,itypj).gt.0.0d0) then
432 C Calculate the components of the gradient in DC and X
434 fac=-rrij*(e1+evdwij)
439 gvdwx(k,i)=gvdwx(k,i)-gg(k)
440 gvdwx(k,j)=gvdwx(k,j)+gg(k)
444 gvdwc(l,k)=gvdwc(l,k)+gg(l)
449 C 12/1/95, revised on 5/20/97
451 C Calculate the contact function. The ith column of the array JCONT will
452 C contain the numbers of atoms that make contacts with the atom I (of numbers
453 C greater than I). The arrays FACONT and GACONT will contain the values of
454 C the contact function and its derivative.
456 C Uncomment next line, if the correlation interactions include EVDW explicitly.
457 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
458 C Uncomment next line, if the correlation interactions are contact function only
459 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
461 sigij=sigma(itypi,itypj)
462 r0ij=rs0(itypi,itypj)
464 C Check whether the SC's are not too far to make a contact.
467 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
468 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
470 if (fcont.gt.0.0D0) then
471 C If the SC-SC distance if close to sigma, apply spline.
472 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
473 cAdam & fcont1,fprimcont1)
474 cAdam fcont1=1.0d0-fcont1
475 cAdam if (fcont1.gt.0.0d0) then
476 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
477 cAdam fcont=fcont*fcont1
479 C Uncomment following 4 lines to have the geometric average of the epsilon0's
480 cga eps0ij=1.0d0/dsqrt(eps0ij)
482 cga gg(k)=gg(k)*eps0ij
484 cga eps0ij=-evdwij*eps0ij
485 C Uncomment for AL's type of SC correlation interactions.
487 num_conti=num_conti+1
489 facont(num_conti,i)=fcont*eps0ij
490 fprimcont=eps0ij*fprimcont/rij
492 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
493 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
494 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
495 C Uncomment following 3 lines for Skolnick's type of SC correlation.
496 gacont(1,num_conti,i)=-fprimcont*xj
497 gacont(2,num_conti,i)=-fprimcont*yj
498 gacont(3,num_conti,i)=-fprimcont*zj
499 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
500 cd write (iout,'(2i3,3f10.5)')
501 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
507 num_cont(i)=num_conti
512 gvdwc(j,i)=expon*gvdwc(j,i)
513 gvdwx(j,i)=expon*gvdwx(j,i)
517 C******************************************************************************
521 C To save time, the factor of EXPON has been extracted from ALL components
522 C of GVDWC and GRADX. Remember to multiply them by this factor before further
525 C******************************************************************************
528 C-----------------------------------------------------------------------------
529 subroutine eljk(evdw,evdw_t)
531 C This subroutine calculates the interaction energy of nonbonded side chains
532 C assuming the LJK potential of interaction.
534 implicit real*8 (a-h,o-z)
536 include 'DIMENSIONS.ZSCOPT'
537 include "DIMENSIONS.COMPAR"
540 include 'COMMON.LOCAL'
541 include 'COMMON.CHAIN'
542 include 'COMMON.DERIV'
543 include 'COMMON.INTERACT'
544 include 'COMMON.ENEPS'
545 include 'COMMON.IOUNITS'
546 include 'COMMON.NAMES'
551 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
554 eneps_temp(j,i)=0.0d0
561 if (itypi.eq.ntyp1) cycle
562 itypi1=iabs(itype(i+1))
567 C Calculate SC interaction energy.
570 do j=istart(i,iint),iend(i,iint)
572 if (itypj.eq.ntyp1) cycle
576 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
578 e_augm=augm(itypi,itypj)*fac_augm
581 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
582 fac=r_shift_inv**expon
583 e1=fac*fac*aa(itypi,itypj)
584 e2=fac*bb(itypi,itypj)
586 ij=icant(itypi,itypj)
587 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
588 & /dabs(eps(itypi,itypj))
589 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
590 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
591 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
592 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
593 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
594 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
595 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
596 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
597 if (bb(itypi,itypj).gt.0.0d0) then
604 C Calculate the components of the gradient in DC and X
606 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
611 gvdwx(k,i)=gvdwx(k,i)-gg(k)
612 gvdwx(k,j)=gvdwx(k,j)+gg(k)
616 gvdwc(l,k)=gvdwc(l,k)+gg(l)
626 gvdwc(j,i)=expon*gvdwc(j,i)
627 gvdwx(j,i)=expon*gvdwx(j,i)
633 C-----------------------------------------------------------------------------
634 subroutine ebp(evdw,evdw_t)
636 C This subroutine calculates the interaction energy of nonbonded side chains
637 C assuming the Berne-Pechukas potential of interaction.
639 implicit real*8 (a-h,o-z)
641 include 'DIMENSIONS.ZSCOPT'
642 include "DIMENSIONS.COMPAR"
645 include 'COMMON.LOCAL'
646 include 'COMMON.CHAIN'
647 include 'COMMON.DERIV'
648 include 'COMMON.NAMES'
649 include 'COMMON.INTERACT'
650 include 'COMMON.ENEPS'
651 include 'COMMON.IOUNITS'
652 include 'COMMON.CALC'
654 c double precision rrsave(maxdim)
660 eneps_temp(j,i)=0.0d0
665 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
666 c if (icall.eq.0) then
674 if (itypi.eq.ntyp1) cycle
675 itypi1=iabs(itype(i+1))
679 dxi=dc_norm(1,nres+i)
680 dyi=dc_norm(2,nres+i)
681 dzi=dc_norm(3,nres+i)
682 dsci_inv=vbld_inv(i+nres)
684 C Calculate SC interaction energy.
687 do j=istart(i,iint),iend(i,iint)
690 if (itypj.eq.ntyp1) cycle
691 dscj_inv=vbld_inv(j+nres)
692 chi1=chi(itypi,itypj)
693 chi2=chi(itypj,itypi)
700 alf12=0.5D0*(alf1+alf2)
701 C For diagnostics only!!!
714 dxj=dc_norm(1,nres+j)
715 dyj=dc_norm(2,nres+j)
716 dzj=dc_norm(3,nres+j)
717 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
718 cd if (icall.eq.0) then
724 C Calculate the angle-dependent terms of energy & contributions to derivatives.
726 C Calculate whole angle-dependent part of epsilon and contributions
728 fac=(rrij*sigsq)**expon2
729 e1=fac*fac*aa(itypi,itypj)
730 e2=fac*bb(itypi,itypj)
731 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
732 eps2der=evdwij*eps3rt
733 eps3der=evdwij*eps2rt
734 evdwij=evdwij*eps2rt*eps3rt
735 ij=icant(itypi,itypj)
736 aux=eps1*eps2rt**2*eps3rt**2
737 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
738 & /dabs(eps(itypi,itypj))
739 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
740 if (bb(itypi,itypj).gt.0.0d0) then
747 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
748 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
749 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
750 & restyp(itypi),i,restyp(itypj),j,
751 & epsi,sigm,chi1,chi2,chip1,chip2,
752 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
753 & om1,om2,om12,1.0D0/dsqrt(rrij),
756 C Calculate gradient components.
757 e1=e1*eps1*eps2rt**2*eps3rt**2
758 fac=-expon*(e1+evdwij)
761 C Calculate radial part of the gradient
765 C Calculate the angular part of the gradient and sum add the contributions
766 C to the appropriate components of the Cartesian gradient.
775 C-----------------------------------------------------------------------------
776 subroutine egb(evdw,evdw_t)
778 C This subroutine calculates the interaction energy of nonbonded side chains
779 C assuming the Gay-Berne potential of interaction.
781 implicit real*8 (a-h,o-z)
783 include 'DIMENSIONS.ZSCOPT'
784 include "DIMENSIONS.COMPAR"
787 include 'COMMON.LOCAL'
788 include 'COMMON.CHAIN'
789 include 'COMMON.DERIV'
790 include 'COMMON.NAMES'
791 include 'COMMON.INTERACT'
792 include 'COMMON.ENEPS'
793 include 'COMMON.IOUNITS'
794 include 'COMMON.CALC'
795 include 'COMMON.SBRIDGE'
802 eneps_temp(j,i)=0.0d0
805 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
809 c if (icall.gt.0) lprn=.true.
813 if (itypi.eq.ntyp1) cycle
814 itypi1=iabs(itype(i+1))
818 C returning the ith atom to box
820 if (xi.lt.0) xi=xi+boxxsize
822 if (yi.lt.0) yi=yi+boxysize
824 if (zi.lt.0) zi=zi+boxzsize
826 dxi=dc_norm(1,nres+i)
827 dyi=dc_norm(2,nres+i)
828 dzi=dc_norm(3,nres+i)
829 dsci_inv=vbld_inv(i+nres)
831 C Calculate SC interaction energy.
834 do j=istart(i,iint),iend(i,iint)
835 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
836 call dyn_ssbond_ene(i,j,evdwij)
838 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
839 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
840 C triple bond artifac removal
841 do k=j+1,iend(i,iint)
842 C search over all next residues
843 if (dyn_ss_mask(k)) then
844 C check if they are cysteins
845 C write(iout,*) 'k=',k
846 call triple_ssbond_ene(i,j,k,evdwij)
847 C call the energy function that removes the artifical triple disulfide
848 C bond the soubroutine is located in ssMD.F
850 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
851 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
857 if (itypj.eq.ntyp1) cycle
858 dscj_inv=vbld_inv(j+nres)
859 sig0ij=sigma(itypi,itypj)
860 chi1=chi(itypi,itypj)
861 chi2=chi(itypj,itypi)
868 alf12=0.5D0*(alf1+alf2)
869 C For diagnostics only!!!
882 C returning jth atom to box
884 if (xj.lt.0) xj=xj+boxxsize
886 if (yj.lt.0) yj=yj+boxysize
888 if (zj.lt.0) zj=zj+boxzsize
889 C checking the distance
890 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
895 C finding the closest
899 xj=xj_safe+xshift*boxxsize
900 yj=yj_safe+yshift*boxysize
901 zj=zj_safe+zshift*boxzsize
902 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
903 if(dist_temp.lt.dist_init) then
913 if (subchap.eq.1) then
923 dxj=dc_norm(1,nres+j)
924 dyj=dc_norm(2,nres+j)
925 dzj=dc_norm(3,nres+j)
926 c write (iout,*) i,j,xj,yj,zj
927 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
929 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
930 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
931 if (sss.le.0.0) cycle
932 C Calculate angle-dependent terms of energy and contributions to their
936 sig=sig0ij*dsqrt(sigsq)
937 rij_shift=1.0D0/rij-sig+sig0ij
938 C I hate to put IF's in the loops, but here don't have another choice!!!!
939 if (rij_shift.le.0.0D0) then
944 c---------------------------------------------------------------
945 rij_shift=1.0D0/rij_shift
947 e1=fac*fac*aa(itypi,itypj)
948 e2=fac*bb(itypi,itypj)
949 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
950 eps2der=evdwij*eps3rt
951 eps3der=evdwij*eps2rt
952 evdwij=evdwij*eps2rt*eps3rt
953 if (bb(itypi,itypj).gt.0) then
956 evdw_t=evdw_t+evdwij*sss
958 ij=icant(itypi,itypj)
959 aux=eps1*eps2rt**2*eps3rt**2
960 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
961 & /dabs(eps(itypi,itypj))
962 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
963 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
964 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
965 c & aux*e2/eps(itypi,itypj)
967 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
968 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
970 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
971 & restyp(itypi),i,restyp(itypj),j,
972 & epsi,sigm,chi1,chi2,chip1,chip2,
973 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
974 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
976 write (iout,*) "partial sum", evdw, evdw_t
980 C Calculate gradient components.
981 e1=e1*eps1*eps2rt**2*eps3rt**2
982 fac=-expon*(e1+evdwij)*rij_shift
985 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
986 C Calculate the radial part of the gradient
990 C Calculate angular part of the gradient.
993 C write(iout,*) "partial sum", evdw, evdw_t
1000 C-----------------------------------------------------------------------------
1001 subroutine egbv(evdw,evdw_t)
1003 C This subroutine calculates the interaction energy of nonbonded side chains
1004 C assuming the Gay-Berne-Vorobjev potential of interaction.
1006 implicit real*8 (a-h,o-z)
1007 include 'DIMENSIONS'
1008 include 'DIMENSIONS.ZSCOPT'
1009 include "DIMENSIONS.COMPAR"
1010 include 'COMMON.GEO'
1011 include 'COMMON.VAR'
1012 include 'COMMON.LOCAL'
1013 include 'COMMON.CHAIN'
1014 include 'COMMON.DERIV'
1015 include 'COMMON.NAMES'
1016 include 'COMMON.INTERACT'
1017 include 'COMMON.ENEPS'
1018 include 'COMMON.IOUNITS'
1019 include 'COMMON.CALC'
1020 common /srutu/ icall
1026 eneps_temp(j,i)=0.0d0
1031 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1034 c if (icall.gt.0) lprn=.true.
1036 do i=iatsc_s,iatsc_e
1037 itypi=iabs(itype(i))
1038 if (itypi.eq.ntyp1) cycle
1039 itypi1=iabs(itype(i+1))
1043 dxi=dc_norm(1,nres+i)
1044 dyi=dc_norm(2,nres+i)
1045 dzi=dc_norm(3,nres+i)
1046 dsci_inv=vbld_inv(i+nres)
1048 C Calculate SC interaction energy.
1050 do iint=1,nint_gr(i)
1051 do j=istart(i,iint),iend(i,iint)
1053 itypj=iabs(itype(j))
1054 if (itypj.eq.ntyp1) cycle
1055 dscj_inv=vbld_inv(j+nres)
1056 sig0ij=sigma(itypi,itypj)
1057 r0ij=r0(itypi,itypj)
1058 chi1=chi(itypi,itypj)
1059 chi2=chi(itypj,itypi)
1066 alf12=0.5D0*(alf1+alf2)
1067 C For diagnostics only!!!
1080 dxj=dc_norm(1,nres+j)
1081 dyj=dc_norm(2,nres+j)
1082 dzj=dc_norm(3,nres+j)
1083 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1085 C Calculate angle-dependent terms of energy and contributions to their
1089 sig=sig0ij*dsqrt(sigsq)
1090 rij_shift=1.0D0/rij-sig+r0ij
1091 C I hate to put IF's in the loops, but here don't have another choice!!!!
1092 if (rij_shift.le.0.0D0) then
1097 c---------------------------------------------------------------
1098 rij_shift=1.0D0/rij_shift
1099 fac=rij_shift**expon
1100 e1=fac*fac*aa(itypi,itypj)
1101 e2=fac*bb(itypi,itypj)
1102 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1103 eps2der=evdwij*eps3rt
1104 eps3der=evdwij*eps2rt
1105 fac_augm=rrij**expon
1106 e_augm=augm(itypi,itypj)*fac_augm
1107 evdwij=evdwij*eps2rt*eps3rt
1108 if (bb(itypi,itypj).gt.0.0d0) then
1109 evdw=evdw+evdwij+e_augm
1111 evdw_t=evdw_t+evdwij+e_augm
1113 ij=icant(itypi,itypj)
1114 aux=eps1*eps2rt**2*eps3rt**2
1115 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1116 & /dabs(eps(itypi,itypj))
1117 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1118 c eneps_temp(ij)=eneps_temp(ij)
1119 c & +(evdwij+e_augm)/eps(itypi,itypj)
1121 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1122 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1123 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1124 c & restyp(itypi),i,restyp(itypj),j,
1125 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1126 c & chi1,chi2,chip1,chip2,
1127 c & eps1,eps2rt**2,eps3rt**2,
1128 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1132 C Calculate gradient components.
1133 e1=e1*eps1*eps2rt**2*eps3rt**2
1134 fac=-expon*(e1+evdwij)*rij_shift
1136 fac=rij*fac-2*expon*rrij*e_augm
1137 C Calculate the radial part of the gradient
1141 C Calculate angular part of the gradient.
1149 C-----------------------------------------------------------------------------
1150 subroutine sc_angular
1151 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1152 C om12. Called by ebp, egb, and egbv.
1154 include 'COMMON.CALC'
1158 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1159 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1160 om12=dxi*dxj+dyi*dyj+dzi*dzj
1162 C Calculate eps1(om12) and its derivative in om12
1163 faceps1=1.0D0-om12*chiom12
1164 faceps1_inv=1.0D0/faceps1
1165 eps1=dsqrt(faceps1_inv)
1166 C Following variable is eps1*deps1/dom12
1167 eps1_om12=faceps1_inv*chiom12
1168 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1173 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1174 sigsq=1.0D0-facsig*faceps1_inv
1175 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1176 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1177 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1178 C Calculate eps2 and its derivatives in om1, om2, and om12.
1181 chipom12=chip12*om12
1182 facp=1.0D0-om12*chipom12
1184 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1185 C Following variable is the square root of eps2
1186 eps2rt=1.0D0-facp1*facp_inv
1187 C Following three variables are the derivatives of the square root of eps
1188 C in om1, om2, and om12.
1189 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1190 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1191 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1192 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1193 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1194 C Calculate whole angle-dependent part of epsilon and contributions
1195 C to its derivatives
1198 C----------------------------------------------------------------------------
1200 implicit real*8 (a-h,o-z)
1201 include 'DIMENSIONS'
1202 include 'DIMENSIONS.ZSCOPT'
1203 include 'COMMON.CHAIN'
1204 include 'COMMON.DERIV'
1205 include 'COMMON.CALC'
1206 double precision dcosom1(3),dcosom2(3)
1207 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1208 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1209 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1210 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1212 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1213 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1216 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1219 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1220 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1221 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1222 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1223 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1224 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1227 C Calculate the components of the gradient in DC and X
1231 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1236 c------------------------------------------------------------------------------
1237 subroutine vec_and_deriv
1238 implicit real*8 (a-h,o-z)
1239 include 'DIMENSIONS'
1240 include 'DIMENSIONS.ZSCOPT'
1241 include 'COMMON.IOUNITS'
1242 include 'COMMON.GEO'
1243 include 'COMMON.VAR'
1244 include 'COMMON.LOCAL'
1245 include 'COMMON.CHAIN'
1246 include 'COMMON.VECTORS'
1247 include 'COMMON.DERIV'
1248 include 'COMMON.INTERACT'
1249 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1250 C Compute the local reference systems. For reference system (i), the
1251 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1252 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1254 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1255 if (i.eq.nres-1) then
1256 C Case of the last full residue
1257 C Compute the Z-axis
1258 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1259 costh=dcos(pi-theta(nres))
1260 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1265 C Compute the derivatives of uz
1267 uzder(2,1,1)=-dc_norm(3,i-1)
1268 uzder(3,1,1)= dc_norm(2,i-1)
1269 uzder(1,2,1)= dc_norm(3,i-1)
1271 uzder(3,2,1)=-dc_norm(1,i-1)
1272 uzder(1,3,1)=-dc_norm(2,i-1)
1273 uzder(2,3,1)= dc_norm(1,i-1)
1276 uzder(2,1,2)= dc_norm(3,i)
1277 uzder(3,1,2)=-dc_norm(2,i)
1278 uzder(1,2,2)=-dc_norm(3,i)
1280 uzder(3,2,2)= dc_norm(1,i)
1281 uzder(1,3,2)= dc_norm(2,i)
1282 uzder(2,3,2)=-dc_norm(1,i)
1285 C Compute the Y-axis
1288 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1291 C Compute the derivatives of uy
1294 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1295 & -dc_norm(k,i)*dc_norm(j,i-1)
1296 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1298 uyder(j,j,1)=uyder(j,j,1)-costh
1299 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1304 uygrad(l,k,j,i)=uyder(l,k,j)
1305 uzgrad(l,k,j,i)=uzder(l,k,j)
1309 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1310 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1311 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1312 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1316 C Compute the Z-axis
1317 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1318 costh=dcos(pi-theta(i+2))
1319 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1324 C Compute the derivatives of uz
1326 uzder(2,1,1)=-dc_norm(3,i+1)
1327 uzder(3,1,1)= dc_norm(2,i+1)
1328 uzder(1,2,1)= dc_norm(3,i+1)
1330 uzder(3,2,1)=-dc_norm(1,i+1)
1331 uzder(1,3,1)=-dc_norm(2,i+1)
1332 uzder(2,3,1)= dc_norm(1,i+1)
1335 uzder(2,1,2)= dc_norm(3,i)
1336 uzder(3,1,2)=-dc_norm(2,i)
1337 uzder(1,2,2)=-dc_norm(3,i)
1339 uzder(3,2,2)= dc_norm(1,i)
1340 uzder(1,3,2)= dc_norm(2,i)
1341 uzder(2,3,2)=-dc_norm(1,i)
1344 C Compute the Y-axis
1347 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1350 C Compute the derivatives of uy
1353 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1354 & -dc_norm(k,i)*dc_norm(j,i+1)
1355 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1357 uyder(j,j,1)=uyder(j,j,1)-costh
1358 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1363 uygrad(l,k,j,i)=uyder(l,k,j)
1364 uzgrad(l,k,j,i)=uzder(l,k,j)
1368 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1369 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1370 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1371 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1377 vbld_inv_temp(1)=vbld_inv(i+1)
1378 if (i.lt.nres-1) then
1379 vbld_inv_temp(2)=vbld_inv(i+2)
1381 vbld_inv_temp(2)=vbld_inv(i)
1386 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1387 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1395 C-----------------------------------------------------------------------------
1396 subroutine vec_and_deriv_test
1397 implicit real*8 (a-h,o-z)
1398 include 'DIMENSIONS'
1399 include 'DIMENSIONS.ZSCOPT'
1400 include 'COMMON.IOUNITS'
1401 include 'COMMON.GEO'
1402 include 'COMMON.VAR'
1403 include 'COMMON.LOCAL'
1404 include 'COMMON.CHAIN'
1405 include 'COMMON.VECTORS'
1406 dimension uyder(3,3,2),uzder(3,3,2)
1407 C Compute the local reference systems. For reference system (i), the
1408 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1409 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1411 if (i.eq.nres-1) then
1412 C Case of the last full residue
1413 C Compute the Z-axis
1414 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1415 costh=dcos(pi-theta(nres))
1416 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1417 c write (iout,*) 'fac',fac,
1418 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1419 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1423 C Compute the derivatives of uz
1425 uzder(2,1,1)=-dc_norm(3,i-1)
1426 uzder(3,1,1)= dc_norm(2,i-1)
1427 uzder(1,2,1)= dc_norm(3,i-1)
1429 uzder(3,2,1)=-dc_norm(1,i-1)
1430 uzder(1,3,1)=-dc_norm(2,i-1)
1431 uzder(2,3,1)= dc_norm(1,i-1)
1434 uzder(2,1,2)= dc_norm(3,i)
1435 uzder(3,1,2)=-dc_norm(2,i)
1436 uzder(1,2,2)=-dc_norm(3,i)
1438 uzder(3,2,2)= dc_norm(1,i)
1439 uzder(1,3,2)= dc_norm(2,i)
1440 uzder(2,3,2)=-dc_norm(1,i)
1442 C Compute the Y-axis
1444 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1447 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1448 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1449 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1451 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1454 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1455 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1458 c write (iout,*) 'facy',facy,
1459 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1460 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1462 uy(k,i)=facy*uy(k,i)
1464 C Compute the derivatives of uy
1467 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1468 & -dc_norm(k,i)*dc_norm(j,i-1)
1469 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1471 c uyder(j,j,1)=uyder(j,j,1)-costh
1472 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1473 uyder(j,j,1)=uyder(j,j,1)
1474 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1475 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1481 uygrad(l,k,j,i)=uyder(l,k,j)
1482 uzgrad(l,k,j,i)=uzder(l,k,j)
1486 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1487 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1488 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1489 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1492 C Compute the Z-axis
1493 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1494 costh=dcos(pi-theta(i+2))
1495 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1496 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1500 C Compute the derivatives of uz
1502 uzder(2,1,1)=-dc_norm(3,i+1)
1503 uzder(3,1,1)= dc_norm(2,i+1)
1504 uzder(1,2,1)= dc_norm(3,i+1)
1506 uzder(3,2,1)=-dc_norm(1,i+1)
1507 uzder(1,3,1)=-dc_norm(2,i+1)
1508 uzder(2,3,1)= dc_norm(1,i+1)
1511 uzder(2,1,2)= dc_norm(3,i)
1512 uzder(3,1,2)=-dc_norm(2,i)
1513 uzder(1,2,2)=-dc_norm(3,i)
1515 uzder(3,2,2)= dc_norm(1,i)
1516 uzder(1,3,2)= dc_norm(2,i)
1517 uzder(2,3,2)=-dc_norm(1,i)
1519 C Compute the Y-axis
1521 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1522 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1523 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1525 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1528 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1529 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1532 c write (iout,*) 'facy',facy,
1533 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1534 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1536 uy(k,i)=facy*uy(k,i)
1538 C Compute the derivatives of uy
1541 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1542 & -dc_norm(k,i)*dc_norm(j,i+1)
1543 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1545 c uyder(j,j,1)=uyder(j,j,1)-costh
1546 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1547 uyder(j,j,1)=uyder(j,j,1)
1548 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1549 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1555 uygrad(l,k,j,i)=uyder(l,k,j)
1556 uzgrad(l,k,j,i)=uzder(l,k,j)
1560 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1561 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1562 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1563 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1570 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1571 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1578 C-----------------------------------------------------------------------------
1579 subroutine check_vecgrad
1580 implicit real*8 (a-h,o-z)
1581 include 'DIMENSIONS'
1582 include 'DIMENSIONS.ZSCOPT'
1583 include 'COMMON.IOUNITS'
1584 include 'COMMON.GEO'
1585 include 'COMMON.VAR'
1586 include 'COMMON.LOCAL'
1587 include 'COMMON.CHAIN'
1588 include 'COMMON.VECTORS'
1589 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1590 dimension uyt(3,maxres),uzt(3,maxres)
1591 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1592 double precision delta /1.0d-7/
1595 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1596 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1597 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1598 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1599 cd & (dc_norm(if90,i),if90=1,3)
1600 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1601 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1602 cd write(iout,'(a)')
1608 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1609 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1622 cd write (iout,*) 'i=',i
1624 erij(k)=dc_norm(k,i)
1628 dc_norm(k,i)=erij(k)
1630 dc_norm(j,i)=dc_norm(j,i)+delta
1631 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1633 c dc_norm(k,i)=dc_norm(k,i)/fac
1635 c write (iout,*) (dc_norm(k,i),k=1,3)
1636 c write (iout,*) (erij(k),k=1,3)
1639 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1640 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1641 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1642 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1644 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1645 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1646 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1649 dc_norm(k,i)=erij(k)
1652 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1653 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1654 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1655 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1656 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1657 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1658 cd write (iout,'(a)')
1663 C--------------------------------------------------------------------------
1664 subroutine set_matrices
1665 implicit real*8 (a-h,o-z)
1666 include 'DIMENSIONS'
1667 include 'DIMENSIONS.ZSCOPT'
1668 include 'COMMON.IOUNITS'
1669 include 'COMMON.GEO'
1670 include 'COMMON.VAR'
1671 include 'COMMON.LOCAL'
1672 include 'COMMON.CHAIN'
1673 include 'COMMON.DERIV'
1674 include 'COMMON.INTERACT'
1675 include 'COMMON.CONTACTS'
1676 include 'COMMON.TORSION'
1677 include 'COMMON.VECTORS'
1678 include 'COMMON.FFIELD'
1679 double precision auxvec(2),auxmat(2,2)
1681 C Compute the virtual-bond-torsional-angle dependent quantities needed
1682 C to calculate the el-loc multibody terms of various order.
1685 if (i .lt. nres+1) then
1722 if (i .gt. 3 .and. i .lt. nres+1) then
1723 obrot_der(1,i-2)=-sin1
1724 obrot_der(2,i-2)= cos1
1725 Ugder(1,1,i-2)= sin1
1726 Ugder(1,2,i-2)=-cos1
1727 Ugder(2,1,i-2)=-cos1
1728 Ugder(2,2,i-2)=-sin1
1731 obrot2_der(1,i-2)=-dwasin2
1732 obrot2_der(2,i-2)= dwacos2
1733 Ug2der(1,1,i-2)= dwasin2
1734 Ug2der(1,2,i-2)=-dwacos2
1735 Ug2der(2,1,i-2)=-dwacos2
1736 Ug2der(2,2,i-2)=-dwasin2
1738 obrot_der(1,i-2)=0.0d0
1739 obrot_der(2,i-2)=0.0d0
1740 Ugder(1,1,i-2)=0.0d0
1741 Ugder(1,2,i-2)=0.0d0
1742 Ugder(2,1,i-2)=0.0d0
1743 Ugder(2,2,i-2)=0.0d0
1744 obrot2_der(1,i-2)=0.0d0
1745 obrot2_der(2,i-2)=0.0d0
1746 Ug2der(1,1,i-2)=0.0d0
1747 Ug2der(1,2,i-2)=0.0d0
1748 Ug2der(2,1,i-2)=0.0d0
1749 Ug2der(2,2,i-2)=0.0d0
1751 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1752 if (itype(i-2).le.ntyp) then
1753 iti = itortyp(itype(i-2))
1760 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1761 if (itype(i-1).le.ntyp) then
1762 iti1 = itortyp(itype(i-1))
1769 cd write (iout,*) '*******i',i,' iti1',iti
1770 cd write (iout,*) 'b1',b1(:,iti)
1771 cd write (iout,*) 'b2',b2(:,iti)
1772 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1773 c print *,"itilde1 i iti iti1",i,iti,iti1
1774 if (i .gt. iatel_s+2) then
1775 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1776 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1777 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1778 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1779 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1780 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1781 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1791 DtUg2(l,k,i-2)=0.0d0
1795 c print *,"itilde2 i iti iti1",i,iti,iti1
1796 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1797 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1798 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1799 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1800 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1801 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1802 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1803 c print *,"itilde3 i iti iti1",i,iti,iti1
1805 muder(k,i-2)=Ub2der(k,i-2)
1807 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1808 if (itype(i-1).le.ntyp) then
1809 iti1 = itortyp(itype(i-1))
1817 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1819 C Vectors and matrices dependent on a single virtual-bond dihedral.
1820 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1821 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1822 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1823 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1824 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1825 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1826 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1827 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1828 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1829 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1830 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1832 C Matrices dependent on two consecutive virtual-bond dihedrals.
1833 C The order of matrices is from left to right.
1835 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1836 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1837 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1838 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1839 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1840 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1841 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1842 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1845 cd iti = itortyp(itype(i))
1848 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1849 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1854 C--------------------------------------------------------------------------
1855 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1857 C This subroutine calculates the average interaction energy and its gradient
1858 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1859 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1860 C The potential depends both on the distance of peptide-group centers and on
1861 C the orientation of the CA-CA virtual bonds.
1863 implicit real*8 (a-h,o-z)
1864 include 'DIMENSIONS'
1865 include 'DIMENSIONS.ZSCOPT'
1866 include 'COMMON.CONTROL'
1867 include 'COMMON.IOUNITS'
1868 include 'COMMON.GEO'
1869 include 'COMMON.VAR'
1870 include 'COMMON.LOCAL'
1871 include 'COMMON.CHAIN'
1872 include 'COMMON.DERIV'
1873 include 'COMMON.INTERACT'
1874 include 'COMMON.CONTACTS'
1875 include 'COMMON.TORSION'
1876 include 'COMMON.VECTORS'
1877 include 'COMMON.FFIELD'
1878 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1879 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1880 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1881 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1882 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1883 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1884 double precision scal_el /0.5d0/
1886 C 13-go grudnia roku pamietnego...
1887 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1888 & 0.0d0,1.0d0,0.0d0,
1889 & 0.0d0,0.0d0,1.0d0/
1890 cd write(iout,*) 'In EELEC'
1892 cd write(iout,*) 'Type',i
1893 cd write(iout,*) 'B1',B1(:,i)
1894 cd write(iout,*) 'B2',B2(:,i)
1895 cd write(iout,*) 'CC',CC(:,:,i)
1896 cd write(iout,*) 'DD',DD(:,:,i)
1897 cd write(iout,*) 'EE',EE(:,:,i)
1899 cd call check_vecgrad
1901 if (icheckgrad.eq.1) then
1903 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1905 dc_norm(k,i)=dc(k,i)*fac
1907 c write (iout,*) 'i',i,' fac',fac
1910 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1911 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1912 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1913 cd if (wel_loc.gt.0.0d0) then
1914 if (icheckgrad.eq.1) then
1915 call vec_and_deriv_test
1922 cd write (iout,*) 'i=',i
1924 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1927 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1928 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1941 C print '(a)','Enter EELEC'
1942 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1944 gel_loc_loc(i)=0.0d0
1947 do i=iatel_s,iatel_e
1949 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
1950 & .or. itype(i+2).eq.ntyp1) cycle
1952 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1953 & .or. itype(i+2).eq.ntyp1
1954 & .or. itype(i-1).eq.ntyp1
1957 if (itel(i).eq.0) goto 1215
1961 dx_normi=dc_norm(1,i)
1962 dy_normi=dc_norm(2,i)
1963 dz_normi=dc_norm(3,i)
1964 xmedi=c(1,i)+0.5d0*dxi
1965 ymedi=c(2,i)+0.5d0*dyi
1966 zmedi=c(3,i)+0.5d0*dzi
1967 xmedi=mod(xmedi,boxxsize)
1968 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1969 ymedi=mod(ymedi,boxysize)
1970 if (ymedi.lt.0) ymedi=ymedi+boxysize
1971 zmedi=mod(zmedi,boxzsize)
1972 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1974 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1975 do j=ielstart(i),ielend(i)
1977 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1978 & .or.itype(j+2).eq.ntyp1
1981 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1982 & .or.itype(j+2).eq.ntyp1
1983 & .or.itype(j-1).eq.ntyp1
1988 if (itel(j).eq.0) goto 1216
1992 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1993 aaa=app(iteli,itelj)
1994 bbb=bpp(iteli,itelj)
1995 C Diagnostics only!!!
2001 ael6i=ael6(iteli,itelj)
2002 ael3i=ael3(iteli,itelj)
2006 dx_normj=dc_norm(1,j)
2007 dy_normj=dc_norm(2,j)
2008 dz_normj=dc_norm(3,j)
2013 if (xj.lt.0) xj=xj+boxxsize
2015 if (yj.lt.0) yj=yj+boxysize
2017 if (zj.lt.0) zj=zj+boxzsize
2018 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2026 xj=xj_safe+xshift*boxxsize
2027 yj=yj_safe+yshift*boxysize
2028 zj=zj_safe+zshift*boxzsize
2029 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2030 if(dist_temp.lt.dist_init) then
2040 if (isubchap.eq.1) then
2049 rij=xj*xj+yj*yj+zj*zj
2050 sss=sscale(sqrt(rij))
2051 sssgrad=sscagrad(sqrt(rij))
2057 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2058 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2059 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2060 fac=cosa-3.0D0*cosb*cosg
2062 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2063 if (j.eq.i+2) ev1=scal_el*ev1
2068 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2071 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2072 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2073 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2075 evdw1=evdw1+evdwij*sss
2076 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2077 c &'evdw1',i,j,evdwij
2078 c &,iteli,itelj,aaa,evdw1
2080 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2081 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2082 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2083 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2084 c & xmedi,ymedi,zmedi,xj,yj,zj
2086 C Calculate contributions to the Cartesian gradient.
2089 facvdw=-6*rrmij*(ev1+evdwij)*sss
2090 facel=-3*rrmij*(el1+eesij)
2097 * Radial derivatives. First process both termini of the fragment (i,j)
2104 gelc(k,i)=gelc(k,i)+ghalf
2105 gelc(k,j)=gelc(k,j)+ghalf
2108 * Loop over residues i+1 thru j-1.
2112 gelc(l,k)=gelc(l,k)+ggg(l)
2118 if (sss.gt.0.0) then
2119 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2120 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2121 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2129 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2130 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2133 * Loop over residues i+1 thru j-1.
2137 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2141 facvdw=(ev1+evdwij)*sss
2144 fac=-3*rrmij*(facvdw+facvdw+facel)
2150 * Radial derivatives. First process both termini of the fragment (i,j)
2157 gelc(k,i)=gelc(k,i)+ghalf
2158 gelc(k,j)=gelc(k,j)+ghalf
2161 * Loop over residues i+1 thru j-1.
2165 gelc(l,k)=gelc(l,k)+ggg(l)
2172 ecosa=2.0D0*fac3*fac1+fac4
2175 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2176 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2178 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2179 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2181 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2182 cd & (dcosg(k),k=1,3)
2184 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2188 gelc(k,i)=gelc(k,i)+ghalf
2189 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2190 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2191 gelc(k,j)=gelc(k,j)+ghalf
2192 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2193 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2197 gelc(l,k)=gelc(l,k)+ggg(l)
2202 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2203 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2204 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2206 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2207 C energy of a peptide unit is assumed in the form of a second-order
2208 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2209 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2210 C are computed for EVERY pair of non-contiguous peptide groups.
2212 if (j.lt.nres-1) then
2223 muij(kkk)=mu(k,i)*mu(l,j)
2226 cd write (iout,*) 'EELEC: i',i,' j',j
2227 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2228 cd write(iout,*) 'muij',muij
2229 ury=scalar(uy(1,i),erij)
2230 urz=scalar(uz(1,i),erij)
2231 vry=scalar(uy(1,j),erij)
2232 vrz=scalar(uz(1,j),erij)
2233 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2234 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2235 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2236 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2237 C For diagnostics only
2242 fac=dsqrt(-ael6i)*r3ij
2243 cd write (2,*) 'fac=',fac
2244 C For diagnostics only
2250 cd write (iout,'(4i5,4f10.5)')
2251 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2252 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2253 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2254 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2255 cd write (iout,'(4f10.5)')
2256 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2257 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2258 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2259 cd write (iout,'(2i3,9f10.5/)') i,j,
2260 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2262 C Derivatives of the elements of A in virtual-bond vectors
2263 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2270 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2271 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2272 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2273 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2274 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2275 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2276 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2277 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2278 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2279 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2280 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2281 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2291 C Compute radial contributions to the gradient
2313 C Add the contributions coming from er
2316 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2317 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2318 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2319 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2322 C Derivatives in DC(i)
2323 ghalf1=0.5d0*agg(k,1)
2324 ghalf2=0.5d0*agg(k,2)
2325 ghalf3=0.5d0*agg(k,3)
2326 ghalf4=0.5d0*agg(k,4)
2327 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2328 & -3.0d0*uryg(k,2)*vry)+ghalf1
2329 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2330 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2331 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2332 & -3.0d0*urzg(k,2)*vry)+ghalf3
2333 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2334 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2335 C Derivatives in DC(i+1)
2336 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2337 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2338 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2339 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2340 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2341 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2342 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2343 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2344 C Derivatives in DC(j)
2345 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2346 & -3.0d0*vryg(k,2)*ury)+ghalf1
2347 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2348 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2349 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2350 & -3.0d0*vryg(k,2)*urz)+ghalf3
2351 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2352 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2353 C Derivatives in DC(j+1) or DC(nres-1)
2354 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2355 & -3.0d0*vryg(k,3)*ury)
2356 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2357 & -3.0d0*vrzg(k,3)*ury)
2358 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2359 & -3.0d0*vryg(k,3)*urz)
2360 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2361 & -3.0d0*vrzg(k,3)*urz)
2366 C Derivatives in DC(i+1)
2367 cd aggi1(k,1)=agg(k,1)
2368 cd aggi1(k,2)=agg(k,2)
2369 cd aggi1(k,3)=agg(k,3)
2370 cd aggi1(k,4)=agg(k,4)
2371 C Derivatives in DC(j)
2376 C Derivatives in DC(j+1)
2381 if (j.eq.nres-1 .and. i.lt.j-2) then
2383 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2384 cd aggj1(k,l)=agg(k,l)
2390 C Check the loc-el terms by numerical integration
2400 aggi(k,l)=-aggi(k,l)
2401 aggi1(k,l)=-aggi1(k,l)
2402 aggj(k,l)=-aggj(k,l)
2403 aggj1(k,l)=-aggj1(k,l)
2406 if (j.lt.nres-1) then
2412 aggi(k,l)=-aggi(k,l)
2413 aggi1(k,l)=-aggi1(k,l)
2414 aggj(k,l)=-aggj(k,l)
2415 aggj1(k,l)=-aggj1(k,l)
2426 aggi(k,l)=-aggi(k,l)
2427 aggi1(k,l)=-aggi1(k,l)
2428 aggj(k,l)=-aggj(k,l)
2429 aggj1(k,l)=-aggj1(k,l)
2435 IF (wel_loc.gt.0.0d0) THEN
2436 C Contribution to the local-electrostatic energy coming from the i-j pair
2437 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2439 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2440 c write (iout,'(a6,2i5,0pf7.3)')
2441 c & 'eelloc',i,j,eel_loc_ij
2442 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2443 eel_loc=eel_loc+eel_loc_ij
2444 C Partial derivatives in virtual-bond dihedral angles gamma
2447 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2448 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2449 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2450 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2451 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2452 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2453 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2454 cd write(iout,*) 'agg ',agg
2455 cd write(iout,*) 'aggi ',aggi
2456 cd write(iout,*) 'aggi1',aggi1
2457 cd write(iout,*) 'aggj ',aggj
2458 cd write(iout,*) 'aggj1',aggj1
2460 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2462 ggg(l)=agg(l,1)*muij(1)+
2463 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2467 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2470 C Remaining derivatives of eello
2472 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2473 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2474 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2475 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2476 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2477 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2478 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2479 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2483 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2484 C Contributions from turns
2489 call eturn34(i,j,eello_turn3,eello_turn4)
2491 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2492 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2494 C Calculate the contact function. The ith column of the array JCONT will
2495 C contain the numbers of atoms that make contacts with the atom I (of numbers
2496 C greater than I). The arrays FACONT and GACONT will contain the values of
2497 C the contact function and its derivative.
2498 c r0ij=1.02D0*rpp(iteli,itelj)
2499 c r0ij=1.11D0*rpp(iteli,itelj)
2500 r0ij=2.20D0*rpp(iteli,itelj)
2501 c r0ij=1.55D0*rpp(iteli,itelj)
2502 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2503 if (fcont.gt.0.0D0) then
2504 num_conti=num_conti+1
2505 if (num_conti.gt.maxconts) then
2506 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2507 & ' will skip next contacts for this conf.'
2509 jcont_hb(num_conti,i)=j
2510 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2511 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2512 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2514 d_cont(num_conti,i)=rij
2515 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2516 C --- Electrostatic-interaction matrix ---
2517 a_chuj(1,1,num_conti,i)=a22
2518 a_chuj(1,2,num_conti,i)=a23
2519 a_chuj(2,1,num_conti,i)=a32
2520 a_chuj(2,2,num_conti,i)=a33
2521 C --- Gradient of rij
2523 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2526 c a_chuj(1,1,num_conti,i)=-0.61d0
2527 c a_chuj(1,2,num_conti,i)= 0.4d0
2528 c a_chuj(2,1,num_conti,i)= 0.65d0
2529 c a_chuj(2,2,num_conti,i)= 0.50d0
2530 c else if (i.eq.2) then
2531 c a_chuj(1,1,num_conti,i)= 0.0d0
2532 c a_chuj(1,2,num_conti,i)= 0.0d0
2533 c a_chuj(2,1,num_conti,i)= 0.0d0
2534 c a_chuj(2,2,num_conti,i)= 0.0d0
2536 C --- and its gradients
2537 cd write (iout,*) 'i',i,' j',j
2539 cd write (iout,*) 'iii 1 kkk',kkk
2540 cd write (iout,*) agg(kkk,:)
2543 cd write (iout,*) 'iii 2 kkk',kkk
2544 cd write (iout,*) aggi(kkk,:)
2547 cd write (iout,*) 'iii 3 kkk',kkk
2548 cd write (iout,*) aggi1(kkk,:)
2551 cd write (iout,*) 'iii 4 kkk',kkk
2552 cd write (iout,*) aggj(kkk,:)
2555 cd write (iout,*) 'iii 5 kkk',kkk
2556 cd write (iout,*) aggj1(kkk,:)
2563 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2564 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2565 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2566 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2567 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2569 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2575 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2576 C Calculate contact energies
2578 wij=cosa-3.0D0*cosb*cosg
2581 c fac3=dsqrt(-ael6i)/r0ij**3
2582 fac3=dsqrt(-ael6i)*r3ij
2583 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2584 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2586 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2587 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2588 C Diagnostics. Comment out or remove after debugging!
2589 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2590 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2591 c ees0m(num_conti,i)=0.0D0
2593 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2594 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2595 facont_hb(num_conti,i)=fcont
2597 C Angular derivatives of the contact function
2598 ees0pij1=fac3/ees0pij
2599 ees0mij1=fac3/ees0mij
2600 fac3p=-3.0D0*fac3*rrmij
2601 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2602 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2604 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2605 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2606 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2607 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2608 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2609 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2610 ecosap=ecosa1+ecosa2
2611 ecosbp=ecosb1+ecosb2
2612 ecosgp=ecosg1+ecosg2
2613 ecosam=ecosa1-ecosa2
2614 ecosbm=ecosb1-ecosb2
2615 ecosgm=ecosg1-ecosg2
2624 fprimcont=fprimcont/rij
2625 cd facont_hb(num_conti,i)=1.0D0
2626 C Following line is for diagnostics.
2629 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2630 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2633 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2634 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2636 gggp(1)=gggp(1)+ees0pijp*xj
2637 gggp(2)=gggp(2)+ees0pijp*yj
2638 gggp(3)=gggp(3)+ees0pijp*zj
2639 gggm(1)=gggm(1)+ees0mijp*xj
2640 gggm(2)=gggm(2)+ees0mijp*yj
2641 gggm(3)=gggm(3)+ees0mijp*zj
2642 C Derivatives due to the contact function
2643 gacont_hbr(1,num_conti,i)=fprimcont*xj
2644 gacont_hbr(2,num_conti,i)=fprimcont*yj
2645 gacont_hbr(3,num_conti,i)=fprimcont*zj
2647 ghalfp=0.5D0*gggp(k)
2648 ghalfm=0.5D0*gggm(k)
2649 gacontp_hb1(k,num_conti,i)=ghalfp
2650 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2651 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2652 gacontp_hb2(k,num_conti,i)=ghalfp
2653 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2654 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2655 gacontp_hb3(k,num_conti,i)=gggp(k)
2656 gacontm_hb1(k,num_conti,i)=ghalfm
2657 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2658 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2659 gacontm_hb2(k,num_conti,i)=ghalfm
2660 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2661 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2662 gacontm_hb3(k,num_conti,i)=gggm(k)
2665 C Diagnostics. Comment out or remove after debugging!
2667 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2668 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2669 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2670 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2671 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2672 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2675 endif ! num_conti.le.maxconts
2680 num_cont_hb(i)=num_conti
2684 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2685 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2687 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2688 ccc eel_loc=eel_loc+eello_turn3
2691 C-----------------------------------------------------------------------------
2692 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2693 C Third- and fourth-order contributions from turns
2694 implicit real*8 (a-h,o-z)
2695 include 'DIMENSIONS'
2696 include 'DIMENSIONS.ZSCOPT'
2697 include 'COMMON.IOUNITS'
2698 include 'COMMON.GEO'
2699 include 'COMMON.VAR'
2700 include 'COMMON.LOCAL'
2701 include 'COMMON.CHAIN'
2702 include 'COMMON.DERIV'
2703 include 'COMMON.INTERACT'
2704 include 'COMMON.CONTACTS'
2705 include 'COMMON.TORSION'
2706 include 'COMMON.VECTORS'
2707 include 'COMMON.FFIELD'
2709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2713 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2718 C Third-order contributions
2725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2726 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2727 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2728 call transpose2(auxmat(1,1),auxmat1(1,1))
2729 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2730 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2731 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2732 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2733 cd & ' eello_turn3_num',4*eello_turn3_num
2735 C Derivatives in gamma(i)
2736 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2737 call transpose2(auxmat2(1,1),pizda(1,1))
2738 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2739 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2740 C Derivatives in gamma(i+1)
2741 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2742 call transpose2(auxmat2(1,1),pizda(1,1))
2743 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2744 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2745 & +0.5d0*(pizda(1,1)+pizda(2,2))
2746 C Cartesian derivatives
2748 a_temp(1,1)=aggi(l,1)
2749 a_temp(1,2)=aggi(l,2)
2750 a_temp(2,1)=aggi(l,3)
2751 a_temp(2,2)=aggi(l,4)
2752 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2753 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2754 & +0.5d0*(pizda(1,1)+pizda(2,2))
2755 a_temp(1,1)=aggi1(l,1)
2756 a_temp(1,2)=aggi1(l,2)
2757 a_temp(2,1)=aggi1(l,3)
2758 a_temp(2,2)=aggi1(l,4)
2759 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2760 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2761 & +0.5d0*(pizda(1,1)+pizda(2,2))
2762 a_temp(1,1)=aggj(l,1)
2763 a_temp(1,2)=aggj(l,2)
2764 a_temp(2,1)=aggj(l,3)
2765 a_temp(2,2)=aggj(l,4)
2766 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2767 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2768 & +0.5d0*(pizda(1,1)+pizda(2,2))
2769 a_temp(1,1)=aggj1(l,1)
2770 a_temp(1,2)=aggj1(l,2)
2771 a_temp(2,1)=aggj1(l,3)
2772 a_temp(2,2)=aggj1(l,4)
2773 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2774 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2775 & +0.5d0*(pizda(1,1)+pizda(2,2))
2778 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2779 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2781 C Fourth-order contributions
2789 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2790 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2791 iti1=itortyp(itype(i+1))
2792 iti2=itortyp(itype(i+2))
2793 iti3=itortyp(itype(i+3))
2794 call transpose2(EUg(1,1,i+1),e1t(1,1))
2795 call transpose2(Eug(1,1,i+2),e2t(1,1))
2796 call transpose2(Eug(1,1,i+3),e3t(1,1))
2797 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2798 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2799 s1=scalar2(b1(1,iti2),auxvec(1))
2800 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2801 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2802 s2=scalar2(b1(1,iti1),auxvec(1))
2803 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2804 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2805 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2806 eello_turn4=eello_turn4-(s1+s2+s3)
2807 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2808 cd & ' eello_turn4_num',8*eello_turn4_num
2809 C Derivatives in gamma(i)
2811 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2812 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2813 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2814 s1=scalar2(b1(1,iti2),auxvec(1))
2815 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2816 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2817 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2818 C Derivatives in gamma(i+1)
2819 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2820 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2821 s2=scalar2(b1(1,iti1),auxvec(1))
2822 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2823 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2824 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2825 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2826 C Derivatives in gamma(i+2)
2827 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2828 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2829 s1=scalar2(b1(1,iti2),auxvec(1))
2830 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2831 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2832 s2=scalar2(b1(1,iti1),auxvec(1))
2833 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2834 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2835 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2836 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2837 C Cartesian derivatives
2838 C Derivatives of this turn contributions in DC(i+2)
2839 if (j.lt.nres-1) then
2841 a_temp(1,1)=agg(l,1)
2842 a_temp(1,2)=agg(l,2)
2843 a_temp(2,1)=agg(l,3)
2844 a_temp(2,2)=agg(l,4)
2845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2847 s1=scalar2(b1(1,iti2),auxvec(1))
2848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2850 s2=scalar2(b1(1,iti1),auxvec(1))
2851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2855 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2858 C Remaining derivatives of this turn contribution
2860 a_temp(1,1)=aggi(l,1)
2861 a_temp(1,2)=aggi(l,2)
2862 a_temp(2,1)=aggi(l,3)
2863 a_temp(2,2)=aggi(l,4)
2864 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2865 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2866 s1=scalar2(b1(1,iti2),auxvec(1))
2867 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2868 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2869 s2=scalar2(b1(1,iti1),auxvec(1))
2870 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2871 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2872 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2873 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2874 a_temp(1,1)=aggi1(l,1)
2875 a_temp(1,2)=aggi1(l,2)
2876 a_temp(2,1)=aggi1(l,3)
2877 a_temp(2,2)=aggi1(l,4)
2878 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2879 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2880 s1=scalar2(b1(1,iti2),auxvec(1))
2881 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2882 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2883 s2=scalar2(b1(1,iti1),auxvec(1))
2884 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2885 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2886 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2887 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2888 a_temp(1,1)=aggj(l,1)
2889 a_temp(1,2)=aggj(l,2)
2890 a_temp(2,1)=aggj(l,3)
2891 a_temp(2,2)=aggj(l,4)
2892 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2893 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2894 s1=scalar2(b1(1,iti2),auxvec(1))
2895 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2896 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2897 s2=scalar2(b1(1,iti1),auxvec(1))
2898 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2899 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2900 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2901 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2902 a_temp(1,1)=aggj1(l,1)
2903 a_temp(1,2)=aggj1(l,2)
2904 a_temp(2,1)=aggj1(l,3)
2905 a_temp(2,2)=aggj1(l,4)
2906 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2907 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2908 s1=scalar2(b1(1,iti2),auxvec(1))
2909 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2910 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2911 s2=scalar2(b1(1,iti1),auxvec(1))
2912 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2913 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2914 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2915 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2921 C-----------------------------------------------------------------------------
2922 subroutine vecpr(u,v,w)
2923 implicit real*8(a-h,o-z)
2924 dimension u(3),v(3),w(3)
2925 w(1)=u(2)*v(3)-u(3)*v(2)
2926 w(2)=-u(1)*v(3)+u(3)*v(1)
2927 w(3)=u(1)*v(2)-u(2)*v(1)
2930 C-----------------------------------------------------------------------------
2931 subroutine unormderiv(u,ugrad,unorm,ungrad)
2932 C This subroutine computes the derivatives of a normalized vector u, given
2933 C the derivatives computed without normalization conditions, ugrad. Returns
2936 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2937 double precision vec(3)
2938 double precision scalar
2940 c write (2,*) 'ugrad',ugrad
2943 vec(i)=scalar(ugrad(1,i),u(1))
2945 c write (2,*) 'vec',vec
2948 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2951 c write (2,*) 'ungrad',ungrad
2954 C-----------------------------------------------------------------------------
2955 subroutine escp(evdw2,evdw2_14)
2957 C This subroutine calculates the excluded-volume interaction energy between
2958 C peptide-group centers and side chains and its gradient in virtual-bond and
2959 C side-chain vectors.
2961 implicit real*8 (a-h,o-z)
2962 include 'DIMENSIONS'
2963 include 'DIMENSIONS.ZSCOPT'
2964 include 'COMMON.GEO'
2965 include 'COMMON.VAR'
2966 include 'COMMON.LOCAL'
2967 include 'COMMON.CHAIN'
2968 include 'COMMON.DERIV'
2969 include 'COMMON.INTERACT'
2970 include 'COMMON.FFIELD'
2971 include 'COMMON.IOUNITS'
2975 cd print '(a)','Enter ESCP'
2976 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2977 c & ' scal14',scal14
2978 do i=iatscp_s,iatscp_e
2979 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2981 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2982 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2983 if (iteli.eq.0) goto 1225
2984 xi=0.5D0*(c(1,i)+c(1,i+1))
2985 yi=0.5D0*(c(2,i)+c(2,i+1))
2986 zi=0.5D0*(c(3,i)+c(3,i+1))
2987 C Returning the ith atom to box
2989 if (xi.lt.0) xi=xi+boxxsize
2991 if (yi.lt.0) yi=yi+boxysize
2993 if (zi.lt.0) zi=zi+boxzsize
2994 do iint=1,nscp_gr(i)
2996 do j=iscpstart(i,iint),iscpend(i,iint)
2997 itypj=iabs(itype(j))
2998 if (itypj.eq.ntyp1) cycle
2999 C Uncomment following three lines for SC-p interactions
3003 C Uncomment following three lines for Ca-p interactions
3007 C returning the jth atom to box
3009 if (xj.lt.0) xj=xj+boxxsize
3011 if (yj.lt.0) yj=yj+boxysize
3013 if (zj.lt.0) zj=zj+boxzsize
3014 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3019 C Finding the closest jth atom
3023 xj=xj_safe+xshift*boxxsize
3024 yj=yj_safe+yshift*boxysize
3025 zj=zj_safe+zshift*boxzsize
3026 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3027 if(dist_temp.lt.dist_init) then
3037 if (subchap.eq.1) then
3046 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3047 C sss is scaling function for smoothing the cutoff gradient otherwise
3048 C the gradient would not be continuouse
3049 sss=sscale(1.0d0/(dsqrt(rrij)))
3050 if (sss.le.0.0d0) cycle
3051 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3053 e1=fac*fac*aad(itypj,iteli)
3054 e2=fac*bad(itypj,iteli)
3055 if (iabs(j-i) .le. 2) then
3058 evdw2_14=evdw2_14+(e1+e2)*sss
3061 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3062 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3063 c & bad(itypj,iteli)
3064 evdw2=evdw2+evdwij*sss
3067 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3069 fac=-(evdwij+e1)*rrij*sss
3070 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3075 cd write (iout,*) 'j<i'
3076 C Uncomment following three lines for SC-p interactions
3078 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3081 cd write (iout,*) 'j>i'
3084 C Uncomment following line for SC-p interactions
3085 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3089 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3093 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3094 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3097 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3107 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3108 gradx_scp(j,i)=expon*gradx_scp(j,i)
3111 C******************************************************************************
3115 C To save time the factor EXPON has been extracted from ALL components
3116 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3119 C******************************************************************************
3122 C--------------------------------------------------------------------------
3123 subroutine edis(ehpb)
3125 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3127 implicit real*8 (a-h,o-z)
3128 include 'DIMENSIONS'
3129 include 'DIMENSIONS.ZSCOPT'
3130 include 'COMMON.SBRIDGE'
3131 include 'COMMON.CHAIN'
3132 include 'COMMON.DERIV'
3133 include 'COMMON.VAR'
3134 include 'COMMON.INTERACT'
3135 include 'COMMON.CONTROL'
3136 include 'COMMON.IOUNITS'
3139 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3140 cd print *,'link_start=',link_start,' link_end=',link_end
3141 C write(iout,*) link_end, "link_end"
3142 if (link_end.eq.0) return
3143 do i=link_start,link_end
3144 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3145 C CA-CA distance used in regularization of structure.
3148 C iii and jjj point to the residues for which the distance is assigned.
3149 if (ii.gt.nres) then
3156 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3157 C distance and angle dependent SS bond potential.
3158 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3159 C & iabs(itype(jjj)).eq.1) then
3160 C write(iout,*) constr_dist,"const"
3161 if (.not.dyn_ss .and. i.le.nss) then
3162 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3163 & iabs(itype(jjj)).eq.1) then
3164 call ssbond_ene(iii,jjj,eij)
3167 else if (ii.gt.nres .and. jj.gt.nres) then
3168 c Restraints from contact prediction
3170 if (constr_dist.eq.11) then
3171 C ehpb=ehpb+fordepth(i)**4.0d0
3172 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3173 ehpb=ehpb+fordepth(i)**4.0d0
3174 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3175 fac=fordepth(i)**4.0d0
3176 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3177 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3178 C & ehpb,fordepth(i),dd
3179 C write(iout,*) ehpb,"atu?"
3181 C fac=fordepth(i)**4.0d0
3182 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3184 if (dhpb1(i).gt.0.0d0) then
3185 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3186 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3187 c write (iout,*) "beta nmr",
3188 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3192 C Get the force constant corresponding to this distance.
3194 C Calculate the contribution to energy.
3195 ehpb=ehpb+waga*rdis*rdis
3196 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3198 C Evaluate gradient.
3201 endif !end dhpb1(i).gt.0
3202 endif !end const_dist=11
3204 ggg(j)=fac*(c(j,jj)-c(j,ii))
3207 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3208 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3211 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3212 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3215 C write(iout,*) "before"
3217 C write(iout,*) "after",dd
3218 if (constr_dist.eq.11) then
3219 ehpb=ehpb+fordepth(i)**4.0d0
3220 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3221 fac=fordepth(i)**4.0d0
3222 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3223 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3224 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3225 C print *,ehpb,"tu?"
3226 C write(iout,*) ehpb,"btu?",
3227 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3228 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3229 C & ehpb,fordepth(i),dd
3231 if (dhpb1(i).gt.0.0d0) then
3232 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3233 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3234 c write (iout,*) "alph nmr",
3235 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3238 C Get the force constant corresponding to this distance.
3240 C Calculate the contribution to energy.
3241 ehpb=ehpb+waga*rdis*rdis
3242 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3244 C Evaluate gradient.
3251 ggg(j)=fac*(c(j,jj)-c(j,ii))
3253 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3254 C If this is a SC-SC distance, we need to calculate the contributions to the
3255 C Cartesian gradient in the SC vectors (ghpbx).
3258 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3259 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3264 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3269 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3272 C--------------------------------------------------------------------------
3273 subroutine ssbond_ene(i,j,eij)
3275 C Calculate the distance and angle dependent SS-bond potential energy
3276 C using a free-energy function derived based on RHF/6-31G** ab initio
3277 C calculations of diethyl disulfide.
3279 C A. Liwo and U. Kozlowska, 11/24/03
3281 implicit real*8 (a-h,o-z)
3282 include 'DIMENSIONS'
3283 include 'DIMENSIONS.ZSCOPT'
3284 include 'COMMON.SBRIDGE'
3285 include 'COMMON.CHAIN'
3286 include 'COMMON.DERIV'
3287 include 'COMMON.LOCAL'
3288 include 'COMMON.INTERACT'
3289 include 'COMMON.VAR'
3290 include 'COMMON.IOUNITS'
3291 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3292 itypi=iabs(itype(i))
3296 dxi=dc_norm(1,nres+i)
3297 dyi=dc_norm(2,nres+i)
3298 dzi=dc_norm(3,nres+i)
3299 dsci_inv=dsc_inv(itypi)
3300 itypj=iabs(itype(j))
3301 dscj_inv=dsc_inv(itypj)
3305 dxj=dc_norm(1,nres+j)
3306 dyj=dc_norm(2,nres+j)
3307 dzj=dc_norm(3,nres+j)
3308 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3313 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3314 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3315 om12=dxi*dxj+dyi*dyj+dzi*dzj
3317 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3318 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3324 deltat12=om2-om1+2.0d0
3326 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3327 & +akct*deltad*deltat12
3328 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3329 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3330 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3331 c & " deltat12",deltat12," eij",eij
3332 ed=2*akcm*deltad+akct*deltat12
3334 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3335 eom1=-2*akth*deltat1-pom1-om2*pom2
3336 eom2= 2*akth*deltat2+pom1-om1*pom2
3339 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3342 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3343 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3344 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3345 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3348 C Calculate the components of the gradient in DC and X
3352 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3357 C--------------------------------------------------------------------------
3358 subroutine ebond(estr)
3360 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3362 implicit real*8 (a-h,o-z)
3363 include 'DIMENSIONS'
3364 include 'DIMENSIONS.ZSCOPT'
3365 include 'COMMON.LOCAL'
3366 include 'COMMON.GEO'
3367 include 'COMMON.INTERACT'
3368 include 'COMMON.DERIV'
3369 include 'COMMON.VAR'
3370 include 'COMMON.CHAIN'
3371 include 'COMMON.IOUNITS'
3372 include 'COMMON.NAMES'
3373 include 'COMMON.FFIELD'
3374 include 'COMMON.CONTROL'
3375 logical energy_dec /.false./
3376 double precision u(3),ud(3)
3379 c write (iout,*) "distchainmax",distchainmax
3381 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3382 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3384 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3385 C & *dc(j,i-1)/vbld(i)
3387 C if (energy_dec) write(iout,*)
3388 C & "estr1",i,vbld(i),distchainmax,
3389 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3391 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3392 diff = vbld(i)-vbldpDUM
3394 diff = vbld(i)-vbldp0
3395 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3399 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3402 C write (iout,'(a7,i5,4f7.3)')
3403 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3405 estr=0.5d0*AKP*estr+estr1
3407 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3411 if (iti.ne.10 .and. iti.ne.ntyp1) then
3414 diff=vbld(i+nres)-vbldsc0(1,iti)
3415 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3416 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3417 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3419 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3423 diff=vbld(i+nres)-vbldsc0(j,iti)
3424 ud(j)=aksc(j,iti)*diff
3425 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3439 uprod2=uprod2*u(k)*u(k)
3443 usumsqder=usumsqder+ud(j)*uprod2
3445 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3446 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3447 estr=estr+uprod/usum
3449 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3457 C--------------------------------------------------------------------------
3458 subroutine ebend(etheta,ethetacnstr)
3460 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3461 C angles gamma and its derivatives in consecutive thetas and gammas.
3463 implicit real*8 (a-h,o-z)
3464 include 'DIMENSIONS'
3465 include 'DIMENSIONS.ZSCOPT'
3466 include 'COMMON.LOCAL'
3467 include 'COMMON.GEO'
3468 include 'COMMON.INTERACT'
3469 include 'COMMON.DERIV'
3470 include 'COMMON.VAR'
3471 include 'COMMON.CHAIN'
3472 include 'COMMON.IOUNITS'
3473 include 'COMMON.NAMES'
3474 include 'COMMON.FFIELD'
3475 include 'COMMON.TORCNSTR'
3476 common /calcthet/ term1,term2,termm,diffak,ratak,
3477 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3478 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3479 double precision y(2),z(2)
3481 c time11=dexp(-2*time)
3484 c write (iout,*) "nres",nres
3485 c write (*,'(a,i2)') 'EBEND ICG=',icg
3486 c write (iout,*) ithet_start,ithet_end
3487 do i=ithet_start,ithet_end
3488 C if (itype(i-1).eq.ntyp1) cycle
3490 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3491 & .or.itype(i).eq.ntyp1) cycle
3492 C Zero the energy function and its derivative at 0 or pi.
3493 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3495 ichir1=isign(1,itype(i-2))
3496 ichir2=isign(1,itype(i))
3497 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3498 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3499 if (itype(i-1).eq.10) then
3500 itype1=isign(10,itype(i-2))
3501 ichir11=isign(1,itype(i-2))
3502 ichir12=isign(1,itype(i-2))
3503 itype2=isign(10,itype(i))
3504 ichir21=isign(1,itype(i))
3505 ichir22=isign(1,itype(i))
3512 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3516 c call proc_proc(phii,icrc)
3517 if (icrc.eq.1) phii=150.0
3528 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3532 c call proc_proc(phii1,icrc)
3533 if (icrc.eq.1) phii1=150.0
3545 C Calculate the "mean" value of theta from the part of the distribution
3546 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3547 C In following comments this theta will be referred to as t_c.
3548 thet_pred_mean=0.0d0
3550 athetk=athet(k,it,ichir1,ichir2)
3551 bthetk=bthet(k,it,ichir1,ichir2)
3553 athetk=athet(k,itype1,ichir11,ichir12)
3554 bthetk=bthet(k,itype2,ichir21,ichir22)
3556 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3558 c write (iout,*) "thet_pred_mean",thet_pred_mean
3559 dthett=thet_pred_mean*ssd
3560 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3561 c write (iout,*) "thet_pred_mean",thet_pred_mean
3562 C Derivatives of the "mean" values in gamma1 and gamma2.
3563 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3564 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3565 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3566 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3568 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3569 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3570 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3571 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3573 if (theta(i).gt.pi-delta) then
3574 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3576 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3577 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3578 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3580 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3582 else if (theta(i).lt.delta) then
3583 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3584 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3585 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3587 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3588 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3591 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3594 etheta=etheta+ethetai
3595 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3596 c & 'ebend',i,ethetai,theta(i),itype(i)
3597 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3598 c & rad2deg*phii,rad2deg*phii1,ethetai
3599 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3600 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3601 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3605 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3606 do i=1,ntheta_constr
3607 itheta=itheta_constr(i)
3608 thetiii=theta(itheta)
3609 difi=pinorm(thetiii-theta_constr0(i))
3610 if (difi.gt.theta_drange(i)) then
3611 difi=difi-theta_drange(i)
3612 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3613 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3614 & +for_thet_constr(i)*difi**3
3615 else if (difi.lt.-drange(i)) then
3617 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3618 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3619 & +for_thet_constr(i)*difi**3
3623 C if (energy_dec) then
3624 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3625 C & i,itheta,rad2deg*thetiii,
3626 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3627 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3628 C & gloc(itheta+nphi-2,icg)
3631 C Ufff.... We've done all this!!!
3634 C---------------------------------------------------------------------------
3635 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3637 implicit real*8 (a-h,o-z)
3638 include 'DIMENSIONS'
3639 include 'COMMON.LOCAL'
3640 include 'COMMON.IOUNITS'
3641 common /calcthet/ term1,term2,termm,diffak,ratak,
3642 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3643 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3644 C Calculate the contributions to both Gaussian lobes.
3645 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3646 C The "polynomial part" of the "standard deviation" of this part of
3650 sig=sig*thet_pred_mean+polthet(j,it)
3652 C Derivative of the "interior part" of the "standard deviation of the"
3653 C gamma-dependent Gaussian lobe in t_c.
3654 sigtc=3*polthet(3,it)
3656 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3659 C Set the parameters of both Gaussian lobes of the distribution.
3660 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3661 fac=sig*sig+sigc0(it)
3664 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3665 sigsqtc=-4.0D0*sigcsq*sigtc
3666 c print *,i,sig,sigtc,sigsqtc
3667 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3668 sigtc=-sigtc/(fac*fac)
3669 C Following variable is sigma(t_c)**(-2)
3670 sigcsq=sigcsq*sigcsq
3672 sig0inv=1.0D0/sig0i**2
3673 delthec=thetai-thet_pred_mean
3674 delthe0=thetai-theta0i
3675 term1=-0.5D0*sigcsq*delthec*delthec
3676 term2=-0.5D0*sig0inv*delthe0*delthe0
3677 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3678 C NaNs in taking the logarithm. We extract the largest exponent which is added
3679 C to the energy (this being the log of the distribution) at the end of energy
3680 C term evaluation for this virtual-bond angle.
3681 if (term1.gt.term2) then
3683 term2=dexp(term2-termm)
3687 term1=dexp(term1-termm)
3690 C The ratio between the gamma-independent and gamma-dependent lobes of
3691 C the distribution is a Gaussian function of thet_pred_mean too.
3692 diffak=gthet(2,it)-thet_pred_mean
3693 ratak=diffak/gthet(3,it)**2
3694 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3695 C Let's differentiate it in thet_pred_mean NOW.
3697 C Now put together the distribution terms to make complete distribution.
3698 termexp=term1+ak*term2
3699 termpre=sigc+ak*sig0i
3700 C Contribution of the bending energy from this theta is just the -log of
3701 C the sum of the contributions from the two lobes and the pre-exponential
3702 C factor. Simple enough, isn't it?
3703 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3704 C NOW the derivatives!!!
3705 C 6/6/97 Take into account the deformation.
3706 E_theta=(delthec*sigcsq*term1
3707 & +ak*delthe0*sig0inv*term2)/termexp
3708 E_tc=((sigtc+aktc*sig0i)/termpre
3709 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3710 & aktc*term2)/termexp)
3713 c-----------------------------------------------------------------------------
3714 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3715 implicit real*8 (a-h,o-z)
3716 include 'DIMENSIONS'
3717 include 'COMMON.LOCAL'
3718 include 'COMMON.IOUNITS'
3719 common /calcthet/ term1,term2,termm,diffak,ratak,
3720 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3721 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3722 delthec=thetai-thet_pred_mean
3723 delthe0=thetai-theta0i
3724 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3725 t3 = thetai-thet_pred_mean
3729 t14 = t12+t6*sigsqtc
3731 t21 = thetai-theta0i
3737 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3738 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3739 & *(-t12*t9-ak*sig0inv*t27)
3743 C--------------------------------------------------------------------------
3744 subroutine ebend(etheta,ethetacnstr)
3746 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3747 C angles gamma and its derivatives in consecutive thetas and gammas.
3748 C ab initio-derived potentials from
3749 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3751 implicit real*8 (a-h,o-z)
3752 include 'DIMENSIONS'
3753 include 'DIMENSIONS.ZSCOPT'
3754 include 'COMMON.LOCAL'
3755 include 'COMMON.GEO'
3756 include 'COMMON.INTERACT'
3757 include 'COMMON.DERIV'
3758 include 'COMMON.VAR'
3759 include 'COMMON.CHAIN'
3760 include 'COMMON.IOUNITS'
3761 include 'COMMON.NAMES'
3762 include 'COMMON.FFIELD'
3763 include 'COMMON.CONTROL'
3764 include 'COMMON.TORCNSTR'
3765 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3766 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3767 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3768 & sinph1ph2(maxdouble,maxdouble)
3769 logical lprn /.false./, lprn1 /.false./
3771 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3772 do i=ithet_start,ithet_end
3774 C if (itype(i-1).eq.ntyp1) cycle
3776 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3777 & .or.itype(i).eq.ntyp1) cycle
3778 if (iabs(itype(i+1)).eq.20) iblock=2
3779 if (iabs(itype(i+1)).ne.20) iblock=1
3783 theti2=0.5d0*theta(i)
3784 ityp2=ithetyp((itype(i-1)))
3786 coskt(k)=dcos(k*theti2)
3787 sinkt(k)=dsin(k*theti2)
3797 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3800 if (phii.ne.phii) phii=150.0
3804 ityp1=ithetyp((itype(i-2)))
3806 cosph1(k)=dcos(k*phii)
3807 sinph1(k)=dsin(k*phii)
3813 ityp1=ithetyp((itype(i-2)))
3819 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3822 if (phii1.ne.phii1) phii1=150.0
3827 ityp3=ithetyp((itype(i)))
3829 cosph2(k)=dcos(k*phii1)
3830 sinph2(k)=dsin(k*phii1)
3835 ityp3=ithetyp((itype(i)))
3841 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3842 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3844 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3847 ccl=cosph1(l)*cosph2(k-l)
3848 ssl=sinph1(l)*sinph2(k-l)
3849 scl=sinph1(l)*cosph2(k-l)
3850 csl=cosph1(l)*sinph2(k-l)
3851 cosph1ph2(l,k)=ccl-ssl
3852 cosph1ph2(k,l)=ccl+ssl
3853 sinph1ph2(l,k)=scl+csl
3854 sinph1ph2(k,l)=scl-csl
3858 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3859 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3860 write (iout,*) "coskt and sinkt"
3862 write (iout,*) k,coskt(k),sinkt(k)
3866 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3867 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3870 & write (iout,*) "k",k,"
3871 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3872 & " ethetai",ethetai
3875 write (iout,*) "cosph and sinph"
3877 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3879 write (iout,*) "cosph1ph2 and sinph2ph2"
3882 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3883 & sinph1ph2(l,k),sinph1ph2(k,l)
3886 write(iout,*) "ethetai",ethetai
3890 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3891 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3892 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3893 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3894 ethetai=ethetai+sinkt(m)*aux
3895 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3896 dephii=dephii+k*sinkt(m)*(
3897 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3898 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3899 dephii1=dephii1+k*sinkt(m)*(
3900 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3901 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3903 & write (iout,*) "m",m," k",k," bbthet",
3904 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3905 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3906 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3907 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3911 & write(iout,*) "ethetai",ethetai
3915 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3916 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3917 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3918 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3919 ethetai=ethetai+sinkt(m)*aux
3920 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3921 dephii=dephii+l*sinkt(m)*(
3922 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3923 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3924 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3925 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3926 dephii1=dephii1+(k-l)*sinkt(m)*(
3927 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3928 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3929 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3930 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3932 write (iout,*) "m",m," k",k," l",l," ffthet",
3933 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3934 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3935 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3936 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3937 & " ethetai",ethetai
3938 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3939 & cosph1ph2(k,l)*sinkt(m),
3940 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3946 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3947 & i,theta(i)*rad2deg,phii*rad2deg,
3948 & phii1*rad2deg,ethetai
3949 etheta=etheta+ethetai
3950 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3951 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3952 c gloc(nphi+i-2,icg)=wang*dethetai
3953 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3957 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3958 do i=1,ntheta_constr
3959 itheta=itheta_constr(i)
3960 thetiii=theta(itheta)
3961 difi=pinorm(thetiii-theta_constr0(i))
3962 if (difi.gt.theta_drange(i)) then
3963 difi=difi-theta_drange(i)
3964 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3965 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3966 & +for_thet_constr(i)*difi**3
3967 else if (difi.lt.-drange(i)) then
3969 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3970 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3971 & +for_thet_constr(i)*difi**3
3975 C if (energy_dec) then
3976 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3977 C & i,itheta,rad2deg*thetiii,
3978 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3979 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3980 C & gloc(itheta+nphi-2,icg)
3987 c-----------------------------------------------------------------------------
3988 subroutine esc(escloc)
3989 C Calculate the local energy of a side chain and its derivatives in the
3990 C corresponding virtual-bond valence angles THETA and the spherical angles
3992 implicit real*8 (a-h,o-z)
3993 include 'DIMENSIONS'
3994 include 'DIMENSIONS.ZSCOPT'
3995 include 'COMMON.GEO'
3996 include 'COMMON.LOCAL'
3997 include 'COMMON.VAR'
3998 include 'COMMON.INTERACT'
3999 include 'COMMON.DERIV'
4000 include 'COMMON.CHAIN'
4001 include 'COMMON.IOUNITS'
4002 include 'COMMON.NAMES'
4003 include 'COMMON.FFIELD'
4004 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4005 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4006 common /sccalc/ time11,time12,time112,theti,it,nlobit
4009 C write (iout,*) 'ESC'
4010 do i=loc_start,loc_end
4012 if (it.eq.ntyp1) cycle
4013 if (it.eq.10) goto 1
4014 nlobit=nlob(iabs(it))
4015 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4016 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4017 theti=theta(i+1)-pipol
4021 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4023 if (x(2).gt.pi-delta) then
4027 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4029 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4030 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4032 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4033 & ddersc0(1),dersc(1))
4034 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4035 & ddersc0(3),dersc(3))
4037 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4039 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4040 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4041 & dersc0(2),esclocbi,dersc02)
4042 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4044 call splinthet(x(2),0.5d0*delta,ss,ssd)
4049 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4051 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4052 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4054 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4056 c write (iout,*) escloci
4057 else if (x(2).lt.delta) then
4061 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4063 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4064 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4066 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4067 & ddersc0(1),dersc(1))
4068 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4069 & ddersc0(3),dersc(3))
4071 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4073 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4074 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4075 & dersc0(2),esclocbi,dersc02)
4076 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4081 call splinthet(x(2),0.5d0*delta,ss,ssd)
4083 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4085 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4086 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4088 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4089 C write (iout,*) 'i=',i, escloci
4091 call enesc(x,escloci,dersc,ddummy,.false.)
4094 escloc=escloc+escloci
4095 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4096 write (iout,'(a6,i5,0pf7.3)')
4097 & 'escloc',i,escloci
4099 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4101 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4102 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4107 C---------------------------------------------------------------------------
4108 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4109 implicit real*8 (a-h,o-z)
4110 include 'DIMENSIONS'
4111 include 'COMMON.GEO'
4112 include 'COMMON.LOCAL'
4113 include 'COMMON.IOUNITS'
4114 common /sccalc/ time11,time12,time112,theti,it,nlobit
4115 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4116 double precision contr(maxlob,-1:1)
4118 c write (iout,*) 'it=',it,' nlobit=',nlobit
4122 if (mixed) ddersc(j)=0.0d0
4126 C Because of periodicity of the dependence of the SC energy in omega we have
4127 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4128 C To avoid underflows, first compute & store the exponents.
4136 z(k)=x(k)-censc(k,j,it)
4141 Axk=Axk+gaussc(l,k,j,it)*z(l)
4147 expfac=expfac+Ax(k,j,iii)*z(k)
4155 C As in the case of ebend, we want to avoid underflows in exponentiation and
4156 C subsequent NaNs and INFs in energy calculation.
4157 C Find the largest exponent
4161 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4165 cd print *,'it=',it,' emin=',emin
4167 C Compute the contribution to SC energy and derivatives
4171 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4172 cd print *,'j=',j,' expfac=',expfac
4173 escloc_i=escloc_i+expfac
4175 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4179 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4180 & +gaussc(k,2,j,it))*expfac
4187 dersc(1)=dersc(1)/cos(theti)**2
4188 ddersc(1)=ddersc(1)/cos(theti)**2
4191 escloci=-(dlog(escloc_i)-emin)
4193 dersc(j)=dersc(j)/escloc_i
4197 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4202 C------------------------------------------------------------------------------
4203 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4204 implicit real*8 (a-h,o-z)
4205 include 'DIMENSIONS'
4206 include 'COMMON.GEO'
4207 include 'COMMON.LOCAL'
4208 include 'COMMON.IOUNITS'
4209 common /sccalc/ time11,time12,time112,theti,it,nlobit
4210 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4211 double precision contr(maxlob)
4222 z(k)=x(k)-censc(k,j,it)
4228 Axk=Axk+gaussc(l,k,j,it)*z(l)
4234 expfac=expfac+Ax(k,j)*z(k)
4239 C As in the case of ebend, we want to avoid underflows in exponentiation and
4240 C subsequent NaNs and INFs in energy calculation.
4241 C Find the largest exponent
4244 if (emin.gt.contr(j)) emin=contr(j)
4248 C Compute the contribution to SC energy and derivatives
4252 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4253 escloc_i=escloc_i+expfac
4255 dersc(k)=dersc(k)+Ax(k,j)*expfac
4257 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4258 & +gaussc(1,2,j,it))*expfac
4262 dersc(1)=dersc(1)/cos(theti)**2
4263 dersc12=dersc12/cos(theti)**2
4264 escloci=-(dlog(escloc_i)-emin)
4266 dersc(j)=dersc(j)/escloc_i
4268 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4272 c----------------------------------------------------------------------------------
4273 subroutine esc(escloc)
4274 C Calculate the local energy of a side chain and its derivatives in the
4275 C corresponding virtual-bond valence angles THETA and the spherical angles
4276 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4277 C added by Urszula Kozlowska. 07/11/2007
4279 implicit real*8 (a-h,o-z)
4280 include 'DIMENSIONS'
4281 include 'DIMENSIONS.ZSCOPT'
4282 include 'COMMON.GEO'
4283 include 'COMMON.LOCAL'
4284 include 'COMMON.VAR'
4285 include 'COMMON.SCROT'
4286 include 'COMMON.INTERACT'
4287 include 'COMMON.DERIV'
4288 include 'COMMON.CHAIN'
4289 include 'COMMON.IOUNITS'
4290 include 'COMMON.NAMES'
4291 include 'COMMON.FFIELD'
4292 include 'COMMON.CONTROL'
4293 include 'COMMON.VECTORS'
4294 double precision x_prime(3),y_prime(3),z_prime(3)
4295 & , sumene,dsc_i,dp2_i,x(65),
4296 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4297 & de_dxx,de_dyy,de_dzz,de_dt
4298 double precision s1_t,s1_6_t,s2_t,s2_6_t
4300 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4301 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4302 & dt_dCi(3),dt_dCi1(3)
4303 common /sccalc/ time11,time12,time112,theti,it,nlobit
4306 do i=loc_start,loc_end
4307 if (itype(i).eq.ntyp1) cycle
4308 costtab(i+1) =dcos(theta(i+1))
4309 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4310 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4311 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4312 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4313 cosfac=dsqrt(cosfac2)
4314 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4315 sinfac=dsqrt(sinfac2)
4317 if (it.eq.10) goto 1
4319 C Compute the axes of tghe local cartesian coordinates system; store in
4320 c x_prime, y_prime and z_prime
4327 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4328 C & dc_norm(3,i+nres)
4330 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4331 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4334 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4337 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4338 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4339 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4340 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4341 c & " xy",scalar(x_prime(1),y_prime(1)),
4342 c & " xz",scalar(x_prime(1),z_prime(1)),
4343 c & " yy",scalar(y_prime(1),y_prime(1)),
4344 c & " yz",scalar(y_prime(1),z_prime(1)),
4345 c & " zz",scalar(z_prime(1),z_prime(1))
4347 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4348 C to local coordinate system. Store in xx, yy, zz.
4354 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4355 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4356 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4363 C Compute the energy of the ith side cbain
4365 c write (2,*) "xx",xx," yy",yy," zz",zz
4368 x(j) = sc_parmin(j,it)
4371 Cc diagnostics - remove later
4373 yy1 = dsin(alph(2))*dcos(omeg(2))
4374 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4375 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4376 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4378 C," --- ", xx_w,yy_w,zz_w
4381 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4382 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4384 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4385 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4387 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4388 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4389 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4390 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4391 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4393 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4394 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4395 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4396 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4397 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4399 dsc_i = 0.743d0+x(61)
4401 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4402 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4403 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4404 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4405 s1=(1+x(63))/(0.1d0 + dscp1)
4406 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4407 s2=(1+x(65))/(0.1d0 + dscp2)
4408 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4409 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4410 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4411 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4413 c & dscp1,dscp2,sumene
4414 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4415 escloc = escloc + sumene
4416 c write (2,*) "escloc",escloc
4417 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4419 if (.not. calc_grad) goto 1
4422 C This section to check the numerical derivatives of the energy of ith side
4423 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4424 C #define DEBUG in the code to turn it on.
4426 write (2,*) "sumene =",sumene
4430 write (2,*) xx,yy,zz
4431 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4432 de_dxx_num=(sumenep-sumene)/aincr
4434 write (2,*) "xx+ sumene from enesc=",sumenep
4437 write (2,*) xx,yy,zz
4438 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4439 de_dyy_num=(sumenep-sumene)/aincr
4441 write (2,*) "yy+ sumene from enesc=",sumenep
4444 write (2,*) xx,yy,zz
4445 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4446 de_dzz_num=(sumenep-sumene)/aincr
4448 write (2,*) "zz+ sumene from enesc=",sumenep
4449 costsave=cost2tab(i+1)
4450 sintsave=sint2tab(i+1)
4451 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4452 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4453 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4454 de_dt_num=(sumenep-sumene)/aincr
4455 write (2,*) " t+ sumene from enesc=",sumenep
4456 cost2tab(i+1)=costsave
4457 sint2tab(i+1)=sintsave
4458 C End of diagnostics section.
4461 C Compute the gradient of esc
4463 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4464 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4465 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4466 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4467 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4468 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4469 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4470 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4471 pom1=(sumene3*sint2tab(i+1)+sumene1)
4472 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4473 pom2=(sumene4*cost2tab(i+1)+sumene2)
4474 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4475 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4476 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4477 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4479 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4480 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4481 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4483 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4484 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4485 & +(pom1+pom2)*pom_dx
4487 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4490 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4491 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4492 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4494 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4495 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4496 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4497 & +x(59)*zz**2 +x(60)*xx*zz
4498 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4499 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4500 & +(pom1-pom2)*pom_dy
4502 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4505 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4506 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4507 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4508 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4509 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4510 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4511 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4512 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4514 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4517 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4518 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4519 & +pom1*pom_dt1+pom2*pom_dt2
4521 write(2,*), "de_dt = ", de_dt,de_dt_num
4525 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4526 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4527 cosfac2xx=cosfac2*xx
4528 sinfac2yy=sinfac2*yy
4530 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4532 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4534 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4535 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4536 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4537 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4538 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4539 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4540 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4541 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4542 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4543 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4547 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4548 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4549 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4550 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4553 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4554 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4555 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4557 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4558 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4562 dXX_Ctab(k,i)=dXX_Ci(k)
4563 dXX_C1tab(k,i)=dXX_Ci1(k)
4564 dYY_Ctab(k,i)=dYY_Ci(k)
4565 dYY_C1tab(k,i)=dYY_Ci1(k)
4566 dZZ_Ctab(k,i)=dZZ_Ci(k)
4567 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4568 dXX_XYZtab(k,i)=dXX_XYZ(k)
4569 dYY_XYZtab(k,i)=dYY_XYZ(k)
4570 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4574 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4575 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4576 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4577 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4578 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4580 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4581 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4582 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4583 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4584 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4585 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4586 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4587 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4589 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4590 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4592 C to check gradient call subroutine check_grad
4599 c------------------------------------------------------------------------------
4600 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4602 C This procedure calculates two-body contact function g(rij) and its derivative:
4605 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4608 C where x=(rij-r0ij)/delta
4610 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4613 double precision rij,r0ij,eps0ij,fcont,fprimcont
4614 double precision x,x2,x4,delta
4618 if (x.lt.-1.0D0) then
4621 else if (x.le.1.0D0) then
4624 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4625 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4632 c------------------------------------------------------------------------------
4633 subroutine splinthet(theti,delta,ss,ssder)
4634 implicit real*8 (a-h,o-z)
4635 include 'DIMENSIONS'
4636 include 'DIMENSIONS.ZSCOPT'
4637 include 'COMMON.VAR'
4638 include 'COMMON.GEO'
4641 if (theti.gt.pipol) then
4642 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4644 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4649 c------------------------------------------------------------------------------
4650 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4652 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4653 double precision ksi,ksi2,ksi3,a1,a2,a3
4654 a1=fprim0*delta/(f1-f0)
4660 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4661 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4664 c------------------------------------------------------------------------------
4665 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4667 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4668 double precision ksi,ksi2,ksi3,a1,a2,a3
4673 a2=3*(f1x-f0x)-2*fprim0x*delta
4674 a3=fprim0x*delta-2*(f1x-f0x)
4675 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4678 C-----------------------------------------------------------------------------
4680 C-----------------------------------------------------------------------------
4681 subroutine etor(etors,edihcnstr,fact)
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'DIMENSIONS.ZSCOPT'
4685 include 'COMMON.VAR'
4686 include 'COMMON.GEO'
4687 include 'COMMON.LOCAL'
4688 include 'COMMON.TORSION'
4689 include 'COMMON.INTERACT'
4690 include 'COMMON.DERIV'
4691 include 'COMMON.CHAIN'
4692 include 'COMMON.NAMES'
4693 include 'COMMON.IOUNITS'
4694 include 'COMMON.FFIELD'
4695 include 'COMMON.TORCNSTR'
4697 C Set lprn=.true. for debugging
4701 do i=iphi_start,iphi_end
4702 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4703 & .or. itype(i).eq.ntyp1) cycle
4704 itori=itortyp(itype(i-2))
4705 itori1=itortyp(itype(i-1))
4708 C Proline-Proline pair is a special case...
4709 if (itori.eq.3 .and. itori1.eq.3) then
4710 if (phii.gt.-dwapi3) then
4712 fac=1.0D0/(1.0D0-cosphi)
4713 etorsi=v1(1,3,3)*fac
4714 etorsi=etorsi+etorsi
4715 etors=etors+etorsi-v1(1,3,3)
4716 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4719 v1ij=v1(j+1,itori,itori1)
4720 v2ij=v2(j+1,itori,itori1)
4723 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4724 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4728 v1ij=v1(j,itori,itori1)
4729 v2ij=v2(j,itori,itori1)
4732 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4733 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4737 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4738 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4739 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4740 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4741 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4743 ! 6/20/98 - dihedral angle constraints
4746 itori=idih_constr(i)
4749 if (difi.gt.drange(i)) then
4751 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4752 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4753 else if (difi.lt.-drange(i)) then
4755 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4756 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4758 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4759 C & i,itori,rad2deg*phii,
4760 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4762 ! write (iout,*) 'edihcnstr',edihcnstr
4765 c------------------------------------------------------------------------------
4767 subroutine etor(etors,edihcnstr,fact)
4768 implicit real*8 (a-h,o-z)
4769 include 'DIMENSIONS'
4770 include 'DIMENSIONS.ZSCOPT'
4771 include 'COMMON.VAR'
4772 include 'COMMON.GEO'
4773 include 'COMMON.LOCAL'
4774 include 'COMMON.TORSION'
4775 include 'COMMON.INTERACT'
4776 include 'COMMON.DERIV'
4777 include 'COMMON.CHAIN'
4778 include 'COMMON.NAMES'
4779 include 'COMMON.IOUNITS'
4780 include 'COMMON.FFIELD'
4781 include 'COMMON.TORCNSTR'
4783 C Set lprn=.true. for debugging
4787 do i=iphi_start,iphi_end
4789 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4790 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4791 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4792 C & .or. itype(i).eq.ntyp1) cycle
4793 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4794 if (iabs(itype(i)).eq.20) then
4799 itori=itortyp(itype(i-2))
4800 itori1=itortyp(itype(i-1))
4803 C Regular cosine and sine terms
4804 do j=1,nterm(itori,itori1,iblock)
4805 v1ij=v1(j,itori,itori1,iblock)
4806 v2ij=v2(j,itori,itori1,iblock)
4809 etors=etors+v1ij*cosphi+v2ij*sinphi
4810 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4814 C E = SUM ----------------------------------- - v1
4815 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4817 cosphi=dcos(0.5d0*phii)
4818 sinphi=dsin(0.5d0*phii)
4819 do j=1,nlor(itori,itori1,iblock)
4820 vl1ij=vlor1(j,itori,itori1)
4821 vl2ij=vlor2(j,itori,itori1)
4822 vl3ij=vlor3(j,itori,itori1)
4823 pom=vl2ij*cosphi+vl3ij*sinphi
4824 pom1=1.0d0/(pom*pom+1.0d0)
4825 etors=etors+vl1ij*pom1
4826 c if (energy_dec) etors_ii=etors_ii+
4829 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4831 C Subtract the constant term
4832 etors=etors-v0(itori,itori1,iblock)
4834 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4835 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4836 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4837 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4838 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4841 ! 6/20/98 - dihedral angle constraints
4844 itori=idih_constr(i)
4846 difi=pinorm(phii-phi0(i))
4848 if (difi.gt.drange(i)) then
4850 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4851 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4852 edihi=0.25d0*ftors(i)*difi**4
4853 else if (difi.lt.-drange(i)) then
4855 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4856 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4857 edihi=0.25d0*ftors(i)*difi**4
4861 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4862 & i,itori,rad2deg*phii,
4863 & rad2deg*difi,0.25d0*ftors(i)*difi**4
4864 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4866 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4867 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4869 ! write (iout,*) 'edihcnstr',edihcnstr
4872 c----------------------------------------------------------------------------
4873 subroutine etor_d(etors_d,fact2)
4874 C 6/23/01 Compute double torsional energy
4875 implicit real*8 (a-h,o-z)
4876 include 'DIMENSIONS'
4877 include 'DIMENSIONS.ZSCOPT'
4878 include 'COMMON.VAR'
4879 include 'COMMON.GEO'
4880 include 'COMMON.LOCAL'
4881 include 'COMMON.TORSION'
4882 include 'COMMON.INTERACT'
4883 include 'COMMON.DERIV'
4884 include 'COMMON.CHAIN'
4885 include 'COMMON.NAMES'
4886 include 'COMMON.IOUNITS'
4887 include 'COMMON.FFIELD'
4888 include 'COMMON.TORCNSTR'
4890 C Set lprn=.true. for debugging
4894 do i=iphi_start,iphi_end-1
4896 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4897 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4898 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4899 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4900 & (itype(i+1).eq.ntyp1)) cycle
4901 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4903 itori=itortyp(itype(i-2))
4904 itori1=itortyp(itype(i-1))
4905 itori2=itortyp(itype(i))
4911 if (iabs(itype(i+1)).eq.20) iblock=2
4912 C Regular cosine and sine terms
4913 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4914 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4915 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4916 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4917 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4918 cosphi1=dcos(j*phii)
4919 sinphi1=dsin(j*phii)
4920 cosphi2=dcos(j*phii1)
4921 sinphi2=dsin(j*phii1)
4922 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4923 & v2cij*cosphi2+v2sij*sinphi2
4924 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4925 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4927 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4929 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4930 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4931 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4932 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4933 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4934 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4935 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4936 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4937 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4938 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4939 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4940 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4941 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4942 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4945 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4946 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4952 c------------------------------------------------------------------------------
4953 subroutine eback_sc_corr(esccor)
4954 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4955 c conformational states; temporarily implemented as differences
4956 c between UNRES torsional potentials (dependent on three types of
4957 c residues) and the torsional potentials dependent on all 20 types
4958 c of residues computed from AM1 energy surfaces of terminally-blocked
4959 c amino-acid residues.
4960 implicit real*8 (a-h,o-z)
4961 include 'DIMENSIONS'
4962 include 'DIMENSIONS.ZSCOPT'
4963 include 'COMMON.VAR'
4964 include 'COMMON.GEO'
4965 include 'COMMON.LOCAL'
4966 include 'COMMON.TORSION'
4967 include 'COMMON.SCCOR'
4968 include 'COMMON.INTERACT'
4969 include 'COMMON.DERIV'
4970 include 'COMMON.CHAIN'
4971 include 'COMMON.NAMES'
4972 include 'COMMON.IOUNITS'
4973 include 'COMMON.FFIELD'
4974 include 'COMMON.CONTROL'
4976 C Set lprn=.true. for debugging
4979 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4981 do i=itau_start,itau_end
4982 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4984 isccori=isccortyp(itype(i-2))
4985 isccori1=isccortyp(itype(i-1))
4987 do intertyp=1,3 !intertyp
4988 cc Added 09 May 2012 (Adasko)
4989 cc Intertyp means interaction type of backbone mainchain correlation:
4990 c 1 = SC...Ca...Ca...Ca
4991 c 2 = Ca...Ca...Ca...SC
4992 c 3 = SC...Ca...Ca...SCi
4994 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4995 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4996 & (itype(i-1).eq.ntyp1)))
4997 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4998 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4999 & .or.(itype(i).eq.ntyp1)))
5000 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5001 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5002 & (itype(i-3).eq.ntyp1)))) cycle
5003 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5004 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5006 do j=1,nterm_sccor(isccori,isccori1)
5007 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5008 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5009 cosphi=dcos(j*tauangle(intertyp,i))
5010 sinphi=dsin(j*tauangle(intertyp,i))
5011 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5012 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5014 C write (iout,*)"EBACK_SC_COR",esccor,i
5015 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5016 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5017 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5019 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5020 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5021 & (v1sccor(j,1,itori,itori1),j=1,6)
5022 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5023 c gsccor_loc(i-3)=gloci
5028 c------------------------------------------------------------------------------
5029 subroutine multibody(ecorr)
5030 C This subroutine calculates multi-body contributions to energy following
5031 C the idea of Skolnick et al. If side chains I and J make a contact and
5032 C at the same time side chains I+1 and J+1 make a contact, an extra
5033 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5034 implicit real*8 (a-h,o-z)
5035 include 'DIMENSIONS'
5036 include 'COMMON.IOUNITS'
5037 include 'COMMON.DERIV'
5038 include 'COMMON.INTERACT'
5039 include 'COMMON.CONTACTS'
5040 double precision gx(3),gx1(3)
5043 C Set lprn=.true. for debugging
5047 write (iout,'(a)') 'Contact function values:'
5049 write (iout,'(i2,20(1x,i2,f10.5))')
5050 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5065 num_conti=num_cont(i)
5066 num_conti1=num_cont(i1)
5071 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5072 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5073 cd & ' ishift=',ishift
5074 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5075 C The system gains extra energy.
5076 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5077 endif ! j1==j+-ishift
5086 c------------------------------------------------------------------------------
5087 double precision function esccorr(i,j,k,l,jj,kk)
5088 implicit real*8 (a-h,o-z)
5089 include 'DIMENSIONS'
5090 include 'COMMON.IOUNITS'
5091 include 'COMMON.DERIV'
5092 include 'COMMON.INTERACT'
5093 include 'COMMON.CONTACTS'
5094 double precision gx(3),gx1(3)
5099 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5100 C Calculate the multi-body contribution to energy.
5101 C Calculate multi-body contributions to the gradient.
5102 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5103 cd & k,l,(gacont(m,kk,k),m=1,3)
5105 gx(m) =ekl*gacont(m,jj,i)
5106 gx1(m)=eij*gacont(m,kk,k)
5107 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5108 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5109 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5110 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5114 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5119 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5125 c------------------------------------------------------------------------------
5127 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5128 implicit real*8 (a-h,o-z)
5129 include 'DIMENSIONS'
5130 integer dimen1,dimen2,atom,indx
5131 double precision buffer(dimen1,dimen2)
5132 double precision zapas
5133 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5134 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5135 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5136 num_kont=num_cont_hb(atom)
5140 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5143 buffer(i,indx+22)=facont_hb(i,atom)
5144 buffer(i,indx+23)=ees0p(i,atom)
5145 buffer(i,indx+24)=ees0m(i,atom)
5146 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5148 buffer(1,indx+26)=dfloat(num_kont)
5151 c------------------------------------------------------------------------------
5152 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5153 implicit real*8 (a-h,o-z)
5154 include 'DIMENSIONS'
5155 integer dimen1,dimen2,atom,indx
5156 double precision buffer(dimen1,dimen2)
5157 double precision zapas
5158 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5159 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5160 & ees0m(ntyp,maxres),
5161 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5162 num_kont=buffer(1,indx+26)
5163 num_kont_old=num_cont_hb(atom)
5164 num_cont_hb(atom)=num_kont+num_kont_old
5169 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5172 facont_hb(ii,atom)=buffer(i,indx+22)
5173 ees0p(ii,atom)=buffer(i,indx+23)
5174 ees0m(ii,atom)=buffer(i,indx+24)
5175 jcont_hb(ii,atom)=buffer(i,indx+25)
5179 c------------------------------------------------------------------------------
5181 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5182 C This subroutine calculates multi-body contributions to hydrogen-bonding
5183 implicit real*8 (a-h,o-z)
5184 include 'DIMENSIONS'
5185 include 'DIMENSIONS.ZSCOPT'
5186 include 'COMMON.IOUNITS'
5188 include 'COMMON.INFO'
5190 include 'COMMON.FFIELD'
5191 include 'COMMON.DERIV'
5192 include 'COMMON.INTERACT'
5193 include 'COMMON.CONTACTS'
5195 parameter (max_cont=maxconts)
5196 parameter (max_dim=2*(8*3+2))
5197 parameter (msglen1=max_cont*max_dim*4)
5198 parameter (msglen2=2*msglen1)
5199 integer source,CorrelType,CorrelID,Error
5200 double precision buffer(max_cont,max_dim)
5202 double precision gx(3),gx1(3)
5205 C Set lprn=.true. for debugging
5210 if (fgProcs.le.1) goto 30
5212 write (iout,'(a)') 'Contact function values:'
5214 write (iout,'(2i3,50(1x,i2,f5.2))')
5215 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5216 & j=1,num_cont_hb(i))
5219 C Caution! Following code assumes that electrostatic interactions concerning
5220 C a given atom are split among at most two processors!
5230 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5233 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5234 if (MyRank.gt.0) then
5235 C Send correlation contributions to the preceding processor
5237 nn=num_cont_hb(iatel_s)
5238 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5239 cd write (iout,*) 'The BUFFER array:'
5241 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5243 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5245 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5246 C Clear the contacts of the atom passed to the neighboring processor
5247 nn=num_cont_hb(iatel_s+1)
5249 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5251 num_cont_hb(iatel_s)=0
5253 cd write (iout,*) 'Processor ',MyID,MyRank,
5254 cd & ' is sending correlation contribution to processor',MyID-1,
5255 cd & ' msglen=',msglen
5256 cd write (*,*) 'Processor ',MyID,MyRank,
5257 cd & ' is sending correlation contribution to processor',MyID-1,
5258 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5259 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5260 cd write (iout,*) 'Processor ',MyID,
5261 cd & ' has sent correlation contribution to processor',MyID-1,
5262 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5263 cd write (*,*) 'Processor ',MyID,
5264 cd & ' has sent correlation contribution to processor',MyID-1,
5265 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5267 endif ! (MyRank.gt.0)
5271 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5272 if (MyRank.lt.fgProcs-1) then
5273 C Receive correlation contributions from the next processor
5275 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5276 cd write (iout,*) 'Processor',MyID,
5277 cd & ' is receiving correlation contribution from processor',MyID+1,
5278 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5279 cd write (*,*) 'Processor',MyID,
5280 cd & ' is receiving correlation contribution from processor',MyID+1,
5281 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5283 do while (nbytes.le.0)
5284 call mp_probe(MyID+1,CorrelType,nbytes)
5286 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5287 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5288 cd write (iout,*) 'Processor',MyID,
5289 cd & ' has received correlation contribution from processor',MyID+1,
5290 cd & ' msglen=',msglen,' nbytes=',nbytes
5291 cd write (iout,*) 'The received BUFFER array:'
5293 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5295 if (msglen.eq.msglen1) then
5296 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5297 else if (msglen.eq.msglen2) then
5298 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5299 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5302 & 'ERROR!!!! message length changed while processing correlations.'
5304 & 'ERROR!!!! message length changed while processing correlations.'
5305 call mp_stopall(Error)
5306 endif ! msglen.eq.msglen1
5307 endif ! MyRank.lt.fgProcs-1
5314 write (iout,'(a)') 'Contact function values:'
5316 write (iout,'(2i3,50(1x,i2,f5.2))')
5317 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5318 & j=1,num_cont_hb(i))
5322 C Remove the loop below after debugging !!!
5329 C Calculate the local-electrostatic correlation terms
5330 do i=iatel_s,iatel_e+1
5332 num_conti=num_cont_hb(i)
5333 num_conti1=num_cont_hb(i+1)
5338 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5339 c & ' jj=',jj,' kk=',kk
5340 if (j1.eq.j+1 .or. j1.eq.j-1) then
5341 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5342 C The system gains extra energy.
5343 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5345 else if (j1.eq.j) then
5346 C Contacts I-J and I-(J+1) occur simultaneously.
5347 C The system loses extra energy.
5348 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5353 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5354 c & ' jj=',jj,' kk=',kk
5356 C Contacts I-J and (I+1)-J occur simultaneously.
5357 C The system loses extra energy.
5358 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5365 c------------------------------------------------------------------------------
5366 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5368 C This subroutine calculates multi-body contributions to hydrogen-bonding
5369 implicit real*8 (a-h,o-z)
5370 include 'DIMENSIONS'
5371 include 'DIMENSIONS.ZSCOPT'
5372 include 'COMMON.IOUNITS'
5374 include 'COMMON.INFO'
5376 include 'COMMON.FFIELD'
5377 include 'COMMON.DERIV'
5378 include 'COMMON.INTERACT'
5379 include 'COMMON.CONTACTS'
5381 parameter (max_cont=maxconts)
5382 parameter (max_dim=2*(8*3+2))
5383 parameter (msglen1=max_cont*max_dim*4)
5384 parameter (msglen2=2*msglen1)
5385 integer source,CorrelType,CorrelID,Error
5386 double precision buffer(max_cont,max_dim)
5388 double precision gx(3),gx1(3)
5391 C Set lprn=.true. for debugging
5397 if (fgProcs.le.1) goto 30
5399 write (iout,'(a)') 'Contact function values:'
5401 write (iout,'(2i3,50(1x,i2,f5.2))')
5402 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5403 & j=1,num_cont_hb(i))
5406 C Caution! Following code assumes that electrostatic interactions concerning
5407 C a given atom are split among at most two processors!
5417 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5420 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5421 if (MyRank.gt.0) then
5422 C Send correlation contributions to the preceding processor
5424 nn=num_cont_hb(iatel_s)
5425 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5426 cd write (iout,*) 'The BUFFER array:'
5428 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5430 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5432 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5433 C Clear the contacts of the atom passed to the neighboring processor
5434 nn=num_cont_hb(iatel_s+1)
5436 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5438 num_cont_hb(iatel_s)=0
5440 cd write (iout,*) 'Processor ',MyID,MyRank,
5441 cd & ' is sending correlation contribution to processor',MyID-1,
5442 cd & ' msglen=',msglen
5443 cd write (*,*) 'Processor ',MyID,MyRank,
5444 cd & ' is sending correlation contribution to processor',MyID-1,
5445 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5446 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5447 cd write (iout,*) 'Processor ',MyID,
5448 cd & ' has sent correlation contribution to processor',MyID-1,
5449 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5450 cd write (*,*) 'Processor ',MyID,
5451 cd & ' has sent correlation contribution to processor',MyID-1,
5452 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5454 endif ! (MyRank.gt.0)
5458 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5459 if (MyRank.lt.fgProcs-1) then
5460 C Receive correlation contributions from the next processor
5462 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5463 cd write (iout,*) 'Processor',MyID,
5464 cd & ' is receiving correlation contribution from processor',MyID+1,
5465 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5466 cd write (*,*) 'Processor',MyID,
5467 cd & ' is receiving correlation contribution from processor',MyID+1,
5468 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5470 do while (nbytes.le.0)
5471 call mp_probe(MyID+1,CorrelType,nbytes)
5473 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5474 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5475 cd write (iout,*) 'Processor',MyID,
5476 cd & ' has received correlation contribution from processor',MyID+1,
5477 cd & ' msglen=',msglen,' nbytes=',nbytes
5478 cd write (iout,*) 'The received BUFFER array:'
5480 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5482 if (msglen.eq.msglen1) then
5483 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5484 else if (msglen.eq.msglen2) then
5485 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5486 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5489 & 'ERROR!!!! message length changed while processing correlations.'
5491 & 'ERROR!!!! message length changed while processing correlations.'
5492 call mp_stopall(Error)
5493 endif ! msglen.eq.msglen1
5494 endif ! MyRank.lt.fgProcs-1
5501 write (iout,'(a)') 'Contact function values:'
5503 write (iout,'(2i3,50(1x,i2,f5.2))')
5504 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5505 & j=1,num_cont_hb(i))
5511 C Remove the loop below after debugging !!!
5518 C Calculate the dipole-dipole interaction energies
5519 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5520 do i=iatel_s,iatel_e+1
5521 num_conti=num_cont_hb(i)
5528 C Calculate the local-electrostatic correlation terms
5529 do i=iatel_s,iatel_e+1
5531 num_conti=num_cont_hb(i)
5532 num_conti1=num_cont_hb(i+1)
5537 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5538 c & ' jj=',jj,' kk=',kk
5539 if (j1.eq.j+1 .or. j1.eq.j-1) then
5540 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5541 C The system gains extra energy.
5543 sqd1=dsqrt(d_cont(jj,i))
5544 sqd2=dsqrt(d_cont(kk,i1))
5545 sred_geom = sqd1*sqd2
5546 IF (sred_geom.lt.cutoff_corr) THEN
5547 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5549 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5550 c & ' jj=',jj,' kk=',kk
5551 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5552 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5554 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5555 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5558 cd write (iout,*) 'sred_geom=',sred_geom,
5559 cd & ' ekont=',ekont,' fprim=',fprimcont
5560 call calc_eello(i,j,i+1,j1,jj,kk)
5561 if (wcorr4.gt.0.0d0)
5562 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5563 if (wcorr5.gt.0.0d0)
5564 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5565 c print *,"wcorr5",ecorr5
5566 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5567 cd write(2,*)'ijkl',i,j,i+1,j1
5568 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5569 & .or. wturn6.eq.0.0d0))then
5570 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5571 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5572 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5573 cd & 'ecorr6=',ecorr6
5574 cd write (iout,'(4e15.5)') sred_geom,
5575 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5576 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5577 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5578 else if (wturn6.gt.0.0d0
5579 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5580 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5581 eturn6=eturn6+eello_turn6(i,jj,kk)
5582 cd write (2,*) 'multibody_eello:eturn6',eturn6
5586 else if (j1.eq.j) then
5587 C Contacts I-J and I-(J+1) occur simultaneously.
5588 C The system loses extra energy.
5589 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5594 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5595 c & ' jj=',jj,' kk=',kk
5597 C Contacts I-J and (I+1)-J occur simultaneously.
5598 C The system loses extra energy.
5599 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5606 c------------------------------------------------------------------------------
5607 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5608 implicit real*8 (a-h,o-z)
5609 include 'DIMENSIONS'
5610 include 'COMMON.IOUNITS'
5611 include 'COMMON.DERIV'
5612 include 'COMMON.INTERACT'
5613 include 'COMMON.CONTACTS'
5614 double precision gx(3),gx1(3)
5624 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5625 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5626 C Following 4 lines for diagnostics.
5631 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5633 c write (iout,*)'Contacts have occurred for peptide groups',
5634 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5635 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5636 C Calculate the multi-body contribution to energy.
5637 ecorr=ecorr+ekont*ees
5639 C Calculate multi-body contributions to the gradient.
5641 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5642 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5643 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5644 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5645 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5646 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5647 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5648 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5649 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5650 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5651 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5652 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5653 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5654 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5658 gradcorr(ll,m)=gradcorr(ll,m)+
5659 & ees*ekl*gacont_hbr(ll,jj,i)-
5660 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5661 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5666 gradcorr(ll,m)=gradcorr(ll,m)+
5667 & ees*eij*gacont_hbr(ll,kk,k)-
5668 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5669 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5676 C---------------------------------------------------------------------------
5677 subroutine dipole(i,j,jj)
5678 implicit real*8 (a-h,o-z)
5679 include 'DIMENSIONS'
5680 include 'DIMENSIONS.ZSCOPT'
5681 include 'COMMON.IOUNITS'
5682 include 'COMMON.CHAIN'
5683 include 'COMMON.FFIELD'
5684 include 'COMMON.DERIV'
5685 include 'COMMON.INTERACT'
5686 include 'COMMON.CONTACTS'
5687 include 'COMMON.TORSION'
5688 include 'COMMON.VAR'
5689 include 'COMMON.GEO'
5690 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5692 iti1 = itortyp(itype(i+1))
5693 if (j.lt.nres-1) then
5694 if (itype(j).le.ntyp) then
5695 itj1 = itortyp(itype(j+1))
5703 dipi(iii,1)=Ub2(iii,i)
5704 dipderi(iii)=Ub2der(iii,i)
5705 dipi(iii,2)=b1(iii,iti1)
5706 dipj(iii,1)=Ub2(iii,j)
5707 dipderj(iii)=Ub2der(iii,j)
5708 dipj(iii,2)=b1(iii,itj1)
5712 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5715 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5718 if (.not.calc_grad) return
5723 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5727 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5732 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5733 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5735 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5737 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5739 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5743 C---------------------------------------------------------------------------
5744 subroutine calc_eello(i,j,k,l,jj,kk)
5746 C This subroutine computes matrices and vectors needed to calculate
5747 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5749 implicit real*8 (a-h,o-z)
5750 include 'DIMENSIONS'
5751 include 'DIMENSIONS.ZSCOPT'
5752 include 'COMMON.IOUNITS'
5753 include 'COMMON.CHAIN'
5754 include 'COMMON.DERIV'
5755 include 'COMMON.INTERACT'
5756 include 'COMMON.CONTACTS'
5757 include 'COMMON.TORSION'
5758 include 'COMMON.VAR'
5759 include 'COMMON.GEO'
5760 include 'COMMON.FFIELD'
5761 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5762 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5765 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5766 cd & ' jj=',jj,' kk=',kk
5767 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5770 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5771 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5774 call transpose2(aa1(1,1),aa1t(1,1))
5775 call transpose2(aa2(1,1),aa2t(1,1))
5778 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5779 & aa1tder(1,1,lll,kkk))
5780 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5781 & aa2tder(1,1,lll,kkk))
5785 C parallel orientation of the two CA-CA-CA frames.
5786 if (i.gt.1 .and. itype(i).le.ntyp) then
5787 iti=itortyp(itype(i))
5791 itk1=itortyp(itype(k+1))
5792 itj=itortyp(itype(j))
5793 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5794 itl1=itortyp(itype(l+1))
5798 C A1 kernel(j+1) A2T
5800 cd write (iout,'(3f10.5,5x,3f10.5)')
5801 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5803 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5804 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5805 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5806 C Following matrices are needed only for 6-th order cumulants
5807 IF (wcorr6.gt.0.0d0) THEN
5808 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5809 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5810 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5811 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5812 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5813 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5814 & ADtEAderx(1,1,1,1,1,1))
5816 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5817 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5818 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5819 & ADtEA1derx(1,1,1,1,1,1))
5821 C End 6-th order cumulants
5824 cd write (2,*) 'In calc_eello6'
5826 cd write (2,*) 'iii=',iii
5828 cd write (2,*) 'kkk=',kkk
5830 cd write (2,'(3(2f10.5),5x)')
5831 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5836 call transpose2(EUgder(1,1,k),auxmat(1,1))
5837 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5838 call transpose2(EUg(1,1,k),auxmat(1,1))
5839 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5840 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5844 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5845 & EAEAderx(1,1,lll,kkk,iii,1))
5849 C A1T kernel(i+1) A2
5850 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5851 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5852 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5853 C Following matrices are needed only for 6-th order cumulants
5854 IF (wcorr6.gt.0.0d0) THEN
5855 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5856 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5857 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5858 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5859 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5860 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5861 & ADtEAderx(1,1,1,1,1,2))
5862 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5863 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5864 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5865 & ADtEA1derx(1,1,1,1,1,2))
5867 C End 6-th order cumulants
5868 call transpose2(EUgder(1,1,l),auxmat(1,1))
5869 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5870 call transpose2(EUg(1,1,l),auxmat(1,1))
5871 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5872 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5876 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5877 & EAEAderx(1,1,lll,kkk,iii,2))
5882 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5883 C They are needed only when the fifth- or the sixth-order cumulants are
5885 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5886 call transpose2(AEA(1,1,1),auxmat(1,1))
5887 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5888 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5889 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5890 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5891 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5892 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5893 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5894 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5895 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5896 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5897 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5898 call transpose2(AEA(1,1,2),auxmat(1,1))
5899 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5900 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5901 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5902 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5903 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5904 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5905 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5906 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5907 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5908 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5909 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5910 C Calculate the Cartesian derivatives of the vectors.
5914 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5915 call matvec2(auxmat(1,1),b1(1,iti),
5916 & AEAb1derx(1,lll,kkk,iii,1,1))
5917 call matvec2(auxmat(1,1),Ub2(1,i),
5918 & AEAb2derx(1,lll,kkk,iii,1,1))
5919 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5920 & AEAb1derx(1,lll,kkk,iii,2,1))
5921 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5922 & AEAb2derx(1,lll,kkk,iii,2,1))
5923 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5924 call matvec2(auxmat(1,1),b1(1,itj),
5925 & AEAb1derx(1,lll,kkk,iii,1,2))
5926 call matvec2(auxmat(1,1),Ub2(1,j),
5927 & AEAb2derx(1,lll,kkk,iii,1,2))
5928 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5929 & AEAb1derx(1,lll,kkk,iii,2,2))
5930 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5931 & AEAb2derx(1,lll,kkk,iii,2,2))
5938 C Antiparallel orientation of the two CA-CA-CA frames.
5939 if (i.gt.1 .and. itype(i).le.ntyp) then
5940 iti=itortyp(itype(i))
5944 itk1=itortyp(itype(k+1))
5945 itl=itortyp(itype(l))
5946 itj=itortyp(itype(j))
5947 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5948 itj1=itortyp(itype(j+1))
5952 C A2 kernel(j-1)T A1T
5953 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5954 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5955 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5956 C Following matrices are needed only for 6-th order cumulants
5957 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5958 & j.eq.i+4 .and. l.eq.i+3)) THEN
5959 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5960 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5961 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5962 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5963 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5964 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5965 & ADtEAderx(1,1,1,1,1,1))
5966 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5967 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5968 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5969 & ADtEA1derx(1,1,1,1,1,1))
5971 C End 6-th order cumulants
5972 call transpose2(EUgder(1,1,k),auxmat(1,1))
5973 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5974 call transpose2(EUg(1,1,k),auxmat(1,1))
5975 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5976 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5980 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5981 & EAEAderx(1,1,lll,kkk,iii,1))
5985 C A2T kernel(i+1)T A1
5986 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5987 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5988 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5989 C Following matrices are needed only for 6-th order cumulants
5990 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5991 & j.eq.i+4 .and. l.eq.i+3)) THEN
5992 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5993 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5994 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5995 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5996 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5997 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5998 & ADtEAderx(1,1,1,1,1,2))
5999 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6000 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6001 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6002 & ADtEA1derx(1,1,1,1,1,2))
6004 C End 6-th order cumulants
6005 call transpose2(EUgder(1,1,j),auxmat(1,1))
6006 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6007 call transpose2(EUg(1,1,j),auxmat(1,1))
6008 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6009 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6013 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6014 & EAEAderx(1,1,lll,kkk,iii,2))
6019 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6020 C They are needed only when the fifth- or the sixth-order cumulants are
6022 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6023 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6024 call transpose2(AEA(1,1,1),auxmat(1,1))
6025 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6026 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6027 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6028 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6029 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6030 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6031 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6032 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6033 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6034 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6035 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6036 call transpose2(AEA(1,1,2),auxmat(1,1))
6037 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6038 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6039 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6040 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6041 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6042 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6043 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6044 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6045 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6046 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6047 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6048 C Calculate the Cartesian derivatives of the vectors.
6052 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6053 call matvec2(auxmat(1,1),b1(1,iti),
6054 & AEAb1derx(1,lll,kkk,iii,1,1))
6055 call matvec2(auxmat(1,1),Ub2(1,i),
6056 & AEAb2derx(1,lll,kkk,iii,1,1))
6057 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6058 & AEAb1derx(1,lll,kkk,iii,2,1))
6059 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6060 & AEAb2derx(1,lll,kkk,iii,2,1))
6061 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6062 call matvec2(auxmat(1,1),b1(1,itl),
6063 & AEAb1derx(1,lll,kkk,iii,1,2))
6064 call matvec2(auxmat(1,1),Ub2(1,l),
6065 & AEAb2derx(1,lll,kkk,iii,1,2))
6066 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6067 & AEAb1derx(1,lll,kkk,iii,2,2))
6068 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6069 & AEAb2derx(1,lll,kkk,iii,2,2))
6078 C---------------------------------------------------------------------------
6079 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6080 & KK,KKderg,AKA,AKAderg,AKAderx)
6084 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6085 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6086 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6091 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6093 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6096 cd if (lprn) write (2,*) 'In kernel'
6098 cd if (lprn) write (2,*) 'kkk=',kkk
6100 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6101 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6103 cd write (2,*) 'lll=',lll
6104 cd write (2,*) 'iii=1'
6106 cd write (2,'(3(2f10.5),5x)')
6107 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6110 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6111 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6113 cd write (2,*) 'lll=',lll
6114 cd write (2,*) 'iii=2'
6116 cd write (2,'(3(2f10.5),5x)')
6117 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6124 C---------------------------------------------------------------------------
6125 double precision function eello4(i,j,k,l,jj,kk)
6126 implicit real*8 (a-h,o-z)
6127 include 'DIMENSIONS'
6128 include 'DIMENSIONS.ZSCOPT'
6129 include 'COMMON.IOUNITS'
6130 include 'COMMON.CHAIN'
6131 include 'COMMON.DERIV'
6132 include 'COMMON.INTERACT'
6133 include 'COMMON.CONTACTS'
6134 include 'COMMON.TORSION'
6135 include 'COMMON.VAR'
6136 include 'COMMON.GEO'
6137 double precision pizda(2,2),ggg1(3),ggg2(3)
6138 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6142 cd print *,'eello4:',i,j,k,l,jj,kk
6143 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6144 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6145 cold eij=facont_hb(jj,i)
6146 cold ekl=facont_hb(kk,k)
6148 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6150 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6151 gcorr_loc(k-1)=gcorr_loc(k-1)
6152 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6154 gcorr_loc(l-1)=gcorr_loc(l-1)
6155 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6157 gcorr_loc(j-1)=gcorr_loc(j-1)
6158 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6163 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6164 & -EAEAderx(2,2,lll,kkk,iii,1)
6165 cd derx(lll,kkk,iii)=0.0d0
6169 cd gcorr_loc(l-1)=0.0d0
6170 cd gcorr_loc(j-1)=0.0d0
6171 cd gcorr_loc(k-1)=0.0d0
6173 cd write (iout,*)'Contacts have occurred for peptide groups',
6174 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6175 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6176 if (j.lt.nres-1) then
6183 if (l.lt.nres-1) then
6191 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6192 ggg1(ll)=eel4*g_contij(ll,1)
6193 ggg2(ll)=eel4*g_contij(ll,2)
6194 ghalf=0.5d0*ggg1(ll)
6196 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6197 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6198 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6199 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6200 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6201 ghalf=0.5d0*ggg2(ll)
6203 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6204 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6205 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6206 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6211 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6212 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6217 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6218 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6224 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6229 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6233 cd write (2,*) iii,gcorr_loc(iii)
6237 cd write (2,*) 'ekont',ekont
6238 cd write (iout,*) 'eello4',ekont*eel4
6241 C---------------------------------------------------------------------------
6242 double precision function eello5(i,j,k,l,jj,kk)
6243 implicit real*8 (a-h,o-z)
6244 include 'DIMENSIONS'
6245 include 'DIMENSIONS.ZSCOPT'
6246 include 'COMMON.IOUNITS'
6247 include 'COMMON.CHAIN'
6248 include 'COMMON.DERIV'
6249 include 'COMMON.INTERACT'
6250 include 'COMMON.CONTACTS'
6251 include 'COMMON.TORSION'
6252 include 'COMMON.VAR'
6253 include 'COMMON.GEO'
6254 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6255 double precision ggg1(3),ggg2(3)
6256 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6261 C /l\ / \ \ / \ / \ / C
6262 C / \ / \ \ / \ / \ / C
6263 C j| o |l1 | o | o| o | | o |o C
6264 C \ |/k\| |/ \| / |/ \| |/ \| C
6265 C \i/ \ / \ / / \ / \ C
6267 C (I) (II) (III) (IV) C
6269 C eello5_1 eello5_2 eello5_3 eello5_4 C
6271 C Antiparallel chains C
6274 C /j\ / \ \ / \ / \ / C
6275 C / \ / \ \ / \ / \ / C
6276 C j1| o |l | o | o| o | | o |o C
6277 C \ |/k\| |/ \| / |/ \| |/ \| C
6278 C \i/ \ / \ / / \ / \ C
6280 C (I) (II) (III) (IV) C
6282 C eello5_1 eello5_2 eello5_3 eello5_4 C
6284 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6286 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6287 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6292 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6294 itk=itortyp(itype(k))
6295 itl=itortyp(itype(l))
6296 itj=itortyp(itype(j))
6301 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6302 cd & eel5_3_num,eel5_4_num)
6306 derx(lll,kkk,iii)=0.0d0
6310 cd eij=facont_hb(jj,i)
6311 cd ekl=facont_hb(kk,k)
6313 cd write (iout,*)'Contacts have occurred for peptide groups',
6314 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6316 C Contribution from the graph I.
6317 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6318 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6319 call transpose2(EUg(1,1,k),auxmat(1,1))
6320 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6321 vv(1)=pizda(1,1)-pizda(2,2)
6322 vv(2)=pizda(1,2)+pizda(2,1)
6323 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6324 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6326 C Explicit gradient in virtual-dihedral angles.
6327 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6328 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6329 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6330 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6331 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6332 vv(1)=pizda(1,1)-pizda(2,2)
6333 vv(2)=pizda(1,2)+pizda(2,1)
6334 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6335 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6336 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6337 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6338 vv(1)=pizda(1,1)-pizda(2,2)
6339 vv(2)=pizda(1,2)+pizda(2,1)
6341 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6342 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6343 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6345 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6346 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6347 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6349 C Cartesian gradient
6353 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6355 vv(1)=pizda(1,1)-pizda(2,2)
6356 vv(2)=pizda(1,2)+pizda(2,1)
6357 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6358 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6359 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6366 C Contribution from graph II
6367 call transpose2(EE(1,1,itk),auxmat(1,1))
6368 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6369 vv(1)=pizda(1,1)+pizda(2,2)
6370 vv(2)=pizda(2,1)-pizda(1,2)
6371 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6372 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6374 C Explicit gradient in virtual-dihedral angles.
6375 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6376 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6377 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6378 vv(1)=pizda(1,1)+pizda(2,2)
6379 vv(2)=pizda(2,1)-pizda(1,2)
6381 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6382 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6383 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6385 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6386 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6387 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6389 C Cartesian gradient
6393 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6395 vv(1)=pizda(1,1)+pizda(2,2)
6396 vv(2)=pizda(2,1)-pizda(1,2)
6397 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6398 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6399 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6408 C Parallel orientation
6409 C Contribution from graph III
6410 call transpose2(EUg(1,1,l),auxmat(1,1))
6411 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6412 vv(1)=pizda(1,1)-pizda(2,2)
6413 vv(2)=pizda(1,2)+pizda(2,1)
6414 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6415 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6417 C Explicit gradient in virtual-dihedral angles.
6418 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6419 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6420 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6421 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6422 vv(1)=pizda(1,1)-pizda(2,2)
6423 vv(2)=pizda(1,2)+pizda(2,1)
6424 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6425 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6426 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6427 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6428 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6429 vv(1)=pizda(1,1)-pizda(2,2)
6430 vv(2)=pizda(1,2)+pizda(2,1)
6431 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6432 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6433 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6434 C Cartesian gradient
6438 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6440 vv(1)=pizda(1,1)-pizda(2,2)
6441 vv(2)=pizda(1,2)+pizda(2,1)
6442 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6443 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6444 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6450 C Contribution from graph IV
6452 call transpose2(EE(1,1,itl),auxmat(1,1))
6453 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6454 vv(1)=pizda(1,1)+pizda(2,2)
6455 vv(2)=pizda(2,1)-pizda(1,2)
6456 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6457 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6459 C Explicit gradient in virtual-dihedral angles.
6460 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6461 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6462 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6463 vv(1)=pizda(1,1)+pizda(2,2)
6464 vv(2)=pizda(2,1)-pizda(1,2)
6465 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6466 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6467 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6468 C Cartesian gradient
6472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6474 vv(1)=pizda(1,1)+pizda(2,2)
6475 vv(2)=pizda(2,1)-pizda(1,2)
6476 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6477 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6478 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6484 C Antiparallel orientation
6485 C Contribution from graph III
6487 call transpose2(EUg(1,1,j),auxmat(1,1))
6488 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6489 vv(1)=pizda(1,1)-pizda(2,2)
6490 vv(2)=pizda(1,2)+pizda(2,1)
6491 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6492 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6494 C Explicit gradient in virtual-dihedral angles.
6495 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6496 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6497 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6498 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6499 vv(1)=pizda(1,1)-pizda(2,2)
6500 vv(2)=pizda(1,2)+pizda(2,1)
6501 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6502 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6503 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6504 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6505 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6506 vv(1)=pizda(1,1)-pizda(2,2)
6507 vv(2)=pizda(1,2)+pizda(2,1)
6508 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6509 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6510 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6511 C Cartesian gradient
6515 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6517 vv(1)=pizda(1,1)-pizda(2,2)
6518 vv(2)=pizda(1,2)+pizda(2,1)
6519 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6520 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6521 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6527 C Contribution from graph IV
6529 call transpose2(EE(1,1,itj),auxmat(1,1))
6530 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6531 vv(1)=pizda(1,1)+pizda(2,2)
6532 vv(2)=pizda(2,1)-pizda(1,2)
6533 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6534 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6536 C Explicit gradient in virtual-dihedral angles.
6537 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6538 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6539 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6540 vv(1)=pizda(1,1)+pizda(2,2)
6541 vv(2)=pizda(2,1)-pizda(1,2)
6542 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6543 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6544 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6545 C Cartesian gradient
6549 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6551 vv(1)=pizda(1,1)+pizda(2,2)
6552 vv(2)=pizda(2,1)-pizda(1,2)
6553 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6554 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6555 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6562 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6563 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6564 cd write (2,*) 'ijkl',i,j,k,l
6565 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6566 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6568 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6569 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6570 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6571 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6573 if (j.lt.nres-1) then
6580 if (l.lt.nres-1) then
6590 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6592 ggg1(ll)=eel5*g_contij(ll,1)
6593 ggg2(ll)=eel5*g_contij(ll,2)
6594 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6595 ghalf=0.5d0*ggg1(ll)
6597 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6598 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6599 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6600 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6601 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6602 ghalf=0.5d0*ggg2(ll)
6604 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6605 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6606 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6607 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6612 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6613 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6618 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6619 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6625 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6630 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6634 cd write (2,*) iii,g_corr5_loc(iii)
6638 cd write (2,*) 'ekont',ekont
6639 cd write (iout,*) 'eello5',ekont*eel5
6642 c--------------------------------------------------------------------------
6643 double precision function eello6(i,j,k,l,jj,kk)
6644 implicit real*8 (a-h,o-z)
6645 include 'DIMENSIONS'
6646 include 'DIMENSIONS.ZSCOPT'
6647 include 'COMMON.IOUNITS'
6648 include 'COMMON.CHAIN'
6649 include 'COMMON.DERIV'
6650 include 'COMMON.INTERACT'
6651 include 'COMMON.CONTACTS'
6652 include 'COMMON.TORSION'
6653 include 'COMMON.VAR'
6654 include 'COMMON.GEO'
6655 include 'COMMON.FFIELD'
6656 double precision ggg1(3),ggg2(3)
6657 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6662 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6670 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6671 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6675 derx(lll,kkk,iii)=0.0d0
6679 cd eij=facont_hb(jj,i)
6680 cd ekl=facont_hb(kk,k)
6686 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6687 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6688 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6689 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6690 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6691 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6693 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6694 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6695 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6696 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6697 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6698 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6702 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6704 C If turn contributions are considered, they will be handled separately.
6705 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6706 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6707 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6708 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6709 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6710 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6711 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6714 if (j.lt.nres-1) then
6721 if (l.lt.nres-1) then
6729 ggg1(ll)=eel6*g_contij(ll,1)
6730 ggg2(ll)=eel6*g_contij(ll,2)
6731 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6732 ghalf=0.5d0*ggg1(ll)
6734 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6735 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6736 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6737 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6738 ghalf=0.5d0*ggg2(ll)
6739 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6741 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6742 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6743 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6744 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6749 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6750 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6755 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6756 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6762 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6767 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6771 cd write (2,*) iii,g_corr6_loc(iii)
6775 cd write (2,*) 'ekont',ekont
6776 cd write (iout,*) 'eello6',ekont*eel6
6779 c--------------------------------------------------------------------------
6780 double precision function eello6_graph1(i,j,k,l,imat,swap)
6781 implicit real*8 (a-h,o-z)
6782 include 'DIMENSIONS'
6783 include 'DIMENSIONS.ZSCOPT'
6784 include 'COMMON.IOUNITS'
6785 include 'COMMON.CHAIN'
6786 include 'COMMON.DERIV'
6787 include 'COMMON.INTERACT'
6788 include 'COMMON.CONTACTS'
6789 include 'COMMON.TORSION'
6790 include 'COMMON.VAR'
6791 include 'COMMON.GEO'
6792 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6796 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6798 C Parallel Antiparallel C
6804 C \ j|/k\| / \ |/k\|l / C
6809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6810 itk=itortyp(itype(k))
6811 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6812 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6813 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6814 call transpose2(EUgC(1,1,k),auxmat(1,1))
6815 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6816 vv1(1)=pizda1(1,1)-pizda1(2,2)
6817 vv1(2)=pizda1(1,2)+pizda1(2,1)
6818 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6819 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6820 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6821 s5=scalar2(vv(1),Dtobr2(1,i))
6822 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6823 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6824 if (.not. calc_grad) return
6825 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6826 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6827 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6828 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6829 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6830 & +scalar2(vv(1),Dtobr2der(1,i)))
6831 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6832 vv1(1)=pizda1(1,1)-pizda1(2,2)
6833 vv1(2)=pizda1(1,2)+pizda1(2,1)
6834 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6835 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6837 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6838 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6839 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6840 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6841 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6843 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6844 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6845 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6846 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6847 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6849 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6850 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6851 vv1(1)=pizda1(1,1)-pizda1(2,2)
6852 vv1(2)=pizda1(1,2)+pizda1(2,1)
6853 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6854 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6855 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6856 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6865 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6866 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6867 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6868 call transpose2(EUgC(1,1,k),auxmat(1,1))
6869 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6871 vv1(1)=pizda1(1,1)-pizda1(2,2)
6872 vv1(2)=pizda1(1,2)+pizda1(2,1)
6873 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6874 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6875 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6876 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6877 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6878 s5=scalar2(vv(1),Dtobr2(1,i))
6879 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6885 c----------------------------------------------------------------------------
6886 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6887 implicit real*8 (a-h,o-z)
6888 include 'DIMENSIONS'
6889 include 'DIMENSIONS.ZSCOPT'
6890 include 'COMMON.IOUNITS'
6891 include 'COMMON.CHAIN'
6892 include 'COMMON.DERIV'
6893 include 'COMMON.INTERACT'
6894 include 'COMMON.CONTACTS'
6895 include 'COMMON.TORSION'
6896 include 'COMMON.VAR'
6897 include 'COMMON.GEO'
6899 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6900 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6903 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6905 C Parallel Antiparallel C
6911 C \ j|/k\| \ |/k\|l C
6916 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6917 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6918 C AL 7/4/01 s1 would occur in the sixth-order moment,
6919 C but not in a cluster cumulant
6921 s1=dip(1,jj,i)*dip(1,kk,k)
6923 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6924 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6925 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6926 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6927 call transpose2(EUg(1,1,k),auxmat(1,1))
6928 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6929 vv(1)=pizda(1,1)-pizda(2,2)
6930 vv(2)=pizda(1,2)+pizda(2,1)
6931 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6932 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6934 eello6_graph2=-(s1+s2+s3+s4)
6936 eello6_graph2=-(s2+s3+s4)
6939 if (.not. calc_grad) return
6940 C Derivatives in gamma(i-1)
6943 s1=dipderg(1,jj,i)*dip(1,kk,k)
6945 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6946 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6947 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6948 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6950 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6952 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6954 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6956 C Derivatives in gamma(k-1)
6958 s1=dip(1,jj,i)*dipderg(1,kk,k)
6960 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6961 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6962 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6963 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6964 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6965 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6966 vv(1)=pizda(1,1)-pizda(2,2)
6967 vv(2)=pizda(1,2)+pizda(2,1)
6968 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6970 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6974 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6975 C Derivatives in gamma(j-1) or gamma(l-1)
6978 s1=dipderg(3,jj,i)*dip(1,kk,k)
6980 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6981 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6982 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6983 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6984 vv(1)=pizda(1,1)-pizda(2,2)
6985 vv(2)=pizda(1,2)+pizda(2,1)
6986 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6989 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6991 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6994 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6995 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6997 C Derivatives in gamma(l-1) or gamma(j-1)
7000 s1=dip(1,jj,i)*dipderg(3,kk,k)
7002 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7003 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7004 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7005 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7006 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7007 vv(1)=pizda(1,1)-pizda(2,2)
7008 vv(2)=pizda(1,2)+pizda(2,1)
7009 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7012 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7014 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7017 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7018 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7020 C Cartesian derivatives.
7022 write (2,*) 'In eello6_graph2'
7024 write (2,*) 'iii=',iii
7026 write (2,*) 'kkk=',kkk
7028 write (2,'(3(2f10.5),5x)')
7029 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7039 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7041 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7044 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7046 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7047 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7049 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7050 call transpose2(EUg(1,1,k),auxmat(1,1))
7051 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7053 vv(1)=pizda(1,1)-pizda(2,2)
7054 vv(2)=pizda(1,2)+pizda(2,1)
7055 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7056 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7058 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7060 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7063 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7065 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7072 c----------------------------------------------------------------------------
7073 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7074 implicit real*8 (a-h,o-z)
7075 include 'DIMENSIONS'
7076 include 'DIMENSIONS.ZSCOPT'
7077 include 'COMMON.IOUNITS'
7078 include 'COMMON.CHAIN'
7079 include 'COMMON.DERIV'
7080 include 'COMMON.INTERACT'
7081 include 'COMMON.CONTACTS'
7082 include 'COMMON.TORSION'
7083 include 'COMMON.VAR'
7084 include 'COMMON.GEO'
7085 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7087 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7089 C Parallel Antiparallel C
7095 C j|/k\| / |/k\|l / C
7100 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7102 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7103 C energy moment and not to the cluster cumulant.
7104 iti=itortyp(itype(i))
7105 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7106 itj1=itortyp(itype(j+1))
7110 itk=itortyp(itype(k))
7111 itk1=itortyp(itype(k+1))
7112 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7113 itl1=itortyp(itype(l+1))
7118 s1=dip(4,jj,i)*dip(4,kk,k)
7120 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7121 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7122 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7123 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7124 call transpose2(EE(1,1,itk),auxmat(1,1))
7125 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7126 vv(1)=pizda(1,1)+pizda(2,2)
7127 vv(2)=pizda(2,1)-pizda(1,2)
7128 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7129 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7131 eello6_graph3=-(s1+s2+s3+s4)
7133 eello6_graph3=-(s2+s3+s4)
7136 if (.not. calc_grad) return
7137 C Derivatives in gamma(k-1)
7138 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7139 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7140 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7141 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7142 C Derivatives in gamma(l-1)
7143 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7144 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7145 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7146 vv(1)=pizda(1,1)+pizda(2,2)
7147 vv(2)=pizda(2,1)-pizda(1,2)
7148 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7149 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7150 C Cartesian derivatives.
7156 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7158 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7161 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7163 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7164 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7166 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7167 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7169 vv(1)=pizda(1,1)+pizda(2,2)
7170 vv(2)=pizda(2,1)-pizda(1,2)
7171 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7173 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7175 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7178 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7180 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7182 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7188 c----------------------------------------------------------------------------
7189 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7190 implicit real*8 (a-h,o-z)
7191 include 'DIMENSIONS'
7192 include 'DIMENSIONS.ZSCOPT'
7193 include 'COMMON.IOUNITS'
7194 include 'COMMON.CHAIN'
7195 include 'COMMON.DERIV'
7196 include 'COMMON.INTERACT'
7197 include 'COMMON.CONTACTS'
7198 include 'COMMON.TORSION'
7199 include 'COMMON.VAR'
7200 include 'COMMON.GEO'
7201 include 'COMMON.FFIELD'
7202 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7203 & auxvec1(2),auxmat1(2,2)
7205 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7207 C Parallel Antiparallel C
7213 C \ j|/k\| \ |/k\|l C
7218 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7220 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7221 C energy moment and not to the cluster cumulant.
7222 cd write (2,*) 'eello_graph4: wturn6',wturn6
7223 iti=itortyp(itype(i))
7224 itj=itortyp(itype(j))
7225 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7226 itj1=itortyp(itype(j+1))
7230 itk=itortyp(itype(k))
7231 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7232 itk1=itortyp(itype(k+1))
7236 itl=itortyp(itype(l))
7237 if (l.lt.nres-1) then
7238 itl1=itortyp(itype(l+1))
7242 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7243 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7244 cd & ' itl',itl,' itl1',itl1
7247 s1=dip(3,jj,i)*dip(3,kk,k)
7249 s1=dip(2,jj,j)*dip(2,kk,l)
7252 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7253 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7255 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7256 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7258 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7259 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7261 call transpose2(EUg(1,1,k),auxmat(1,1))
7262 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7263 vv(1)=pizda(1,1)-pizda(2,2)
7264 vv(2)=pizda(2,1)+pizda(1,2)
7265 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7266 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7268 eello6_graph4=-(s1+s2+s3+s4)
7270 eello6_graph4=-(s2+s3+s4)
7272 if (.not. calc_grad) return
7273 C Derivatives in gamma(i-1)
7277 s1=dipderg(2,jj,i)*dip(3,kk,k)
7279 s1=dipderg(4,jj,j)*dip(2,kk,l)
7282 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7284 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7285 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7287 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7288 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7290 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7291 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7292 cd write (2,*) 'turn6 derivatives'
7294 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7296 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7300 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7302 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7306 C Derivatives in gamma(k-1)
7309 s1=dip(3,jj,i)*dipderg(2,kk,k)
7311 s1=dip(2,jj,j)*dipderg(4,kk,l)
7314 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7315 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7317 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7318 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7320 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7321 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7323 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7324 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7325 vv(1)=pizda(1,1)-pizda(2,2)
7326 vv(2)=pizda(2,1)+pizda(1,2)
7327 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7328 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7330 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7332 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7336 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7338 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7341 C Derivatives in gamma(j-1) or gamma(l-1)
7342 if (l.eq.j+1 .and. l.gt.1) then
7343 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7344 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7345 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7346 vv(1)=pizda(1,1)-pizda(2,2)
7347 vv(2)=pizda(2,1)+pizda(1,2)
7348 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7349 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7350 else if (j.gt.1) then
7351 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7352 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7353 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7354 vv(1)=pizda(1,1)-pizda(2,2)
7355 vv(2)=pizda(2,1)+pizda(1,2)
7356 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7357 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7358 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7360 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7363 C Cartesian derivatives.
7370 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7372 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7376 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7378 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7382 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7384 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7386 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7387 & b1(1,itj1),auxvec(1))
7388 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7390 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7391 & b1(1,itl1),auxvec(1))
7392 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7394 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7396 vv(1)=pizda(1,1)-pizda(2,2)
7397 vv(2)=pizda(2,1)+pizda(1,2)
7398 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7400 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7402 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7405 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7408 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7411 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7413 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7415 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7421 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7424 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7426 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7434 c----------------------------------------------------------------------------
7435 double precision function eello_turn6(i,jj,kk)
7436 implicit real*8 (a-h,o-z)
7437 include 'DIMENSIONS'
7438 include 'DIMENSIONS.ZSCOPT'
7439 include 'COMMON.IOUNITS'
7440 include 'COMMON.CHAIN'
7441 include 'COMMON.DERIV'
7442 include 'COMMON.INTERACT'
7443 include 'COMMON.CONTACTS'
7444 include 'COMMON.TORSION'
7445 include 'COMMON.VAR'
7446 include 'COMMON.GEO'
7447 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7448 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7450 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7451 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7452 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7453 C the respective energy moment and not to the cluster cumulant.
7458 iti=itortyp(itype(i))
7459 itk=itortyp(itype(k))
7460 itk1=itortyp(itype(k+1))
7461 itl=itortyp(itype(l))
7462 itj=itortyp(itype(j))
7463 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7464 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7465 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7470 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7472 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7476 derx_turn(lll,kkk,iii)=0.0d0
7483 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7485 cd write (2,*) 'eello6_5',eello6_5
7487 call transpose2(AEA(1,1,1),auxmat(1,1))
7488 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7489 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7490 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7494 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7495 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7496 s2 = scalar2(b1(1,itk),vtemp1(1))
7498 call transpose2(AEA(1,1,2),atemp(1,1))
7499 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7500 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7501 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7505 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7506 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7507 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7509 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7510 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7511 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7512 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7513 ss13 = scalar2(b1(1,itk),vtemp4(1))
7514 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7518 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7524 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7526 C Derivatives in gamma(i+2)
7528 call transpose2(AEA(1,1,1),auxmatd(1,1))
7529 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7530 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7531 call transpose2(AEAderg(1,1,2),atempd(1,1))
7532 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7533 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7537 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7538 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7539 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7545 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7546 C Derivatives in gamma(i+3)
7548 call transpose2(AEA(1,1,1),auxmatd(1,1))
7549 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7550 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7551 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7555 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7556 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7557 s2d = scalar2(b1(1,itk),vtemp1d(1))
7559 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7560 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7562 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7564 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7565 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7566 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7576 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7577 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7579 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7580 & -0.5d0*ekont*(s2d+s12d)
7582 C Derivatives in gamma(i+4)
7583 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7584 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7585 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7587 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7588 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7589 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7599 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7601 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7603 C Derivatives in gamma(i+5)
7605 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7606 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7607 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7611 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7612 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7613 s2d = scalar2(b1(1,itk),vtemp1d(1))
7615 call transpose2(AEA(1,1,2),atempd(1,1))
7616 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7617 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7621 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7622 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7624 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7625 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7626 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7636 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7637 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7639 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7640 & -0.5d0*ekont*(s2d+s12d)
7642 C Cartesian derivatives
7647 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7648 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7649 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7653 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7654 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7656 s2d = scalar2(b1(1,itk),vtemp1d(1))
7658 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7659 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7660 s8d = -(atempd(1,1)+atempd(2,2))*
7661 & scalar2(cc(1,1,itl),vtemp2(1))
7665 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7667 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7668 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7675 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7678 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7682 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7683 & - 0.5d0*(s8d+s12d)
7685 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7694 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7696 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7697 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7698 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7699 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7700 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7702 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7703 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7704 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7708 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7709 cd & 16*eel_turn6_num
7711 if (j.lt.nres-1) then
7718 if (l.lt.nres-1) then
7726 ggg1(ll)=eel_turn6*g_contij(ll,1)
7727 ggg2(ll)=eel_turn6*g_contij(ll,2)
7728 ghalf=0.5d0*ggg1(ll)
7730 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7731 & +ekont*derx_turn(ll,2,1)
7732 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7733 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7734 & +ekont*derx_turn(ll,4,1)
7735 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7736 ghalf=0.5d0*ggg2(ll)
7738 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7739 & +ekont*derx_turn(ll,2,2)
7740 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7741 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7742 & +ekont*derx_turn(ll,4,2)
7743 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7748 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7753 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7759 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7764 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7768 cd write (2,*) iii,g_corr6_loc(iii)
7771 eello_turn6=ekont*eel_turn6
7772 cd write (2,*) 'ekont',ekont
7773 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7776 crc-------------------------------------------------
7777 SUBROUTINE MATVEC2(A1,V1,V2)
7778 implicit real*8 (a-h,o-z)
7779 include 'DIMENSIONS'
7780 DIMENSION A1(2,2),V1(2),V2(2)
7784 c 3 VI=VI+A1(I,K)*V1(K)
7788 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7789 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7794 C---------------------------------------
7795 SUBROUTINE MATMAT2(A1,A2,A3)
7796 implicit real*8 (a-h,o-z)
7797 include 'DIMENSIONS'
7798 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7799 c DIMENSION AI3(2,2)
7803 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7809 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7810 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7811 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7812 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7820 c-------------------------------------------------------------------------
7821 double precision function scalar2(u,v)
7823 double precision u(2),v(2)
7826 scalar2=u(1)*v(1)+u(2)*v(2)
7830 C-----------------------------------------------------------------------------
7832 subroutine transpose2(a,at)
7834 double precision a(2,2),at(2,2)
7841 c--------------------------------------------------------------------------
7842 subroutine transpose(n,a,at)
7845 double precision a(n,n),at(n,n)
7853 C---------------------------------------------------------------------------
7854 subroutine prodmat3(a1,a2,kk,transp,prod)
7857 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7859 crc double precision auxmat(2,2),prod_(2,2)
7862 crc call transpose2(kk(1,1),auxmat(1,1))
7863 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7864 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7866 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7867 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7868 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7869 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7870 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7871 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7872 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7873 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7876 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7877 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7879 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7880 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7881 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7882 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7883 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7884 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7885 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7886 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7889 c call transpose2(a2(1,1),a2t(1,1))
7892 crc print *,((prod_(i,j),i=1,2),j=1,2)
7893 crc print *,((prod(i,j),i=1,2),j=1,2)
7897 C-----------------------------------------------------------------------------
7898 double precision function scalar(u,v)
7900 double precision u(3),v(3)
7910 C-----------------------------------------------------------------------
7911 double precision function sscale(r)
7912 double precision r,gamm
7913 include "COMMON.SPLITELE"
7914 if(r.lt.r_cut-rlamb) then
7916 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7917 gamm=(r-(r_cut-rlamb))/rlamb
7918 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7924 C-----------------------------------------------------------------------
7925 C-----------------------------------------------------------------------
7926 double precision function sscagrad(r)
7927 double precision r,gamm
7928 include "COMMON.SPLITELE"
7929 if(r.lt.r_cut-rlamb) then
7931 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7932 gamm=(r-(r_cut-rlamb))/rlamb
7933 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7939 C-----------------------------------------------------------------------