1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 c & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'sizesclu.dat'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'sizesclu.dat'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
363 c ROZNICA DODANE Z WHAM
366 c eneps_temp(j,i)=0.0d0
375 if (itypi.eq.ntyp1) cycle
376 itypi1=iabs(itype(i+1))
383 C Calculate SC interaction energy.
386 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
387 cd & 'iend=',iend(i,iint)
388 do j=istart(i,iint),iend(i,iint)
390 if (itypj.eq.ntyp1) cycle
394 C Change 12/1/95 to calculate four-body interactions
395 rij=xj*xj+yj*yj+zj*zj
397 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
398 eps0ij=eps(itypi,itypj)
400 e1=fac*fac*aa(itypi,itypj)
401 e2=fac*bb(itypi,itypj)
403 ij=icant(itypi,itypj)
405 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
406 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
409 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
410 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
411 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
412 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
413 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
414 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
415 if (bb(itypi,itypj).gt.0.0d0) then
422 C Calculate the components of the gradient in DC and X
424 fac=-rrij*(e1+evdwij)
429 gvdwx(k,i)=gvdwx(k,i)-gg(k)
430 gvdwx(k,j)=gvdwx(k,j)+gg(k)
434 gvdwc(l,k)=gvdwc(l,k)+gg(l)
439 C 12/1/95, revised on 5/20/97
441 C Calculate the contact function. The ith column of the array JCONT will
442 C contain the numbers of atoms that make contacts with the atom I (of numbers
443 C greater than I). The arrays FACONT and GACONT will contain the values of
444 C the contact function and its derivative.
446 C Uncomment next line, if the correlation interactions include EVDW explicitly.
447 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
448 C Uncomment next line, if the correlation interactions are contact function only
449 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
451 sigij=sigma(itypi,itypj)
452 r0ij=rs0(itypi,itypj)
454 C Check whether the SC's are not too far to make a contact.
457 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
458 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
460 if (fcont.gt.0.0D0) then
461 C If the SC-SC distance if close to sigma, apply spline.
462 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
463 cAdam & fcont1,fprimcont1)
464 cAdam fcont1=1.0d0-fcont1
465 cAdam if (fcont1.gt.0.0d0) then
466 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
467 cAdam fcont=fcont*fcont1
469 C Uncomment following 4 lines to have the geometric average of the epsilon0's
470 cga eps0ij=1.0d0/dsqrt(eps0ij)
472 cga gg(k)=gg(k)*eps0ij
474 cga eps0ij=-evdwij*eps0ij
475 C Uncomment for AL's type of SC correlation interactions.
477 num_conti=num_conti+1
479 facont(num_conti,i)=fcont*eps0ij
480 fprimcont=eps0ij*fprimcont/rij
482 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
483 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
484 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
485 C Uncomment following 3 lines for Skolnick's type of SC correlation.
486 gacont(1,num_conti,i)=-fprimcont*xj
487 gacont(2,num_conti,i)=-fprimcont*yj
488 gacont(3,num_conti,i)=-fprimcont*zj
489 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
490 cd write (iout,'(2i3,3f10.5)')
491 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
497 num_cont(i)=num_conti
502 gvdwc(j,i)=expon*gvdwc(j,i)
503 gvdwx(j,i)=expon*gvdwx(j,i)
507 C******************************************************************************
511 C To save time, the factor of EXPON has been extracted from ALL components
512 C of GVDWC and GRADX. Remember to multiply them by this factor before further
515 C******************************************************************************
518 C-----------------------------------------------------------------------------
519 subroutine eljk(evdw,evdw_t)
521 C This subroutine calculates the interaction energy of nonbonded side chains
522 C assuming the LJK potential of interaction.
524 implicit real*8 (a-h,o-z)
526 include 'sizesclu.dat'
527 include "DIMENSIONS.COMPAR"
530 include 'COMMON.LOCAL'
531 include 'COMMON.CHAIN'
532 include 'COMMON.DERIV'
533 include 'COMMON.INTERACT'
534 include 'COMMON.IOUNITS'
535 include 'COMMON.NAMES'
540 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
545 if (itypi.eq.ntyp1) cycle
546 itypi1=iabs(itype(i+1))
551 C Calculate SC interaction energy.
554 do j=istart(i,iint),iend(i,iint)
556 if (itypj.eq.ntyp1) cycle
560 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
562 e_augm=augm(itypi,itypj)*fac_augm
565 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
566 fac=r_shift_inv**expon
567 e1=fac*fac*aa(itypi,itypj)
568 e2=fac*bb(itypi,itypj)
570 ij=icant(itypi,itypj)
571 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
572 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
573 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
574 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
575 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
576 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
577 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
578 if (bb(itypi,itypj).gt.0.0d0) then
585 C Calculate the components of the gradient in DC and X
587 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
592 gvdwx(k,i)=gvdwx(k,i)-gg(k)
593 gvdwx(k,j)=gvdwx(k,j)+gg(k)
597 gvdwc(l,k)=gvdwc(l,k)+gg(l)
607 gvdwc(j,i)=expon*gvdwc(j,i)
608 gvdwx(j,i)=expon*gvdwx(j,i)
614 C-----------------------------------------------------------------------------
615 subroutine ebp(evdw,evdw_t)
617 C This subroutine calculates the interaction energy of nonbonded side chains
618 C assuming the Berne-Pechukas potential of interaction.
620 implicit real*8 (a-h,o-z)
622 include 'sizesclu.dat'
623 include "DIMENSIONS.COMPAR"
626 include 'COMMON.LOCAL'
627 include 'COMMON.CHAIN'
628 include 'COMMON.DERIV'
629 include 'COMMON.NAMES'
630 include 'COMMON.INTERACT'
631 include 'COMMON.IOUNITS'
632 include 'COMMON.CALC'
634 c double precision rrsave(maxdim)
640 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
641 c if (icall.eq.0) then
649 if (itypi.eq.ntyp1) cycle
650 itypi1=iabs(itype(i+1))
654 dxi=dc_norm(1,nres+i)
655 dyi=dc_norm(2,nres+i)
656 dzi=dc_norm(3,nres+i)
657 dsci_inv=vbld_inv(i+nres)
659 C Calculate SC interaction energy.
662 do j=istart(i,iint),iend(i,iint)
665 if (itypj.eq.ntyp1) cycle
666 dscj_inv=vbld_inv(j+nres)
667 chi1=chi(itypi,itypj)
668 chi2=chi(itypj,itypi)
675 alf12=0.5D0*(alf1+alf2)
676 C For diagnostics only!!!
689 dxj=dc_norm(1,nres+j)
690 dyj=dc_norm(2,nres+j)
691 dzj=dc_norm(3,nres+j)
692 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
693 cd if (icall.eq.0) then
699 C Calculate the angle-dependent terms of energy & contributions to derivatives.
701 C Calculate whole angle-dependent part of epsilon and contributions
703 fac=(rrij*sigsq)**expon2
704 e1=fac*fac*aa(itypi,itypj)
705 e2=fac*bb(itypi,itypj)
706 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
707 eps2der=evdwij*eps3rt
708 eps3der=evdwij*eps2rt
709 evdwij=evdwij*eps2rt*eps3rt
710 ij=icant(itypi,itypj)
711 aux=eps1*eps2rt**2*eps3rt**2
712 if (bb(itypi,itypj).gt.0.0d0) then
719 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
720 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
721 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
722 cd & restyp(itypi),i,restyp(itypj),j,
723 cd & epsi,sigm,chi1,chi2,chip1,chip2,
724 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
725 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
728 C Calculate gradient components.
729 e1=e1*eps1*eps2rt**2*eps3rt**2
730 fac=-expon*(e1+evdwij)
733 C Calculate radial part of the gradient
737 C Calculate the angular part of the gradient and sum add the contributions
738 C to the appropriate components of the Cartesian gradient.
747 C-----------------------------------------------------------------------------
748 subroutine egb(evdw,evdw_t)
750 C This subroutine calculates the interaction energy of nonbonded side chains
751 C assuming the Gay-Berne potential of interaction.
753 implicit real*8 (a-h,o-z)
755 include 'sizesclu.dat'
756 include "DIMENSIONS.COMPAR"
759 include 'COMMON.LOCAL'
760 include 'COMMON.CHAIN'
761 include 'COMMON.DERIV'
762 include 'COMMON.NAMES'
763 include 'COMMON.INTERACT'
764 include 'COMMON.IOUNITS'
765 include 'COMMON.CALC'
770 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
774 c if (icall.gt.0) lprn=.true.
778 if (itypi.eq.ntyp1) cycle
779 itypi1=iabs(itype(i+1))
783 dxi=dc_norm(1,nres+i)
784 dyi=dc_norm(2,nres+i)
785 dzi=dc_norm(3,nres+i)
786 dsci_inv=vbld_inv(i+nres)
788 C Calculate SC interaction energy.
791 do j=istart(i,iint),iend(i,iint)
794 if (itypj.eq.ntyp1) cycle
795 dscj_inv=vbld_inv(j+nres)
796 sig0ij=sigma(itypi,itypj)
797 chi1=chi(itypi,itypj)
798 chi2=chi(itypj,itypi)
805 alf12=0.5D0*(alf1+alf2)
806 C For diagnostics only!!!
819 dxj=dc_norm(1,nres+j)
820 dyj=dc_norm(2,nres+j)
821 dzj=dc_norm(3,nres+j)
822 c write (iout,*) i,j,xj,yj,zj
823 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
825 C Calculate angle-dependent terms of energy and contributions to their
829 sig=sig0ij*dsqrt(sigsq)
830 rij_shift=1.0D0/rij-sig+sig0ij
831 C I hate to put IF's in the loops, but here don't have another choice!!!!
832 if (rij_shift.le.0.0D0) then
837 c---------------------------------------------------------------
838 rij_shift=1.0D0/rij_shift
840 e1=fac*fac*aa(itypi,itypj)
841 e2=fac*bb(itypi,itypj)
842 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
843 eps2der=evdwij*eps3rt
844 eps3der=evdwij*eps2rt
845 evdwij=evdwij*eps2rt*eps3rt
846 if (bb(itypi,itypj).gt.0) then
851 ij=icant(itypi,itypj)
852 aux=eps1*eps2rt**2*eps3rt**2
853 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
854 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
855 c & aux*e2/eps(itypi,itypj)
857 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
858 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
859 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
860 c & restyp(itypi),i,restyp(itypj),j,
861 c & epsi,sigm,chi1,chi2,chip1,chip2,
862 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
863 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
865 c write (iout,*) "pratial sum", evdw,evdw_t
868 C Calculate gradient components.
869 e1=e1*eps1*eps2rt**2*eps3rt**2
870 fac=-expon*(e1+evdwij)*rij_shift
873 C Calculate the radial part of the gradient
877 C Calculate angular part of the gradient.
885 C-----------------------------------------------------------------------------
886 subroutine egbv(evdw,evdw_t)
888 C This subroutine calculates the interaction energy of nonbonded side chains
889 C assuming the Gay-Berne-Vorobjev potential of interaction.
891 implicit real*8 (a-h,o-z)
893 include 'sizesclu.dat'
894 include "DIMENSIONS.COMPAR"
897 include 'COMMON.LOCAL'
898 include 'COMMON.CHAIN'
899 include 'COMMON.DERIV'
900 include 'COMMON.NAMES'
901 include 'COMMON.INTERACT'
902 include 'COMMON.IOUNITS'
903 include 'COMMON.CALC'
910 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
913 c if (icall.gt.0) lprn=.true.
917 if (itypi.eq.ntyp1) cycle
918 itypi1=iabs(itype(i+1))
922 dxi=dc_norm(1,nres+i)
923 dyi=dc_norm(2,nres+i)
924 dzi=dc_norm(3,nres+i)
925 dsci_inv=vbld_inv(i+nres)
927 C Calculate SC interaction energy.
930 do j=istart(i,iint),iend(i,iint)
933 if (itypj.eq.ntyp1) cycle
934 dscj_inv=vbld_inv(j+nres)
935 sig0ij=sigma(itypi,itypj)
937 chi1=chi(itypi,itypj)
938 chi2=chi(itypj,itypi)
945 alf12=0.5D0*(alf1+alf2)
946 C For diagnostics only!!!
959 dxj=dc_norm(1,nres+j)
960 dyj=dc_norm(2,nres+j)
961 dzj=dc_norm(3,nres+j)
962 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
964 C Calculate angle-dependent terms of energy and contributions to their
968 sig=sig0ij*dsqrt(sigsq)
969 rij_shift=1.0D0/rij-sig+r0ij
970 C I hate to put IF's in the loops, but here don't have another choice!!!!
971 if (rij_shift.le.0.0D0) then
976 c---------------------------------------------------------------
977 rij_shift=1.0D0/rij_shift
979 e1=fac*fac*aa(itypi,itypj)
980 e2=fac*bb(itypi,itypj)
981 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
982 eps2der=evdwij*eps3rt
983 eps3der=evdwij*eps2rt
985 e_augm=augm(itypi,itypj)*fac_augm
986 evdwij=evdwij*eps2rt*eps3rt
987 if (bb(itypi,itypj).gt.0.0d0) then
988 evdw=evdw+evdwij+e_augm
990 evdw_t=evdw_t+evdwij+e_augm
992 ij=icant(itypi,itypj)
993 aux=eps1*eps2rt**2*eps3rt**2
995 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
996 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
997 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
998 c & restyp(itypi),i,restyp(itypj),j,
999 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1000 c & chi1,chi2,chip1,chip2,
1001 c & eps1,eps2rt**2,eps3rt**2,
1002 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1006 C Calculate gradient components.
1007 e1=e1*eps1*eps2rt**2*eps3rt**2
1008 fac=-expon*(e1+evdwij)*rij_shift
1010 fac=rij*fac-2*expon*rrij*e_augm
1011 C Calculate the radial part of the gradient
1015 C Calculate angular part of the gradient.
1023 C-----------------------------------------------------------------------------
1024 subroutine sc_angular
1025 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1026 C om12. Called by ebp, egb, and egbv.
1028 include 'COMMON.CALC'
1032 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1033 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1034 om12=dxi*dxj+dyi*dyj+dzi*dzj
1036 C Calculate eps1(om12) and its derivative in om12
1037 faceps1=1.0D0-om12*chiom12
1038 faceps1_inv=1.0D0/faceps1
1039 eps1=dsqrt(faceps1_inv)
1040 C Following variable is eps1*deps1/dom12
1041 eps1_om12=faceps1_inv*chiom12
1042 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1047 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1048 sigsq=1.0D0-facsig*faceps1_inv
1049 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1050 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1051 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1052 C Calculate eps2 and its derivatives in om1, om2, and om12.
1055 chipom12=chip12*om12
1056 facp=1.0D0-om12*chipom12
1058 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1059 C Following variable is the square root of eps2
1060 eps2rt=1.0D0-facp1*facp_inv
1061 C Following three variables are the derivatives of the square root of eps
1062 C in om1, om2, and om12.
1063 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1064 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1065 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1066 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1067 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1068 C Calculate whole angle-dependent part of epsilon and contributions
1069 C to its derivatives
1072 C----------------------------------------------------------------------------
1074 implicit real*8 (a-h,o-z)
1075 include 'DIMENSIONS'
1076 include 'sizesclu.dat'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.CALC'
1080 double precision dcosom1(3),dcosom2(3)
1081 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1082 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1083 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1084 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1086 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1087 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1090 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1093 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1094 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1095 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1096 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1097 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1098 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1101 C Calculate the components of the gradient in DC and X
1105 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1110 c------------------------------------------------------------------------------
1111 subroutine vec_and_deriv
1112 implicit real*8 (a-h,o-z)
1113 include 'DIMENSIONS'
1114 include 'sizesclu.dat'
1115 include 'COMMON.IOUNITS'
1116 include 'COMMON.GEO'
1117 include 'COMMON.VAR'
1118 include 'COMMON.LOCAL'
1119 include 'COMMON.CHAIN'
1120 include 'COMMON.VECTORS'
1121 include 'COMMON.DERIV'
1122 include 'COMMON.INTERACT'
1123 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1124 C Compute the local reference systems. For reference system (i), the
1125 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1126 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1128 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1129 if (i.eq.nres-1) then
1130 C Case of the last full residue
1131 C Compute the Z-axis
1132 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1133 costh=dcos(pi-theta(nres))
1134 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1139 C Compute the derivatives of uz
1141 uzder(2,1,1)=-dc_norm(3,i-1)
1142 uzder(3,1,1)= dc_norm(2,i-1)
1143 uzder(1,2,1)= dc_norm(3,i-1)
1145 uzder(3,2,1)=-dc_norm(1,i-1)
1146 uzder(1,3,1)=-dc_norm(2,i-1)
1147 uzder(2,3,1)= dc_norm(1,i-1)
1150 uzder(2,1,2)= dc_norm(3,i)
1151 uzder(3,1,2)=-dc_norm(2,i)
1152 uzder(1,2,2)=-dc_norm(3,i)
1154 uzder(3,2,2)= dc_norm(1,i)
1155 uzder(1,3,2)= dc_norm(2,i)
1156 uzder(2,3,2)=-dc_norm(1,i)
1159 C Compute the Y-axis
1162 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1165 C Compute the derivatives of uy
1168 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1169 & -dc_norm(k,i)*dc_norm(j,i-1)
1170 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1172 uyder(j,j,1)=uyder(j,j,1)-costh
1173 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1178 uygrad(l,k,j,i)=uyder(l,k,j)
1179 uzgrad(l,k,j,i)=uzder(l,k,j)
1183 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1184 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1185 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1186 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1190 C Compute the Z-axis
1191 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1192 costh=dcos(pi-theta(i+2))
1193 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1198 C Compute the derivatives of uz
1200 uzder(2,1,1)=-dc_norm(3,i+1)
1201 uzder(3,1,1)= dc_norm(2,i+1)
1202 uzder(1,2,1)= dc_norm(3,i+1)
1204 uzder(3,2,1)=-dc_norm(1,i+1)
1205 uzder(1,3,1)=-dc_norm(2,i+1)
1206 uzder(2,3,1)= dc_norm(1,i+1)
1209 uzder(2,1,2)= dc_norm(3,i)
1210 uzder(3,1,2)=-dc_norm(2,i)
1211 uzder(1,2,2)=-dc_norm(3,i)
1213 uzder(3,2,2)= dc_norm(1,i)
1214 uzder(1,3,2)= dc_norm(2,i)
1215 uzder(2,3,2)=-dc_norm(1,i)
1218 C Compute the Y-axis
1221 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1224 C Compute the derivatives of uy
1227 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1228 & -dc_norm(k,i)*dc_norm(j,i+1)
1229 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1231 uyder(j,j,1)=uyder(j,j,1)-costh
1232 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1237 uygrad(l,k,j,i)=uyder(l,k,j)
1238 uzgrad(l,k,j,i)=uzder(l,k,j)
1242 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1243 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1244 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1245 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1251 vbld_inv_temp(1)=vbld_inv(i+1)
1252 if (i.lt.nres-1) then
1253 vbld_inv_temp(2)=vbld_inv(i+2)
1255 vbld_inv_temp(2)=vbld_inv(i)
1260 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1261 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1269 C-----------------------------------------------------------------------------
1270 subroutine vec_and_deriv_test
1271 implicit real*8 (a-h,o-z)
1272 include 'DIMENSIONS'
1273 include 'sizesclu.dat'
1274 include 'COMMON.IOUNITS'
1275 include 'COMMON.GEO'
1276 include 'COMMON.VAR'
1277 include 'COMMON.LOCAL'
1278 include 'COMMON.CHAIN'
1279 include 'COMMON.VECTORS'
1280 dimension uyder(3,3,2),uzder(3,3,2)
1281 C Compute the local reference systems. For reference system (i), the
1282 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1283 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1285 if (i.eq.nres-1) then
1286 C Case of the last full residue
1287 C Compute the Z-axis
1288 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1289 costh=dcos(pi-theta(nres))
1290 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1291 c write (iout,*) 'fac',fac,
1292 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1293 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1297 C Compute the derivatives of uz
1299 uzder(2,1,1)=-dc_norm(3,i-1)
1300 uzder(3,1,1)= dc_norm(2,i-1)
1301 uzder(1,2,1)= dc_norm(3,i-1)
1303 uzder(3,2,1)=-dc_norm(1,i-1)
1304 uzder(1,3,1)=-dc_norm(2,i-1)
1305 uzder(2,3,1)= dc_norm(1,i-1)
1308 uzder(2,1,2)= dc_norm(3,i)
1309 uzder(3,1,2)=-dc_norm(2,i)
1310 uzder(1,2,2)=-dc_norm(3,i)
1312 uzder(3,2,2)= dc_norm(1,i)
1313 uzder(1,3,2)= dc_norm(2,i)
1314 uzder(2,3,2)=-dc_norm(1,i)
1316 C Compute the Y-axis
1318 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1321 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1322 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1323 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1325 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1328 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1329 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1332 c write (iout,*) 'facy',facy,
1333 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1334 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1336 uy(k,i)=facy*uy(k,i)
1338 C Compute the derivatives of uy
1341 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1342 & -dc_norm(k,i)*dc_norm(j,i-1)
1343 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1345 c uyder(j,j,1)=uyder(j,j,1)-costh
1346 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1347 uyder(j,j,1)=uyder(j,j,1)
1348 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1349 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1355 uygrad(l,k,j,i)=uyder(l,k,j)
1356 uzgrad(l,k,j,i)=uzder(l,k,j)
1360 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1361 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1362 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1363 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1366 C Compute the Z-axis
1367 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1368 costh=dcos(pi-theta(i+2))
1369 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1370 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1374 C Compute the derivatives of uz
1376 uzder(2,1,1)=-dc_norm(3,i+1)
1377 uzder(3,1,1)= dc_norm(2,i+1)
1378 uzder(1,2,1)= dc_norm(3,i+1)
1380 uzder(3,2,1)=-dc_norm(1,i+1)
1381 uzder(1,3,1)=-dc_norm(2,i+1)
1382 uzder(2,3,1)= dc_norm(1,i+1)
1385 uzder(2,1,2)= dc_norm(3,i)
1386 uzder(3,1,2)=-dc_norm(2,i)
1387 uzder(1,2,2)=-dc_norm(3,i)
1389 uzder(3,2,2)= dc_norm(1,i)
1390 uzder(1,3,2)= dc_norm(2,i)
1391 uzder(2,3,2)=-dc_norm(1,i)
1393 C Compute the Y-axis
1395 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1396 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1397 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1399 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1402 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1403 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1406 c write (iout,*) 'facy',facy,
1407 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1408 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1410 uy(k,i)=facy*uy(k,i)
1412 C Compute the derivatives of uy
1415 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1416 & -dc_norm(k,i)*dc_norm(j,i+1)
1417 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1419 c uyder(j,j,1)=uyder(j,j,1)-costh
1420 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1421 uyder(j,j,1)=uyder(j,j,1)
1422 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1423 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1429 uygrad(l,k,j,i)=uyder(l,k,j)
1430 uzgrad(l,k,j,i)=uzder(l,k,j)
1434 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1435 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1436 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1437 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1444 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1445 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1452 C-----------------------------------------------------------------------------
1453 subroutine check_vecgrad
1454 implicit real*8 (a-h,o-z)
1455 include 'DIMENSIONS'
1456 include 'sizesclu.dat'
1457 include 'COMMON.IOUNITS'
1458 include 'COMMON.GEO'
1459 include 'COMMON.VAR'
1460 include 'COMMON.LOCAL'
1461 include 'COMMON.CHAIN'
1462 include 'COMMON.VECTORS'
1463 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1464 dimension uyt(3,maxres),uzt(3,maxres)
1465 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1466 double precision delta /1.0d-7/
1469 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1470 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1471 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1472 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1473 cd & (dc_norm(if90,i),if90=1,3)
1474 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1475 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1476 cd write(iout,'(a)')
1482 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1483 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1496 cd write (iout,*) 'i=',i
1498 erij(k)=dc_norm(k,i)
1502 dc_norm(k,i)=erij(k)
1504 dc_norm(j,i)=dc_norm(j,i)+delta
1505 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1507 c dc_norm(k,i)=dc_norm(k,i)/fac
1509 c write (iout,*) (dc_norm(k,i),k=1,3)
1510 c write (iout,*) (erij(k),k=1,3)
1513 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1514 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1515 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1516 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1518 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1519 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1520 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1523 dc_norm(k,i)=erij(k)
1526 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1527 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1528 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1529 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1530 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1531 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1532 cd write (iout,'(a)')
1537 C--------------------------------------------------------------------------
1538 subroutine set_matrices
1539 implicit real*8 (a-h,o-z)
1540 include 'DIMENSIONS'
1541 include 'sizesclu.dat'
1542 include 'COMMON.IOUNITS'
1543 include 'COMMON.GEO'
1544 include 'COMMON.VAR'
1545 include 'COMMON.LOCAL'
1546 include 'COMMON.CHAIN'
1547 include 'COMMON.DERIV'
1548 include 'COMMON.INTERACT'
1549 include 'COMMON.CONTACTS'
1550 include 'COMMON.TORSION'
1551 include 'COMMON.VECTORS'
1552 include 'COMMON.FFIELD'
1553 double precision auxvec(2),auxmat(2,2)
1555 C Compute the virtual-bond-torsional-angle dependent quantities needed
1556 C to calculate the el-loc multibody terms of various order.
1559 if (i .lt. nres+1) then
1596 if (i .gt. 3 .and. i .lt. nres+1) then
1597 obrot_der(1,i-2)=-sin1
1598 obrot_der(2,i-2)= cos1
1599 Ugder(1,1,i-2)= sin1
1600 Ugder(1,2,i-2)=-cos1
1601 Ugder(2,1,i-2)=-cos1
1602 Ugder(2,2,i-2)=-sin1
1605 obrot2_der(1,i-2)=-dwasin2
1606 obrot2_der(2,i-2)= dwacos2
1607 Ug2der(1,1,i-2)= dwasin2
1608 Ug2der(1,2,i-2)=-dwacos2
1609 Ug2der(2,1,i-2)=-dwacos2
1610 Ug2der(2,2,i-2)=-dwasin2
1612 obrot_der(1,i-2)=0.0d0
1613 obrot_der(2,i-2)=0.0d0
1614 Ugder(1,1,i-2)=0.0d0
1615 Ugder(1,2,i-2)=0.0d0
1616 Ugder(2,1,i-2)=0.0d0
1617 Ugder(2,2,i-2)=0.0d0
1618 obrot2_der(1,i-2)=0.0d0
1619 obrot2_der(2,i-2)=0.0d0
1620 Ug2der(1,1,i-2)=0.0d0
1621 Ug2der(1,2,i-2)=0.0d0
1622 Ug2der(2,1,i-2)=0.0d0
1623 Ug2der(2,2,i-2)=0.0d0
1625 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1626 if (itype(i-2).le.ntyp) then
1627 iti = itortyp(itype(i-2))
1634 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1635 if (itype(i-1).le.ntyp) then
1636 iti1 = itortyp(itype(i-1))
1643 cd write (iout,*) '*******i',i,' iti1',iti
1644 cd write (iout,*) 'b1',b1(:,iti)
1645 cd write (iout,*) 'b2',b2(:,iti)
1646 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1647 c print *,"itilde1 i iti iti1",i,iti,iti1
1648 if (i .gt. iatel_s+2) then
1649 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1650 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1651 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1652 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1653 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1654 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1655 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1665 DtUg2(l,k,i-2)=0.0d0
1669 c print *,"itilde2 i iti iti1",i,iti,iti1
1670 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1671 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1672 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1673 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1674 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1675 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1676 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1677 c print *,"itilde3 i iti iti1",i,iti,iti1
1679 muder(k,i-2)=Ub2der(k,i-2)
1681 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1682 if (itype(i-1).le.ntyp) then
1683 iti1 = itortyp(itype(i-1))
1691 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1693 C Vectors and matrices dependent on a single virtual-bond dihedral.
1694 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1695 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1696 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1697 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1698 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1699 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1700 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1701 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1702 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1703 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1704 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1706 C Matrices dependent on two consecutive virtual-bond dihedrals.
1707 C The order of matrices is from left to right.
1709 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1710 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1711 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1712 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1713 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1714 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1715 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1716 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1719 cd iti = itortyp(itype(i))
1722 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1723 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1728 C--------------------------------------------------------------------------
1729 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1731 C This subroutine calculates the average interaction energy and its gradient
1732 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1733 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1734 C The potential depends both on the distance of peptide-group centers and on
1735 C the orientation of the CA-CA virtual bonds.
1737 implicit real*8 (a-h,o-z)
1738 include 'DIMENSIONS'
1739 include 'sizesclu.dat'
1740 include 'COMMON.CONTROL'
1741 include 'COMMON.IOUNITS'
1742 include 'COMMON.GEO'
1743 include 'COMMON.VAR'
1744 include 'COMMON.LOCAL'
1745 include 'COMMON.CHAIN'
1746 include 'COMMON.DERIV'
1747 include 'COMMON.INTERACT'
1748 include 'COMMON.CONTACTS'
1749 include 'COMMON.TORSION'
1750 include 'COMMON.VECTORS'
1751 include 'COMMON.FFIELD'
1752 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1753 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1754 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1755 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1756 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1757 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1758 double precision scal_el /0.5d0/
1760 C 13-go grudnia roku pamietnego...
1761 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1762 & 0.0d0,1.0d0,0.0d0,
1763 & 0.0d0,0.0d0,1.0d0/
1764 cd write(iout,*) 'In EELEC'
1766 cd write(iout,*) 'Type',i
1767 cd write(iout,*) 'B1',B1(:,i)
1768 cd write(iout,*) 'B2',B2(:,i)
1769 cd write(iout,*) 'CC',CC(:,:,i)
1770 cd write(iout,*) 'DD',DD(:,:,i)
1771 cd write(iout,*) 'EE',EE(:,:,i)
1773 cd call check_vecgrad
1775 if (icheckgrad.eq.1) then
1777 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1779 dc_norm(k,i)=dc(k,i)*fac
1781 c write (iout,*) 'i',i,' fac',fac
1784 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1785 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1786 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1787 cd if (wel_loc.gt.0.0d0) then
1788 if (icheckgrad.eq.1) then
1789 call vec_and_deriv_test
1796 cd write (iout,*) 'i=',i
1798 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1801 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1802 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1815 cd print '(a)','Enter EELEC'
1816 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1818 gel_loc_loc(i)=0.0d0
1821 do i=iatel_s,iatel_e
1822 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1823 if (itel(i).eq.0) goto 1215
1827 dx_normi=dc_norm(1,i)
1828 dy_normi=dc_norm(2,i)
1829 dz_normi=dc_norm(3,i)
1830 xmedi=c(1,i)+0.5d0*dxi
1831 ymedi=c(2,i)+0.5d0*dyi
1832 zmedi=c(3,i)+0.5d0*dzi
1834 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1835 do j=ielstart(i),ielend(i)
1836 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1837 if (itel(j).eq.0) goto 1216
1841 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1842 aaa=app(iteli,itelj)
1843 bbb=bpp(iteli,itelj)
1844 C Diagnostics only!!!
1850 ael6i=ael6(iteli,itelj)
1851 ael3i=ael3(iteli,itelj)
1855 dx_normj=dc_norm(1,j)
1856 dy_normj=dc_norm(2,j)
1857 dz_normj=dc_norm(3,j)
1858 xj=c(1,j)+0.5D0*dxj-xmedi
1859 yj=c(2,j)+0.5D0*dyj-ymedi
1860 zj=c(3,j)+0.5D0*dzj-zmedi
1861 rij=xj*xj+yj*yj+zj*zj
1867 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1868 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1869 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1870 fac=cosa-3.0D0*cosb*cosg
1872 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1873 if (j.eq.i+2) ev1=scal_el*ev1
1878 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1881 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1882 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1883 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1886 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1887 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1888 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1889 cd & xmedi,ymedi,zmedi,xj,yj,zj
1891 C Calculate contributions to the Cartesian gradient.
1894 facvdw=-6*rrmij*(ev1+evdwij)
1895 facel=-3*rrmij*(el1+eesij)
1902 * Radial derivatives. First process both termini of the fragment (i,j)
1909 gelc(k,i)=gelc(k,i)+ghalf
1910 gelc(k,j)=gelc(k,j)+ghalf
1913 * Loop over residues i+1 thru j-1.
1917 gelc(l,k)=gelc(l,k)+ggg(l)
1925 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1926 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1929 * Loop over residues i+1 thru j-1.
1933 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1940 fac=-3*rrmij*(facvdw+facvdw+facel)
1946 * Radial derivatives. First process both termini of the fragment (i,j)
1953 gelc(k,i)=gelc(k,i)+ghalf
1954 gelc(k,j)=gelc(k,j)+ghalf
1957 * Loop over residues i+1 thru j-1.
1961 gelc(l,k)=gelc(l,k)+ggg(l)
1968 ecosa=2.0D0*fac3*fac1+fac4
1971 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1972 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1974 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1975 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1977 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1978 cd & (dcosg(k),k=1,3)
1980 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1984 gelc(k,i)=gelc(k,i)+ghalf
1985 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1986 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1987 gelc(k,j)=gelc(k,j)+ghalf
1988 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1989 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1993 gelc(l,k)=gelc(l,k)+ggg(l)
1998 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1999 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2000 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2002 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2003 C energy of a peptide unit is assumed in the form of a second-order
2004 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2005 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2006 C are computed for EVERY pair of non-contiguous peptide groups.
2008 if (j.lt.nres-1) then
2019 muij(kkk)=mu(k,i)*mu(l,j)
2022 cd write (iout,*) 'EELEC: i',i,' j',j
2023 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2024 cd write(iout,*) 'muij',muij
2025 ury=scalar(uy(1,i),erij)
2026 urz=scalar(uz(1,i),erij)
2027 vry=scalar(uy(1,j),erij)
2028 vrz=scalar(uz(1,j),erij)
2029 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2030 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2031 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2032 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2033 C For diagnostics only
2038 fac=dsqrt(-ael6i)*r3ij
2039 cd write (2,*) 'fac=',fac
2040 C For diagnostics only
2046 cd write (iout,'(4i5,4f10.5)')
2047 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2048 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2049 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2050 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2051 cd write (iout,'(4f10.5)')
2052 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2053 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2054 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2055 cd write (iout,'(2i3,9f10.5/)') i,j,
2056 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2058 C Derivatives of the elements of A in virtual-bond vectors
2059 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2066 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2067 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2068 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2069 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2070 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2071 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2072 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2073 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2074 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2075 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2076 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2077 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2087 C Compute radial contributions to the gradient
2109 C Add the contributions coming from er
2112 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2113 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2114 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2115 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2118 C Derivatives in DC(i)
2119 ghalf1=0.5d0*agg(k,1)
2120 ghalf2=0.5d0*agg(k,2)
2121 ghalf3=0.5d0*agg(k,3)
2122 ghalf4=0.5d0*agg(k,4)
2123 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2124 & -3.0d0*uryg(k,2)*vry)+ghalf1
2125 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2126 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2127 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2128 & -3.0d0*urzg(k,2)*vry)+ghalf3
2129 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2130 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2131 C Derivatives in DC(i+1)
2132 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2133 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2134 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2135 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2136 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2137 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2138 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2139 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2140 C Derivatives in DC(j)
2141 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2142 & -3.0d0*vryg(k,2)*ury)+ghalf1
2143 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2144 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2145 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2146 & -3.0d0*vryg(k,2)*urz)+ghalf3
2147 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2148 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2149 C Derivatives in DC(j+1) or DC(nres-1)
2150 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2151 & -3.0d0*vryg(k,3)*ury)
2152 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2153 & -3.0d0*vrzg(k,3)*ury)
2154 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2155 & -3.0d0*vryg(k,3)*urz)
2156 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2157 & -3.0d0*vrzg(k,3)*urz)
2162 C Derivatives in DC(i+1)
2163 cd aggi1(k,1)=agg(k,1)
2164 cd aggi1(k,2)=agg(k,2)
2165 cd aggi1(k,3)=agg(k,3)
2166 cd aggi1(k,4)=agg(k,4)
2167 C Derivatives in DC(j)
2172 C Derivatives in DC(j+1)
2177 if (j.eq.nres-1 .and. i.lt.j-2) then
2179 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2180 cd aggj1(k,l)=agg(k,l)
2186 C Check the loc-el terms by numerical integration
2196 aggi(k,l)=-aggi(k,l)
2197 aggi1(k,l)=-aggi1(k,l)
2198 aggj(k,l)=-aggj(k,l)
2199 aggj1(k,l)=-aggj1(k,l)
2202 if (j.lt.nres-1) then
2208 aggi(k,l)=-aggi(k,l)
2209 aggi1(k,l)=-aggi1(k,l)
2210 aggj(k,l)=-aggj(k,l)
2211 aggj1(k,l)=-aggj1(k,l)
2222 aggi(k,l)=-aggi(k,l)
2223 aggi1(k,l)=-aggi1(k,l)
2224 aggj(k,l)=-aggj(k,l)
2225 aggj1(k,l)=-aggj1(k,l)
2231 IF (wel_loc.gt.0.0d0) THEN
2232 C Contribution to the local-electrostatic energy coming from the i-j pair
2233 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2235 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2236 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2237 eel_loc=eel_loc+eel_loc_ij
2238 C Partial derivatives in virtual-bond dihedral angles gamma
2241 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2242 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2243 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2244 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2245 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2246 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2247 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2248 cd write(iout,*) 'agg ',agg
2249 cd write(iout,*) 'aggi ',aggi
2250 cd write(iout,*) 'aggi1',aggi1
2251 cd write(iout,*) 'aggj ',aggj
2252 cd write(iout,*) 'aggj1',aggj1
2254 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2256 ggg(l)=agg(l,1)*muij(1)+
2257 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2261 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2264 C Remaining derivatives of eello
2266 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2267 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2268 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2269 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2270 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2271 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2272 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2273 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2277 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2278 C Contributions from turns
2283 call eturn34(i,j,eello_turn3,eello_turn4)
2285 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2286 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2288 C Calculate the contact function. The ith column of the array JCONT will
2289 C contain the numbers of atoms that make contacts with the atom I (of numbers
2290 C greater than I). The arrays FACONT and GACONT will contain the values of
2291 C the contact function and its derivative.
2292 c r0ij=1.02D0*rpp(iteli,itelj)
2293 c r0ij=1.11D0*rpp(iteli,itelj)
2294 r0ij=2.20D0*rpp(iteli,itelj)
2295 c r0ij=1.55D0*rpp(iteli,itelj)
2296 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2297 if (fcont.gt.0.0D0) then
2298 num_conti=num_conti+1
2299 if (num_conti.gt.maxconts) then
2300 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2301 & ' will skip next contacts for this conf.'
2303 jcont_hb(num_conti,i)=j
2304 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2305 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2306 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2308 d_cont(num_conti,i)=rij
2309 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2310 C --- Electrostatic-interaction matrix ---
2311 a_chuj(1,1,num_conti,i)=a22
2312 a_chuj(1,2,num_conti,i)=a23
2313 a_chuj(2,1,num_conti,i)=a32
2314 a_chuj(2,2,num_conti,i)=a33
2315 C --- Gradient of rij
2317 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2320 c a_chuj(1,1,num_conti,i)=-0.61d0
2321 c a_chuj(1,2,num_conti,i)= 0.4d0
2322 c a_chuj(2,1,num_conti,i)= 0.65d0
2323 c a_chuj(2,2,num_conti,i)= 0.50d0
2324 c else if (i.eq.2) then
2325 c a_chuj(1,1,num_conti,i)= 0.0d0
2326 c a_chuj(1,2,num_conti,i)= 0.0d0
2327 c a_chuj(2,1,num_conti,i)= 0.0d0
2328 c a_chuj(2,2,num_conti,i)= 0.0d0
2330 C --- and its gradients
2331 cd write (iout,*) 'i',i,' j',j
2333 cd write (iout,*) 'iii 1 kkk',kkk
2334 cd write (iout,*) agg(kkk,:)
2337 cd write (iout,*) 'iii 2 kkk',kkk
2338 cd write (iout,*) aggi(kkk,:)
2341 cd write (iout,*) 'iii 3 kkk',kkk
2342 cd write (iout,*) aggi1(kkk,:)
2345 cd write (iout,*) 'iii 4 kkk',kkk
2346 cd write (iout,*) aggj(kkk,:)
2349 cd write (iout,*) 'iii 5 kkk',kkk
2350 cd write (iout,*) aggj1(kkk,:)
2357 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2358 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2359 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2360 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2361 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2363 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2369 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2370 C Calculate contact energies
2372 wij=cosa-3.0D0*cosb*cosg
2375 c fac3=dsqrt(-ael6i)/r0ij**3
2376 fac3=dsqrt(-ael6i)*r3ij
2377 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2378 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2380 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2381 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2382 C Diagnostics. Comment out or remove after debugging!
2383 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2384 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2385 c ees0m(num_conti,i)=0.0D0
2387 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2388 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2389 facont_hb(num_conti,i)=fcont
2391 C Angular derivatives of the contact function
2392 ees0pij1=fac3/ees0pij
2393 ees0mij1=fac3/ees0mij
2394 fac3p=-3.0D0*fac3*rrmij
2395 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2396 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2398 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2399 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2400 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2401 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2402 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2403 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2404 ecosap=ecosa1+ecosa2
2405 ecosbp=ecosb1+ecosb2
2406 ecosgp=ecosg1+ecosg2
2407 ecosam=ecosa1-ecosa2
2408 ecosbm=ecosb1-ecosb2
2409 ecosgm=ecosg1-ecosg2
2418 fprimcont=fprimcont/rij
2419 cd facont_hb(num_conti,i)=1.0D0
2420 C Following line is for diagnostics.
2423 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2424 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2427 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2428 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2430 gggp(1)=gggp(1)+ees0pijp*xj
2431 gggp(2)=gggp(2)+ees0pijp*yj
2432 gggp(3)=gggp(3)+ees0pijp*zj
2433 gggm(1)=gggm(1)+ees0mijp*xj
2434 gggm(2)=gggm(2)+ees0mijp*yj
2435 gggm(3)=gggm(3)+ees0mijp*zj
2436 C Derivatives due to the contact function
2437 gacont_hbr(1,num_conti,i)=fprimcont*xj
2438 gacont_hbr(2,num_conti,i)=fprimcont*yj
2439 gacont_hbr(3,num_conti,i)=fprimcont*zj
2441 ghalfp=0.5D0*gggp(k)
2442 ghalfm=0.5D0*gggm(k)
2443 gacontp_hb1(k,num_conti,i)=ghalfp
2444 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2445 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2446 gacontp_hb2(k,num_conti,i)=ghalfp
2447 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2448 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2449 gacontp_hb3(k,num_conti,i)=gggp(k)
2450 gacontm_hb1(k,num_conti,i)=ghalfm
2451 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2452 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2453 gacontm_hb2(k,num_conti,i)=ghalfm
2454 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2455 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2456 gacontm_hb3(k,num_conti,i)=gggm(k)
2459 C Diagnostics. Comment out or remove after debugging!
2461 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2462 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2463 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2464 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2465 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2466 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2469 endif ! num_conti.le.maxconts
2474 num_cont_hb(i)=num_conti
2478 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2479 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2481 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2482 ccc eel_loc=eel_loc+eello_turn3
2485 C-----------------------------------------------------------------------------
2486 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2487 C Third- and fourth-order contributions from turns
2488 implicit real*8 (a-h,o-z)
2489 include 'DIMENSIONS'
2490 include 'sizesclu.dat'
2491 include 'COMMON.IOUNITS'
2492 include 'COMMON.GEO'
2493 include 'COMMON.VAR'
2494 include 'COMMON.LOCAL'
2495 include 'COMMON.CHAIN'
2496 include 'COMMON.DERIV'
2497 include 'COMMON.INTERACT'
2498 include 'COMMON.CONTACTS'
2499 include 'COMMON.TORSION'
2500 include 'COMMON.VECTORS'
2501 include 'COMMON.FFIELD'
2503 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2504 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2505 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2506 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2507 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2508 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2510 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2512 C Third-order contributions
2519 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2520 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2521 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2522 call transpose2(auxmat(1,1),auxmat1(1,1))
2523 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2524 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2525 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2526 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2527 cd & ' eello_turn3_num',4*eello_turn3_num
2529 C Derivatives in gamma(i)
2530 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2531 call transpose2(auxmat2(1,1),pizda(1,1))
2532 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2533 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2534 C Derivatives in gamma(i+1)
2535 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2536 call transpose2(auxmat2(1,1),pizda(1,1))
2537 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2538 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2539 & +0.5d0*(pizda(1,1)+pizda(2,2))
2540 C Cartesian derivatives
2542 a_temp(1,1)=aggi(l,1)
2543 a_temp(1,2)=aggi(l,2)
2544 a_temp(2,1)=aggi(l,3)
2545 a_temp(2,2)=aggi(l,4)
2546 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2547 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2548 & +0.5d0*(pizda(1,1)+pizda(2,2))
2549 a_temp(1,1)=aggi1(l,1)
2550 a_temp(1,2)=aggi1(l,2)
2551 a_temp(2,1)=aggi1(l,3)
2552 a_temp(2,2)=aggi1(l,4)
2553 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2554 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2555 & +0.5d0*(pizda(1,1)+pizda(2,2))
2556 a_temp(1,1)=aggj(l,1)
2557 a_temp(1,2)=aggj(l,2)
2558 a_temp(2,1)=aggj(l,3)
2559 a_temp(2,2)=aggj(l,4)
2560 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2561 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2562 & +0.5d0*(pizda(1,1)+pizda(2,2))
2563 a_temp(1,1)=aggj1(l,1)
2564 a_temp(1,2)=aggj1(l,2)
2565 a_temp(2,1)=aggj1(l,3)
2566 a_temp(2,2)=aggj1(l,4)
2567 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2568 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2569 & +0.5d0*(pizda(1,1)+pizda(2,2))
2572 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2573 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2575 C Fourth-order contributions
2583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2584 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2585 iti1=itortyp(itype(i+1))
2586 iti2=itortyp(itype(i+2))
2587 iti3=itortyp(itype(i+3))
2588 call transpose2(EUg(1,1,i+1),e1t(1,1))
2589 call transpose2(Eug(1,1,i+2),e2t(1,1))
2590 call transpose2(Eug(1,1,i+3),e3t(1,1))
2591 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2592 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2593 s1=scalar2(b1(1,iti2),auxvec(1))
2594 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2595 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2596 s2=scalar2(b1(1,iti1),auxvec(1))
2597 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2598 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2599 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2600 eello_turn4=eello_turn4-(s1+s2+s3)
2601 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2602 cd & ' eello_turn4_num',8*eello_turn4_num
2603 C Derivatives in gamma(i)
2605 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2606 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2607 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2608 s1=scalar2(b1(1,iti2),auxvec(1))
2609 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2610 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2611 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2612 C Derivatives in gamma(i+1)
2613 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2614 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2615 s2=scalar2(b1(1,iti1),auxvec(1))
2616 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2617 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2618 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2619 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2620 C Derivatives in gamma(i+2)
2621 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2622 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2623 s1=scalar2(b1(1,iti2),auxvec(1))
2624 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2625 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2626 s2=scalar2(b1(1,iti1),auxvec(1))
2627 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2628 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2629 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2630 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2631 C Cartesian derivatives
2632 C Derivatives of this turn contributions in DC(i+2)
2633 if (j.lt.nres-1) then
2635 a_temp(1,1)=agg(l,1)
2636 a_temp(1,2)=agg(l,2)
2637 a_temp(2,1)=agg(l,3)
2638 a_temp(2,2)=agg(l,4)
2639 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2640 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2641 s1=scalar2(b1(1,iti2),auxvec(1))
2642 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2643 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2644 s2=scalar2(b1(1,iti1),auxvec(1))
2645 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2646 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2647 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2649 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2652 C Remaining derivatives of this turn contribution
2654 a_temp(1,1)=aggi(l,1)
2655 a_temp(1,2)=aggi(l,2)
2656 a_temp(2,1)=aggi(l,3)
2657 a_temp(2,2)=aggi(l,4)
2658 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2659 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2660 s1=scalar2(b1(1,iti2),auxvec(1))
2661 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2662 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2663 s2=scalar2(b1(1,iti1),auxvec(1))
2664 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2665 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2666 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2667 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2668 a_temp(1,1)=aggi1(l,1)
2669 a_temp(1,2)=aggi1(l,2)
2670 a_temp(2,1)=aggi1(l,3)
2671 a_temp(2,2)=aggi1(l,4)
2672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2674 s1=scalar2(b1(1,iti2),auxvec(1))
2675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2677 s2=scalar2(b1(1,iti1),auxvec(1))
2678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2681 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2682 a_temp(1,1)=aggj(l,1)
2683 a_temp(1,2)=aggj(l,2)
2684 a_temp(2,1)=aggj(l,3)
2685 a_temp(2,2)=aggj(l,4)
2686 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2687 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2688 s1=scalar2(b1(1,iti2),auxvec(1))
2689 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2690 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2691 s2=scalar2(b1(1,iti1),auxvec(1))
2692 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2693 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2695 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2696 a_temp(1,1)=aggj1(l,1)
2697 a_temp(1,2)=aggj1(l,2)
2698 a_temp(2,1)=aggj1(l,3)
2699 a_temp(2,2)=aggj1(l,4)
2700 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2701 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2702 s1=scalar2(b1(1,iti2),auxvec(1))
2703 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2704 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2705 s2=scalar2(b1(1,iti1),auxvec(1))
2706 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2707 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2708 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2709 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2715 C-----------------------------------------------------------------------------
2716 subroutine vecpr(u,v,w)
2717 implicit real*8(a-h,o-z)
2718 dimension u(3),v(3),w(3)
2719 w(1)=u(2)*v(3)-u(3)*v(2)
2720 w(2)=-u(1)*v(3)+u(3)*v(1)
2721 w(3)=u(1)*v(2)-u(2)*v(1)
2724 C-----------------------------------------------------------------------------
2725 subroutine unormderiv(u,ugrad,unorm,ungrad)
2726 C This subroutine computes the derivatives of a normalized vector u, given
2727 C the derivatives computed without normalization conditions, ugrad. Returns
2730 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2731 double precision vec(3)
2732 double precision scalar
2734 c write (2,*) 'ugrad',ugrad
2737 vec(i)=scalar(ugrad(1,i),u(1))
2739 c write (2,*) 'vec',vec
2742 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2745 c write (2,*) 'ungrad',ungrad
2748 C-----------------------------------------------------------------------------
2749 subroutine escp(evdw2,evdw2_14)
2751 C This subroutine calculates the excluded-volume interaction energy between
2752 C peptide-group centers and side chains and its gradient in virtual-bond and
2753 C side-chain vectors.
2755 implicit real*8 (a-h,o-z)
2756 include 'DIMENSIONS'
2757 include 'sizesclu.dat'
2758 include 'COMMON.GEO'
2759 include 'COMMON.VAR'
2760 include 'COMMON.LOCAL'
2761 include 'COMMON.CHAIN'
2762 include 'COMMON.DERIV'
2763 include 'COMMON.INTERACT'
2764 include 'COMMON.FFIELD'
2765 include 'COMMON.IOUNITS'
2769 cd print '(a)','Enter ESCP'
2770 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2771 c & ' scal14',scal14
2772 do i=iatscp_s,iatscp_e
2773 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2775 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2776 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2777 if (iteli.eq.0) goto 1225
2778 xi=0.5D0*(c(1,i)+c(1,i+1))
2779 yi=0.5D0*(c(2,i)+c(2,i+1))
2780 zi=0.5D0*(c(3,i)+c(3,i+1))
2782 do iint=1,nscp_gr(i)
2784 do j=iscpstart(i,iint),iscpend(i,iint)
2785 itypj=iabs(itype(j))
2786 if (itypj.eq.ntyp1) cycle
2787 C Uncomment following three lines for SC-p interactions
2791 C Uncomment following three lines for Ca-p interactions
2795 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2797 e1=fac*fac*aad(itypj,iteli)
2798 e2=fac*bad(itypj,iteli)
2799 if (iabs(j-i) .le. 2) then
2802 evdw2_14=evdw2_14+e1+e2
2805 c write (iout,*) i,j,evdwij
2809 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2811 fac=-(evdwij+e1)*rrij
2816 cd write (iout,*) 'j<i'
2817 C Uncomment following three lines for SC-p interactions
2819 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2822 cd write (iout,*) 'j>i'
2825 C Uncomment following line for SC-p interactions
2826 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2830 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2834 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2835 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2838 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2848 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2849 gradx_scp(j,i)=expon*gradx_scp(j,i)
2852 C******************************************************************************
2856 C To save time the factor EXPON has been extracted from ALL components
2857 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2860 C******************************************************************************
2863 C--------------------------------------------------------------------------
2864 subroutine edis(ehpb)
2866 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2868 implicit real*8 (a-h,o-z)
2869 include 'DIMENSIONS'
2870 include 'sizesclu.dat'
2871 include 'COMMON.SBRIDGE'
2872 include 'COMMON.CHAIN'
2873 include 'COMMON.DERIV'
2874 include 'COMMON.VAR'
2875 include 'COMMON.INTERACT'
2878 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2879 cd print *,'link_start=',link_start,' link_end=',link_end
2880 if (link_end.eq.0) return
2881 do i=link_start,link_end
2882 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2883 C CA-CA distance used in regularization of structure.
2886 C iii and jjj point to the residues for which the distance is assigned.
2887 if (ii.gt.nres) then
2894 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2895 C distance and angle dependent SS bond potential.
2896 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2897 & iabs(itype(jjj)).eq.1) then
2898 call ssbond_ene(iii,jjj,eij)
2901 C Calculate the distance between the two points and its difference from the
2905 C Get the force constant corresponding to this distance.
2907 C Calculate the contribution to energy.
2908 ehpb=ehpb+waga*rdis*rdis
2910 C Evaluate gradient.
2913 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2914 cd & ' waga=',waga,' fac=',fac
2916 ggg(j)=fac*(c(j,jj)-c(j,ii))
2918 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2919 C If this is a SC-SC distance, we need to calculate the contributions to the
2920 C Cartesian gradient in the SC vectors (ghpbx).
2923 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2924 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2929 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2937 C--------------------------------------------------------------------------
2938 subroutine ssbond_ene(i,j,eij)
2940 C Calculate the distance and angle dependent SS-bond potential energy
2941 C using a free-energy function derived based on RHF/6-31G** ab initio
2942 C calculations of diethyl disulfide.
2944 C A. Liwo and U. Kozlowska, 11/24/03
2946 implicit real*8 (a-h,o-z)
2947 include 'DIMENSIONS'
2948 include 'sizesclu.dat'
2949 include 'COMMON.SBRIDGE'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.LOCAL'
2953 include 'COMMON.INTERACT'
2954 include 'COMMON.VAR'
2955 include 'COMMON.IOUNITS'
2956 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2957 itypi=iabs(itype(i))
2961 dxi=dc_norm(1,nres+i)
2962 dyi=dc_norm(2,nres+i)
2963 dzi=dc_norm(3,nres+i)
2964 dsci_inv=dsc_inv(itypi)
2965 itypj=iabs(itype(j))
2966 dscj_inv=dsc_inv(itypj)
2970 dxj=dc_norm(1,nres+j)
2971 dyj=dc_norm(2,nres+j)
2972 dzj=dc_norm(3,nres+j)
2973 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2978 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2979 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2980 om12=dxi*dxj+dyi*dyj+dzi*dzj
2982 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2983 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2989 deltat12=om2-om1+2.0d0
2991 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2992 & +akct*deltad*deltat12
2993 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2994 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2995 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2996 c & " deltat12",deltat12," eij",eij
2997 ed=2*akcm*deltad+akct*deltat12
2999 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3000 eom1=-2*akth*deltat1-pom1-om2*pom2
3001 eom2= 2*akth*deltat2+pom1-om1*pom2
3004 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3007 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3008 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3009 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3010 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3013 C Calculate the components of the gradient in DC and X
3017 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3022 C--------------------------------------------------------------------------
3023 subroutine ebond(estr)
3025 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3027 implicit real*8 (a-h,o-z)
3028 include 'DIMENSIONS'
3029 include 'sizesclu.dat'
3030 include 'COMMON.LOCAL'
3031 include 'COMMON.GEO'
3032 include 'COMMON.INTERACT'
3033 include 'COMMON.DERIV'
3034 include 'COMMON.VAR'
3035 include 'COMMON.CHAIN'
3036 include 'COMMON.IOUNITS'
3037 include 'COMMON.NAMES'
3038 include 'COMMON.FFIELD'
3039 include 'COMMON.CONTROL'
3040 logical energy_dec /.false./
3041 double precision u(3),ud(3)
3045 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3046 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3048 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3049 & *dc(j,i-1)/vbld(i)
3051 if (energy_dec) write(iout,*)
3052 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3054 diff = vbld(i)-vbldp0
3055 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3058 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3063 estr=0.5d0*AKP*estr+estr1
3065 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3069 if (iti.ne.10 .and. iti.ne.ntyp1) then
3072 diff=vbld(i+nres)-vbldsc0(1,iti)
3073 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3074 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3075 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3077 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3081 diff=vbld(i+nres)-vbldsc0(j,iti)
3082 ud(j)=aksc(j,iti)*diff
3083 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3097 uprod2=uprod2*u(k)*u(k)
3101 usumsqder=usumsqder+ud(j)*uprod2
3103 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3104 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3105 estr=estr+uprod/usum
3107 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3115 C--------------------------------------------------------------------------
3116 subroutine ebend(etheta)
3118 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3119 C angles gamma and its derivatives in consecutive thetas and gammas.
3121 implicit real*8 (a-h,o-z)
3122 include 'DIMENSIONS'
3123 include 'sizesclu.dat'
3124 include 'COMMON.LOCAL'
3125 include 'COMMON.GEO'
3126 include 'COMMON.INTERACT'
3127 include 'COMMON.DERIV'
3128 include 'COMMON.VAR'
3129 include 'COMMON.CHAIN'
3130 include 'COMMON.IOUNITS'
3131 include 'COMMON.NAMES'
3132 include 'COMMON.FFIELD'
3133 common /calcthet/ term1,term2,termm,diffak,ratak,
3134 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3135 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3136 double precision y(2),z(2)
3138 c time11=dexp(-2*time)
3141 c write (iout,*) "nres",nres
3142 c write (*,'(a,i2)') 'EBEND ICG=',icg
3143 c write (iout,*) ithet_start,ithet_end
3144 do i=ithet_start,ithet_end
3145 if (itype(i-1).eq.ntyp1) cycle
3146 C Zero the energy function and its derivative at 0 or pi.
3147 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3149 ichir1=isign(1,itype(i-2))
3150 ichir2=isign(1,itype(i))
3151 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3152 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3153 if (itype(i-1).eq.10) then
3154 itype1=isign(10,itype(i-2))
3155 ichir11=isign(1,itype(i-2))
3156 ichir12=isign(1,itype(i-2))
3157 itype2=isign(10,itype(i))
3158 ichir21=isign(1,itype(i))
3159 ichir22=isign(1,itype(i))
3161 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3165 c call proc_proc(phii,icrc)
3166 if (icrc.eq.1) phii=150.0
3176 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3180 c call proc_proc(phii1,icrc)
3181 if (icrc.eq.1) phii1=150.0
3193 C Calculate the "mean" value of theta from the part of the distribution
3194 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3195 C In following comments this theta will be referred to as t_c.
3196 thet_pred_mean=0.0d0
3198 athetk=athet(k,it,ichir1,ichir2)
3199 bthetk=bthet(k,it,ichir1,ichir2)
3201 athetk=athet(k,itype1,ichir11,ichir12)
3202 bthetk=bthet(k,itype2,ichir21,ichir22)
3204 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3206 c write (iout,*) "thet_pred_mean",thet_pred_mean
3207 dthett=thet_pred_mean*ssd
3208 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3209 c write (iout,*) "thet_pred_mean",thet_pred_mean
3210 C Derivatives of the "mean" values in gamma1 and gamma2.
3211 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3212 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3213 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3214 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3216 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3217 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3218 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3219 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3221 if (theta(i).gt.pi-delta) then
3222 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3224 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3225 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3226 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3228 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3230 else if (theta(i).lt.delta) then
3231 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3232 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3233 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3235 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3236 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3239 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3242 etheta=etheta+ethetai
3243 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3244 c & rad2deg*phii,rad2deg*phii1,ethetai
3245 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3246 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3247 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3250 C Ufff.... We've done all this!!!
3253 C---------------------------------------------------------------------------
3254 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3256 implicit real*8 (a-h,o-z)
3257 include 'DIMENSIONS'
3258 include 'COMMON.LOCAL'
3259 include 'COMMON.IOUNITS'
3260 common /calcthet/ term1,term2,termm,diffak,ratak,
3261 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3262 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3263 C Calculate the contributions to both Gaussian lobes.
3264 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3265 C The "polynomial part" of the "standard deviation" of this part of
3269 sig=sig*thet_pred_mean+polthet(j,it)
3271 C Derivative of the "interior part" of the "standard deviation of the"
3272 C gamma-dependent Gaussian lobe in t_c.
3273 sigtc=3*polthet(3,it)
3275 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3278 C Set the parameters of both Gaussian lobes of the distribution.
3279 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3280 fac=sig*sig+sigc0(it)
3283 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3284 sigsqtc=-4.0D0*sigcsq*sigtc
3285 c print *,i,sig,sigtc,sigsqtc
3286 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3287 sigtc=-sigtc/(fac*fac)
3288 C Following variable is sigma(t_c)**(-2)
3289 sigcsq=sigcsq*sigcsq
3291 sig0inv=1.0D0/sig0i**2
3292 delthec=thetai-thet_pred_mean
3293 delthe0=thetai-theta0i
3294 term1=-0.5D0*sigcsq*delthec*delthec
3295 term2=-0.5D0*sig0inv*delthe0*delthe0
3296 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3297 C NaNs in taking the logarithm. We extract the largest exponent which is added
3298 C to the energy (this being the log of the distribution) at the end of energy
3299 C term evaluation for this virtual-bond angle.
3300 if (term1.gt.term2) then
3302 term2=dexp(term2-termm)
3306 term1=dexp(term1-termm)
3309 C The ratio between the gamma-independent and gamma-dependent lobes of
3310 C the distribution is a Gaussian function of thet_pred_mean too.
3311 diffak=gthet(2,it)-thet_pred_mean
3312 ratak=diffak/gthet(3,it)**2
3313 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3314 C Let's differentiate it in thet_pred_mean NOW.
3316 C Now put together the distribution terms to make complete distribution.
3317 termexp=term1+ak*term2
3318 termpre=sigc+ak*sig0i
3319 C Contribution of the bending energy from this theta is just the -log of
3320 C the sum of the contributions from the two lobes and the pre-exponential
3321 C factor. Simple enough, isn't it?
3322 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3323 C NOW the derivatives!!!
3324 C 6/6/97 Take into account the deformation.
3325 E_theta=(delthec*sigcsq*term1
3326 & +ak*delthe0*sig0inv*term2)/termexp
3327 E_tc=((sigtc+aktc*sig0i)/termpre
3328 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3329 & aktc*term2)/termexp)
3332 c-----------------------------------------------------------------------------
3333 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3334 implicit real*8 (a-h,o-z)
3335 include 'DIMENSIONS'
3336 include 'COMMON.LOCAL'
3337 include 'COMMON.IOUNITS'
3338 common /calcthet/ term1,term2,termm,diffak,ratak,
3339 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3340 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3341 delthec=thetai-thet_pred_mean
3342 delthe0=thetai-theta0i
3343 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3344 t3 = thetai-thet_pred_mean
3348 t14 = t12+t6*sigsqtc
3350 t21 = thetai-theta0i
3356 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3357 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3358 & *(-t12*t9-ak*sig0inv*t27)
3362 C--------------------------------------------------------------------------
3363 subroutine ebend(etheta)
3365 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3366 C angles gamma and its derivatives in consecutive thetas and gammas.
3367 C ab initio-derived potentials from
3368 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3370 implicit real*8 (a-h,o-z)
3371 include 'DIMENSIONS'
3372 include 'sizesclu.dat'
3373 include 'COMMON.LOCAL'
3374 include 'COMMON.GEO'
3375 include 'COMMON.INTERACT'
3376 include 'COMMON.DERIV'
3377 include 'COMMON.VAR'
3378 include 'COMMON.CHAIN'
3379 include 'COMMON.IOUNITS'
3380 include 'COMMON.NAMES'
3381 include 'COMMON.FFIELD'
3382 include 'COMMON.CONTROL'
3383 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3384 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3385 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3386 & sinph1ph2(maxdouble,maxdouble)
3387 logical lprn /.false./, lprn1 /.false./
3389 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3390 do i=ithet_start,ithet_end
3391 c if (itype(i-1).eq.ntyp1) cycle
3392 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3393 &(itype(i).eq.ntyp1)) cycle
3394 if (iabs(itype(i+1)).eq.20) iblock=2
3395 if (iabs(itype(i+1)).ne.20) iblock=1
3399 theti2=0.5d0*theta(i)
3400 CC Ta zmina jest niewlasciwa
3401 ityp2=ithetyp((itype(i-1)))
3403 coskt(k)=dcos(k*theti2)
3404 sinkt(k)=dsin(k*theti2)
3406 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3409 if (phii.ne.phii) phii=150.0
3413 ityp1=ithetyp((itype(i-2)))
3415 cosph1(k)=dcos(k*phii)
3416 sinph1(k)=dsin(k*phii)
3422 ityp1=ithetyp((itype(i-2)))
3427 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3430 if (phii1.ne.phii1) phii1=150.0
3435 ityp3=ithetyp((itype(i)))
3437 cosph2(k)=dcos(k*phii1)
3438 sinph2(k)=dsin(k*phii1)
3443 ityp3=ithetyp((itype(i)))
3449 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3450 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3452 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3455 ccl=cosph1(l)*cosph2(k-l)
3456 ssl=sinph1(l)*sinph2(k-l)
3457 scl=sinph1(l)*cosph2(k-l)
3458 csl=cosph1(l)*sinph2(k-l)
3459 cosph1ph2(l,k)=ccl-ssl
3460 cosph1ph2(k,l)=ccl+ssl
3461 sinph1ph2(l,k)=scl+csl
3462 sinph1ph2(k,l)=scl-csl
3466 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3467 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3468 write (iout,*) "coskt and sinkt"
3470 write (iout,*) k,coskt(k),sinkt(k)
3474 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3475 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3478 & write (iout,*) "k",k," aathet",
3479 & aathet(k,ityp1,ityp2,ityp3,iblock),
3480 & " ethetai",ethetai
3483 write (iout,*) "cosph and sinph"
3485 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3487 write (iout,*) "cosph1ph2 and sinph2ph2"
3490 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3491 & sinph1ph2(l,k),sinph1ph2(k,l)
3494 write(iout,*) "ethetai",ethetai
3498 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3499 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3500 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3501 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3502 ethetai=ethetai+sinkt(m)*aux
3503 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3504 dephii=dephii+k*sinkt(m)*(
3505 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3506 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3507 dephii1=dephii1+k*sinkt(m)*(
3508 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3509 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3511 & write (iout,*) "m",m," k",k," bbthet",
3512 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3513 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3514 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3515 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3519 & write(iout,*) "ethetai",ethetai
3523 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3524 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3525 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3526 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3527 ethetai=ethetai+sinkt(m)*aux
3528 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3529 dephii=dephii+l*sinkt(m)*(
3530 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3531 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3532 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3533 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3534 dephii1=dephii1+(k-l)*sinkt(m)*(
3535 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3536 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3537 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3538 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3540 write (iout,*) "m",m," k",k," l",l," ffthet",
3541 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3542 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3543 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3544 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3545 & " ethetai",ethetai
3546 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3547 & cosph1ph2(k,l)*sinkt(m),
3548 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3554 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3555 & i,theta(i)*rad2deg,phii*rad2deg,
3556 & phii1*rad2deg,ethetai
3557 etheta=etheta+ethetai
3558 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3559 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3560 c gloc(nphi+i-2,icg)=wang*dethetai
3561 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3567 c-----------------------------------------------------------------------------
3568 subroutine esc(escloc)
3569 C Calculate the local energy of a side chain and its derivatives in the
3570 C corresponding virtual-bond valence angles THETA and the spherical angles
3572 implicit real*8 (a-h,o-z)
3573 include 'DIMENSIONS'
3574 include 'sizesclu.dat'
3575 include 'COMMON.GEO'
3576 include 'COMMON.LOCAL'
3577 include 'COMMON.VAR'
3578 include 'COMMON.INTERACT'
3579 include 'COMMON.DERIV'
3580 include 'COMMON.CHAIN'
3581 include 'COMMON.IOUNITS'
3582 include 'COMMON.NAMES'
3583 include 'COMMON.FFIELD'
3584 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3585 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3586 common /sccalc/ time11,time12,time112,theti,it,nlobit
3589 c write (iout,'(a)') 'ESC'
3590 do i=loc_start,loc_end
3592 if (it.eq.ntyp1) cycle
3593 if (it.eq.10) goto 1
3594 nlobit=nlob(iabs(it))
3595 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3596 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3597 theti=theta(i+1)-pipol
3601 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3603 if (x(2).gt.pi-delta) then
3607 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3609 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3610 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3612 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3613 & ddersc0(1),dersc(1))
3614 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3615 & ddersc0(3),dersc(3))
3617 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3619 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3620 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3621 & dersc0(2),esclocbi,dersc02)
3622 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3624 call splinthet(x(2),0.5d0*delta,ss,ssd)
3629 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3631 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3632 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3634 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3636 c write (iout,*) escloci
3637 else if (x(2).lt.delta) then
3641 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3643 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3644 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3646 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3647 & ddersc0(1),dersc(1))
3648 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3649 & ddersc0(3),dersc(3))
3651 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3653 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3654 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3655 & dersc0(2),esclocbi,dersc02)
3656 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3661 call splinthet(x(2),0.5d0*delta,ss,ssd)
3663 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3665 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3666 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3668 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3669 c write (iout,*) escloci
3671 call enesc(x,escloci,dersc,ddummy,.false.)
3674 escloc=escloc+escloci
3675 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3677 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3679 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3680 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3685 C---------------------------------------------------------------------------
3686 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3687 implicit real*8 (a-h,o-z)
3688 include 'DIMENSIONS'
3689 include 'COMMON.GEO'
3690 include 'COMMON.LOCAL'
3691 include 'COMMON.IOUNITS'
3692 common /sccalc/ time11,time12,time112,theti,it,nlobit
3693 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3694 double precision contr(maxlob,-1:1)
3696 c write (iout,*) 'it=',it,' nlobit=',nlobit
3700 if (mixed) ddersc(j)=0.0d0
3704 C Because of periodicity of the dependence of the SC energy in omega we have
3705 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3706 C To avoid underflows, first compute & store the exponents.
3714 z(k)=x(k)-censc(k,j,it)
3719 Axk=Axk+gaussc(l,k,j,it)*z(l)
3725 expfac=expfac+Ax(k,j,iii)*z(k)
3733 C As in the case of ebend, we want to avoid underflows in exponentiation and
3734 C subsequent NaNs and INFs in energy calculation.
3735 C Find the largest exponent
3739 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3743 cd print *,'it=',it,' emin=',emin
3745 C Compute the contribution to SC energy and derivatives
3749 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3750 cd print *,'j=',j,' expfac=',expfac
3751 escloc_i=escloc_i+expfac
3753 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3757 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3758 & +gaussc(k,2,j,it))*expfac
3765 dersc(1)=dersc(1)/cos(theti)**2
3766 ddersc(1)=ddersc(1)/cos(theti)**2
3769 escloci=-(dlog(escloc_i)-emin)
3771 dersc(j)=dersc(j)/escloc_i
3775 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3780 C------------------------------------------------------------------------------
3781 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3782 implicit real*8 (a-h,o-z)
3783 include 'DIMENSIONS'
3784 include 'COMMON.GEO'
3785 include 'COMMON.LOCAL'
3786 include 'COMMON.IOUNITS'
3787 common /sccalc/ time11,time12,time112,theti,it,nlobit
3788 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3789 double precision contr(maxlob)
3800 z(k)=x(k)-censc(k,j,it)
3806 Axk=Axk+gaussc(l,k,j,it)*z(l)
3812 expfac=expfac+Ax(k,j)*z(k)
3817 C As in the case of ebend, we want to avoid underflows in exponentiation and
3818 C subsequent NaNs and INFs in energy calculation.
3819 C Find the largest exponent
3822 if (emin.gt.contr(j)) emin=contr(j)
3826 C Compute the contribution to SC energy and derivatives
3830 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3831 escloc_i=escloc_i+expfac
3833 dersc(k)=dersc(k)+Ax(k,j)*expfac
3835 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3836 & +gaussc(1,2,j,it))*expfac
3840 dersc(1)=dersc(1)/cos(theti)**2
3841 dersc12=dersc12/cos(theti)**2
3842 escloci=-(dlog(escloc_i)-emin)
3844 dersc(j)=dersc(j)/escloc_i
3846 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3850 c----------------------------------------------------------------------------------
3851 subroutine esc(escloc)
3852 C Calculate the local energy of a side chain and its derivatives in the
3853 C corresponding virtual-bond valence angles THETA and the spherical angles
3854 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3855 C added by Urszula Kozlowska. 07/11/2007
3857 implicit real*8 (a-h,o-z)
3858 include 'DIMENSIONS'
3859 include 'sizesclu.dat'
3860 include 'COMMON.GEO'
3861 include 'COMMON.LOCAL'
3862 include 'COMMON.VAR'
3863 include 'COMMON.SCROT'
3864 include 'COMMON.INTERACT'
3865 include 'COMMON.DERIV'
3866 include 'COMMON.CHAIN'
3867 include 'COMMON.IOUNITS'
3868 include 'COMMON.NAMES'
3869 include 'COMMON.FFIELD'
3870 include 'COMMON.CONTROL'
3871 include 'COMMON.VECTORS'
3872 double precision x_prime(3),y_prime(3),z_prime(3)
3873 & , sumene,dsc_i,dp2_i,x(65),
3874 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3875 & de_dxx,de_dyy,de_dzz,de_dt
3876 double precision s1_t,s1_6_t,s2_t,s2_6_t
3878 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3879 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3880 & dt_dCi(3),dt_dCi1(3)
3881 common /sccalc/ time11,time12,time112,theti,it,nlobit
3884 do i=loc_start,loc_end
3885 if (itype(i).eq.ntyp1) cycle
3886 costtab(i+1) =dcos(theta(i+1))
3887 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3888 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3889 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3890 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3891 cosfac=dsqrt(cosfac2)
3892 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3893 sinfac=dsqrt(sinfac2)
3895 if (it.eq.10) goto 1
3897 C Compute the axes of tghe local cartesian coordinates system; store in
3898 c x_prime, y_prime and z_prime
3905 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3906 C & dc_norm(3,i+nres)
3908 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3909 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3912 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3915 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3916 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3917 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3918 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3919 c & " xy",scalar(x_prime(1),y_prime(1)),
3920 c & " xz",scalar(x_prime(1),z_prime(1)),
3921 c & " yy",scalar(y_prime(1),y_prime(1)),
3922 c & " yz",scalar(y_prime(1),z_prime(1)),
3923 c & " zz",scalar(z_prime(1),z_prime(1))
3925 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3926 C to local coordinate system. Store in xx, yy, zz.
3932 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3933 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3934 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3941 C Compute the energy of the ith side cbain
3943 c write (2,*) "xx",xx," yy",yy," zz",zz
3946 x(j) = sc_parmin(j,it)
3949 Cc diagnostics - remove later
3951 yy1 = dsin(alph(2))*dcos(omeg(2))
3952 c zz1 = -dsin(alph(2))*dsin(omeg(2))
3953 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3954 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3955 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3957 C," --- ", xx_w,yy_w,zz_w
3960 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3961 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3963 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3964 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3966 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3967 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3968 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3969 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3970 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3972 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3973 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3974 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3975 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3976 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3978 dsc_i = 0.743d0+x(61)
3980 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3981 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3982 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3983 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3984 s1=(1+x(63))/(0.1d0 + dscp1)
3985 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3986 s2=(1+x(65))/(0.1d0 + dscp2)
3987 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3988 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3989 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3990 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3992 c & dscp1,dscp2,sumene
3993 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3994 escloc = escloc + sumene
3995 c write (2,*) "escloc",escloc
3996 if (.not. calc_grad) goto 1
3999 C This section to check the numerical derivatives of the energy of ith side
4000 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4001 C #define DEBUG in the code to turn it on.
4003 write (2,*) "sumene =",sumene
4007 write (2,*) xx,yy,zz
4008 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4009 de_dxx_num=(sumenep-sumene)/aincr
4011 write (2,*) "xx+ sumene from enesc=",sumenep
4014 write (2,*) xx,yy,zz
4015 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4016 de_dyy_num=(sumenep-sumene)/aincr
4018 write (2,*) "yy+ sumene from enesc=",sumenep
4021 write (2,*) xx,yy,zz
4022 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4023 de_dzz_num=(sumenep-sumene)/aincr
4025 write (2,*) "zz+ sumene from enesc=",sumenep
4026 costsave=cost2tab(i+1)
4027 sintsave=sint2tab(i+1)
4028 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4029 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4030 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4031 de_dt_num=(sumenep-sumene)/aincr
4032 write (2,*) " t+ sumene from enesc=",sumenep
4033 cost2tab(i+1)=costsave
4034 sint2tab(i+1)=sintsave
4035 C End of diagnostics section.
4038 C Compute the gradient of esc
4040 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4041 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4042 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4043 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4044 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4045 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4046 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4047 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4048 pom1=(sumene3*sint2tab(i+1)+sumene1)
4049 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4050 pom2=(sumene4*cost2tab(i+1)+sumene2)
4051 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4052 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4053 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4054 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4056 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4057 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4058 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4060 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4061 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4062 & +(pom1+pom2)*pom_dx
4064 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4067 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4068 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4069 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4071 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4072 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4073 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4074 & +x(59)*zz**2 +x(60)*xx*zz
4075 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4076 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4077 & +(pom1-pom2)*pom_dy
4079 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4082 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4083 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4084 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4085 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4086 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4087 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4088 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4089 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4091 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4094 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4095 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4096 & +pom1*pom_dt1+pom2*pom_dt2
4098 write(2,*), "de_dt = ", de_dt,de_dt_num
4102 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4103 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4104 cosfac2xx=cosfac2*xx
4105 sinfac2yy=sinfac2*yy
4107 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4109 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4111 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4112 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4113 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4114 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4115 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4116 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4117 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4118 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4119 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4120 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4124 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4125 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4126 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4127 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4130 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4131 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4132 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4134 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4135 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4139 dXX_Ctab(k,i)=dXX_Ci(k)
4140 dXX_C1tab(k,i)=dXX_Ci1(k)
4141 dYY_Ctab(k,i)=dYY_Ci(k)
4142 dYY_C1tab(k,i)=dYY_Ci1(k)
4143 dZZ_Ctab(k,i)=dZZ_Ci(k)
4144 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4145 dXX_XYZtab(k,i)=dXX_XYZ(k)
4146 dYY_XYZtab(k,i)=dYY_XYZ(k)
4147 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4151 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4152 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4153 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4154 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4155 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4157 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4158 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4159 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4160 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4161 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4162 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4163 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4164 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4166 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4167 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4169 C to check gradient call subroutine check_grad
4176 c------------------------------------------------------------------------------
4177 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4179 C This procedure calculates two-body contact function g(rij) and its derivative:
4182 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4185 C where x=(rij-r0ij)/delta
4187 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4190 double precision rij,r0ij,eps0ij,fcont,fprimcont
4191 double precision x,x2,x4,delta
4195 if (x.lt.-1.0D0) then
4198 else if (x.le.1.0D0) then
4201 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4202 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4209 c------------------------------------------------------------------------------
4210 subroutine splinthet(theti,delta,ss,ssder)
4211 implicit real*8 (a-h,o-z)
4212 include 'DIMENSIONS'
4213 include 'sizesclu.dat'
4214 include 'COMMON.VAR'
4215 include 'COMMON.GEO'
4218 if (theti.gt.pipol) then
4219 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4221 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4226 c------------------------------------------------------------------------------
4227 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4229 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4230 double precision ksi,ksi2,ksi3,a1,a2,a3
4231 a1=fprim0*delta/(f1-f0)
4237 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4238 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4241 c------------------------------------------------------------------------------
4242 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4244 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4245 double precision ksi,ksi2,ksi3,a1,a2,a3
4250 a2=3*(f1x-f0x)-2*fprim0x*delta
4251 a3=fprim0x*delta-2*(f1x-f0x)
4252 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4255 C-----------------------------------------------------------------------------
4257 C-----------------------------------------------------------------------------
4258 subroutine etor(etors,edihcnstr,fact)
4259 implicit real*8 (a-h,o-z)
4260 include 'DIMENSIONS'
4261 include 'sizesclu.dat'
4262 include 'COMMON.VAR'
4263 include 'COMMON.GEO'
4264 include 'COMMON.LOCAL'
4265 include 'COMMON.TORSION'
4266 include 'COMMON.INTERACT'
4267 include 'COMMON.DERIV'
4268 include 'COMMON.CHAIN'
4269 include 'COMMON.NAMES'
4270 include 'COMMON.IOUNITS'
4271 include 'COMMON.FFIELD'
4272 include 'COMMON.TORCNSTR'
4274 C Set lprn=.true. for debugging
4278 do i=iphi_start,iphi_end
4279 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4280 & .or. itype(i).eq.ntyp1) cycle
4281 itori=itortyp(itype(i-2))
4282 itori1=itortyp(itype(i-1))
4285 C Proline-Proline pair is a special case...
4286 if (itori.eq.3 .and. itori1.eq.3) then
4287 if (phii.gt.-dwapi3) then
4289 fac=1.0D0/(1.0D0-cosphi)
4290 etorsi=v1(1,3,3)*fac
4291 etorsi=etorsi+etorsi
4292 etors=etors+etorsi-v1(1,3,3)
4293 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4296 v1ij=v1(j+1,itori,itori1)
4297 v2ij=v2(j+1,itori,itori1)
4300 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4301 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4305 v1ij=v1(j,itori,itori1)
4306 v2ij=v2(j,itori,itori1)
4309 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4310 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4314 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4315 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4316 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4317 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4318 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4320 ! 6/20/98 - dihedral angle constraints
4323 itori=idih_constr(i)
4326 if (difi.gt.drange(i)) then
4328 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4329 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4330 else if (difi.lt.-drange(i)) then
4332 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4333 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4335 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4336 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4338 ! write (iout,*) 'edihcnstr',edihcnstr
4341 c------------------------------------------------------------------------------
4343 subroutine etor(etors,edihcnstr,fact)
4344 implicit real*8 (a-h,o-z)
4345 include 'DIMENSIONS'
4346 include 'sizesclu.dat'
4347 include 'COMMON.VAR'
4348 include 'COMMON.GEO'
4349 include 'COMMON.LOCAL'
4350 include 'COMMON.TORSION'
4351 include 'COMMON.INTERACT'
4352 include 'COMMON.DERIV'
4353 include 'COMMON.CHAIN'
4354 include 'COMMON.NAMES'
4355 include 'COMMON.IOUNITS'
4356 include 'COMMON.FFIELD'
4357 include 'COMMON.TORCNSTR'
4359 C Set lprn=.true. for debugging
4363 do i=iphi_start,iphi_end
4364 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4365 & .or. itype(i).eq.ntyp1) cycle
4366 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4367 if (iabs(itype(i)).eq.20) then
4372 itori=itortyp(itype(i-2))
4373 itori1=itortyp(itype(i-1))
4376 C Regular cosine and sine terms
4377 do j=1,nterm(itori,itori1,iblock)
4378 v1ij=v1(j,itori,itori1,iblock)
4379 v2ij=v2(j,itori,itori1,iblock)
4382 etors=etors+v1ij*cosphi+v2ij*sinphi
4383 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4387 C E = SUM ----------------------------------- - v1
4388 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4390 cosphi=dcos(0.5d0*phii)
4391 sinphi=dsin(0.5d0*phii)
4392 do j=1,nlor(itori,itori1,iblock)
4393 vl1ij=vlor1(j,itori,itori1)
4394 vl2ij=vlor2(j,itori,itori1)
4395 vl3ij=vlor3(j,itori,itori1)
4396 pom=vl2ij*cosphi+vl3ij*sinphi
4397 pom1=1.0d0/(pom*pom+1.0d0)
4398 etors=etors+vl1ij*pom1
4400 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4402 C Subtract the constant term
4403 etors=etors-v0(itori,itori1,iblock)
4405 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4406 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4407 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4408 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4409 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4412 ! 6/20/98 - dihedral angle constraints
4415 itori=idih_constr(i)
4417 difi=pinorm(phii-phi0(i))
4419 if (difi.gt.drange(i)) then
4421 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4422 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4423 edihi=0.25d0*ftors*difi**4
4424 else if (difi.lt.-drange(i)) then
4426 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4427 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4428 edihi=0.25d0*ftors*difi**4
4432 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4434 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4435 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4437 ! write (iout,*) 'edihcnstr',edihcnstr
4440 c----------------------------------------------------------------------------
4441 subroutine etor_d(etors_d,fact2)
4442 C 6/23/01 Compute double torsional energy
4443 implicit real*8 (a-h,o-z)
4444 include 'DIMENSIONS'
4445 include 'sizesclu.dat'
4446 include 'COMMON.VAR'
4447 include 'COMMON.GEO'
4448 include 'COMMON.LOCAL'
4449 include 'COMMON.TORSION'
4450 include 'COMMON.INTERACT'
4451 include 'COMMON.DERIV'
4452 include 'COMMON.CHAIN'
4453 include 'COMMON.NAMES'
4454 include 'COMMON.IOUNITS'
4455 include 'COMMON.FFIELD'
4456 include 'COMMON.TORCNSTR'
4458 C Set lprn=.true. for debugging
4462 do i=iphi_start,iphi_end-1
4463 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4464 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4465 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4467 itori=itortyp(itype(i-2))
4468 itori1=itortyp(itype(i-1))
4469 itori2=itortyp(itype(i))
4475 if (iabs(itype(i+1)).eq.20) iblock=2
4476 C Regular cosine and sine terms
4477 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4478 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4479 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4480 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4481 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4482 cosphi1=dcos(j*phii)
4483 sinphi1=dsin(j*phii)
4484 cosphi2=dcos(j*phii1)
4485 sinphi2=dsin(j*phii1)
4486 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4487 & v2cij*cosphi2+v2sij*sinphi2
4488 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4489 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4491 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4493 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4494 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4495 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4496 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4497 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4498 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4499 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4500 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4501 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4502 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4503 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4504 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4505 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4506 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4509 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4510 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4516 c------------------------------------------------------------------------------
4517 subroutine eback_sc_corr(esccor)
4518 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4519 c conformational states; temporarily implemented as differences
4520 c between UNRES torsional potentials (dependent on three types of
4521 c residues) and the torsional potentials dependent on all 20 types
4522 c of residues computed from AM1 energy surfaces of terminally-blocked
4523 c amino-acid residues.
4524 implicit real*8 (a-h,o-z)
4525 include 'DIMENSIONS'
4526 include 'sizesclu.dat'
4527 include 'COMMON.VAR'
4528 include 'COMMON.GEO'
4529 include 'COMMON.LOCAL'
4530 include 'COMMON.TORSION'
4531 include 'COMMON.SCCOR'
4532 include 'COMMON.INTERACT'
4533 include 'COMMON.DERIV'
4534 include 'COMMON.CHAIN'
4535 include 'COMMON.NAMES'
4536 include 'COMMON.IOUNITS'
4537 include 'COMMON.FFIELD'
4538 include 'COMMON.CONTROL'
4540 C Set lprn=.true. for debugging
4543 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4545 do i=itau_start,itau_end
4546 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4548 isccori=isccortyp(itype(i-2))
4549 isccori1=isccortyp(itype(i-1))
4551 do intertyp=1,3 !intertyp
4552 cc Added 09 May 2012 (Adasko)
4553 cc Intertyp means interaction type of backbone mainchain correlation:
4554 c 1 = SC...Ca...Ca...Ca
4555 c 2 = Ca...Ca...Ca...SC
4556 c 3 = SC...Ca...Ca...SCi
4558 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4559 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4560 & (itype(i-1).eq.ntyp1)))
4561 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4562 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4563 & .or.(itype(i).eq.ntyp1)))
4564 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4565 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4566 & (itype(i-3).eq.ntyp1)))) cycle
4567 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4568 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4570 do j=1,nterm_sccor(isccori,isccori1)
4571 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4572 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4573 cosphi=dcos(j*tauangle(intertyp,i))
4574 sinphi=dsin(j*tauangle(intertyp,i))
4575 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4576 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4578 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4579 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4581 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4582 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4583 & (v1sccor(j,1,itori,itori1),j=1,6),
4584 & (v2sccor(j,1,itori,itori1),j=1,6)
4585 gsccor_loc(i-3)=gloci
4590 c------------------------------------------------------------------------------
4591 subroutine multibody(ecorr)
4592 C This subroutine calculates multi-body contributions to energy following
4593 C the idea of Skolnick et al. If side chains I and J make a contact and
4594 C at the same time side chains I+1 and J+1 make a contact, an extra
4595 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4596 implicit real*8 (a-h,o-z)
4597 include 'DIMENSIONS'
4598 include 'COMMON.IOUNITS'
4599 include 'COMMON.DERIV'
4600 include 'COMMON.INTERACT'
4601 include 'COMMON.CONTACTS'
4602 double precision gx(3),gx1(3)
4605 C Set lprn=.true. for debugging
4609 write (iout,'(a)') 'Contact function values:'
4611 write (iout,'(i2,20(1x,i2,f10.5))')
4612 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4627 num_conti=num_cont(i)
4628 num_conti1=num_cont(i1)
4633 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4634 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4635 cd & ' ishift=',ishift
4636 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4637 C The system gains extra energy.
4638 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4639 endif ! j1==j+-ishift
4648 c------------------------------------------------------------------------------
4649 double precision function esccorr(i,j,k,l,jj,kk)
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 include 'COMMON.IOUNITS'
4653 include 'COMMON.DERIV'
4654 include 'COMMON.INTERACT'
4655 include 'COMMON.CONTACTS'
4656 double precision gx(3),gx1(3)
4661 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4662 C Calculate the multi-body contribution to energy.
4663 C Calculate multi-body contributions to the gradient.
4664 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4665 cd & k,l,(gacont(m,kk,k),m=1,3)
4667 gx(m) =ekl*gacont(m,jj,i)
4668 gx1(m)=eij*gacont(m,kk,k)
4669 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4670 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4671 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4672 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4676 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4681 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4687 c------------------------------------------------------------------------------
4689 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4690 implicit real*8 (a-h,o-z)
4691 include 'DIMENSIONS'
4692 integer dimen1,dimen2,atom,indx
4693 double precision buffer(dimen1,dimen2)
4694 double precision zapas
4695 common /contacts_hb/ zapas(3,20,maxres,7),
4696 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4697 & num_cont_hb(maxres),jcont_hb(20,maxres)
4698 num_kont=num_cont_hb(atom)
4702 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4705 buffer(i,indx+22)=facont_hb(i,atom)
4706 buffer(i,indx+23)=ees0p(i,atom)
4707 buffer(i,indx+24)=ees0m(i,atom)
4708 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4710 buffer(1,indx+26)=dfloat(num_kont)
4713 c------------------------------------------------------------------------------
4714 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4715 implicit real*8 (a-h,o-z)
4716 include 'DIMENSIONS'
4717 integer dimen1,dimen2,atom,indx
4718 double precision buffer(dimen1,dimen2)
4719 double precision zapas
4720 common /contacts_hb/ zapas(3,20,maxres,7),
4721 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4722 & num_cont_hb(maxres),jcont_hb(20,maxres)
4723 num_kont=buffer(1,indx+26)
4724 num_kont_old=num_cont_hb(atom)
4725 num_cont_hb(atom)=num_kont+num_kont_old
4730 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4733 facont_hb(ii,atom)=buffer(i,indx+22)
4734 ees0p(ii,atom)=buffer(i,indx+23)
4735 ees0m(ii,atom)=buffer(i,indx+24)
4736 jcont_hb(ii,atom)=buffer(i,indx+25)
4740 c------------------------------------------------------------------------------
4742 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4743 C This subroutine calculates multi-body contributions to hydrogen-bonding
4744 implicit real*8 (a-h,o-z)
4745 include 'DIMENSIONS'
4746 include 'sizesclu.dat'
4747 include 'COMMON.IOUNITS'
4749 include 'COMMON.INFO'
4751 include 'COMMON.FFIELD'
4752 include 'COMMON.DERIV'
4753 include 'COMMON.INTERACT'
4754 include 'COMMON.CONTACTS'
4756 parameter (max_cont=maxconts)
4757 parameter (max_dim=2*(8*3+2))
4758 parameter (msglen1=max_cont*max_dim*4)
4759 parameter (msglen2=2*msglen1)
4760 integer source,CorrelType,CorrelID,Error
4761 double precision buffer(max_cont,max_dim)
4763 double precision gx(3),gx1(3)
4766 C Set lprn=.true. for debugging
4771 if (fgProcs.le.1) goto 30
4773 write (iout,'(a)') 'Contact function values:'
4775 write (iout,'(2i3,50(1x,i2,f5.2))')
4776 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4777 & j=1,num_cont_hb(i))
4780 C Caution! Following code assumes that electrostatic interactions concerning
4781 C a given atom are split among at most two processors!
4791 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4794 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4795 if (MyRank.gt.0) then
4796 C Send correlation contributions to the preceding processor
4798 nn=num_cont_hb(iatel_s)
4799 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4800 cd write (iout,*) 'The BUFFER array:'
4802 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4804 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4806 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4807 C Clear the contacts of the atom passed to the neighboring processor
4808 nn=num_cont_hb(iatel_s+1)
4810 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4812 num_cont_hb(iatel_s)=0
4814 cd write (iout,*) 'Processor ',MyID,MyRank,
4815 cd & ' is sending correlation contribution to processor',MyID-1,
4816 cd & ' msglen=',msglen
4817 cd write (*,*) 'Processor ',MyID,MyRank,
4818 cd & ' is sending correlation contribution to processor',MyID-1,
4819 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4820 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4821 cd write (iout,*) 'Processor ',MyID,
4822 cd & ' has sent correlation contribution to processor',MyID-1,
4823 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4824 cd write (*,*) 'Processor ',MyID,
4825 cd & ' has sent correlation contribution to processor',MyID-1,
4826 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4828 endif ! (MyRank.gt.0)
4832 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4833 if (MyRank.lt.fgProcs-1) then
4834 C Receive correlation contributions from the next processor
4836 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4837 cd write (iout,*) 'Processor',MyID,
4838 cd & ' is receiving correlation contribution from processor',MyID+1,
4839 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4840 cd write (*,*) 'Processor',MyID,
4841 cd & ' is receiving correlation contribution from processor',MyID+1,
4842 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4844 do while (nbytes.le.0)
4845 call mp_probe(MyID+1,CorrelType,nbytes)
4847 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4848 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4849 cd write (iout,*) 'Processor',MyID,
4850 cd & ' has received correlation contribution from processor',MyID+1,
4851 cd & ' msglen=',msglen,' nbytes=',nbytes
4852 cd write (iout,*) 'The received BUFFER array:'
4854 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4856 if (msglen.eq.msglen1) then
4857 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4858 else if (msglen.eq.msglen2) then
4859 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4860 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4863 & 'ERROR!!!! message length changed while processing correlations.'
4865 & 'ERROR!!!! message length changed while processing correlations.'
4866 call mp_stopall(Error)
4867 endif ! msglen.eq.msglen1
4868 endif ! MyRank.lt.fgProcs-1
4875 write (iout,'(a)') 'Contact function values:'
4877 write (iout,'(2i3,50(1x,i2,f5.2))')
4878 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4879 & j=1,num_cont_hb(i))
4883 C Remove the loop below after debugging !!!
4890 C Calculate the local-electrostatic correlation terms
4891 do i=iatel_s,iatel_e+1
4893 num_conti=num_cont_hb(i)
4894 num_conti1=num_cont_hb(i+1)
4899 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4900 c & ' jj=',jj,' kk=',kk
4901 if (j1.eq.j+1 .or. j1.eq.j-1) then
4902 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4903 C The system gains extra energy.
4904 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4906 else if (j1.eq.j) then
4907 C Contacts I-J and I-(J+1) occur simultaneously.
4908 C The system loses extra energy.
4909 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4914 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4915 c & ' jj=',jj,' kk=',kk
4917 C Contacts I-J and (I+1)-J occur simultaneously.
4918 C The system loses extra energy.
4919 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4926 c------------------------------------------------------------------------------
4927 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4929 C This subroutine calculates multi-body contributions to hydrogen-bonding
4930 implicit real*8 (a-h,o-z)
4931 include 'DIMENSIONS'
4932 include 'sizesclu.dat'
4933 include 'COMMON.IOUNITS'
4935 include 'COMMON.INFO'
4937 include 'COMMON.FFIELD'
4938 include 'COMMON.DERIV'
4939 include 'COMMON.INTERACT'
4940 include 'COMMON.CONTACTS'
4942 parameter (max_cont=maxconts)
4943 parameter (max_dim=2*(8*3+2))
4944 parameter (msglen1=max_cont*max_dim*4)
4945 parameter (msglen2=2*msglen1)
4946 integer source,CorrelType,CorrelID,Error
4947 double precision buffer(max_cont,max_dim)
4949 double precision gx(3),gx1(3)
4952 C Set lprn=.true. for debugging
4958 if (fgProcs.le.1) goto 30
4960 write (iout,'(a)') 'Contact function values:'
4962 write (iout,'(2i3,50(1x,i2,f5.2))')
4963 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4964 & j=1,num_cont_hb(i))
4967 C Caution! Following code assumes that electrostatic interactions concerning
4968 C a given atom are split among at most two processors!
4978 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4981 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4982 if (MyRank.gt.0) then
4983 C Send correlation contributions to the preceding processor
4985 nn=num_cont_hb(iatel_s)
4986 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4987 cd write (iout,*) 'The BUFFER array:'
4989 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4991 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4993 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4994 C Clear the contacts of the atom passed to the neighboring processor
4995 nn=num_cont_hb(iatel_s+1)
4997 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4999 num_cont_hb(iatel_s)=0
5001 cd write (iout,*) 'Processor ',MyID,MyRank,
5002 cd & ' is sending correlation contribution to processor',MyID-1,
5003 cd & ' msglen=',msglen
5004 cd write (*,*) 'Processor ',MyID,MyRank,
5005 cd & ' is sending correlation contribution to processor',MyID-1,
5006 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5007 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5008 cd write (iout,*) 'Processor ',MyID,
5009 cd & ' has sent correlation contribution to processor',MyID-1,
5010 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5011 cd write (*,*) 'Processor ',MyID,
5012 cd & ' has sent correlation contribution to processor',MyID-1,
5013 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5015 endif ! (MyRank.gt.0)
5019 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5020 if (MyRank.lt.fgProcs-1) then
5021 C Receive correlation contributions from the next processor
5023 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5024 cd write (iout,*) 'Processor',MyID,
5025 cd & ' is receiving correlation contribution from processor',MyID+1,
5026 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5027 cd write (*,*) 'Processor',MyID,
5028 cd & ' is receiving correlation contribution from processor',MyID+1,
5029 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5031 do while (nbytes.le.0)
5032 call mp_probe(MyID+1,CorrelType,nbytes)
5034 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5035 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5036 cd write (iout,*) 'Processor',MyID,
5037 cd & ' has received correlation contribution from processor',MyID+1,
5038 cd & ' msglen=',msglen,' nbytes=',nbytes
5039 cd write (iout,*) 'The received BUFFER array:'
5041 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5043 if (msglen.eq.msglen1) then
5044 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5045 else if (msglen.eq.msglen2) then
5046 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5047 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5050 & 'ERROR!!!! message length changed while processing correlations.'
5052 & 'ERROR!!!! message length changed while processing correlations.'
5053 call mp_stopall(Error)
5054 endif ! msglen.eq.msglen1
5055 endif ! MyRank.lt.fgProcs-1
5062 write (iout,'(a)') 'Contact function values:'
5064 write (iout,'(2i3,50(1x,i2,f5.2))')
5065 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5066 & j=1,num_cont_hb(i))
5072 C Remove the loop below after debugging !!!
5079 C Calculate the dipole-dipole interaction energies
5080 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5081 do i=iatel_s,iatel_e+1
5082 num_conti=num_cont_hb(i)
5089 C Calculate the local-electrostatic correlation terms
5090 do i=iatel_s,iatel_e+1
5092 num_conti=num_cont_hb(i)
5093 num_conti1=num_cont_hb(i+1)
5098 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5099 c & ' jj=',jj,' kk=',kk
5100 if (j1.eq.j+1 .or. j1.eq.j-1) then
5101 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5102 C The system gains extra energy.
5104 sqd1=dsqrt(d_cont(jj,i))
5105 sqd2=dsqrt(d_cont(kk,i1))
5106 sred_geom = sqd1*sqd2
5107 IF (sred_geom.lt.cutoff_corr) THEN
5108 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5110 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5111 c & ' jj=',jj,' kk=',kk
5112 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5113 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5115 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5116 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5119 cd write (iout,*) 'sred_geom=',sred_geom,
5120 cd & ' ekont=',ekont,' fprim=',fprimcont
5121 call calc_eello(i,j,i+1,j1,jj,kk)
5122 if (wcorr4.gt.0.0d0)
5123 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5124 if (wcorr5.gt.0.0d0)
5125 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5126 c print *,"wcorr5",ecorr5
5127 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5128 cd write(2,*)'ijkl',i,j,i+1,j1
5129 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5130 & .or. wturn6.eq.0.0d0))then
5131 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5132 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5133 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5134 cd & 'ecorr6=',ecorr6
5135 cd write (iout,'(4e15.5)') sred_geom,
5136 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5137 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5138 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5139 else if (wturn6.gt.0.0d0
5140 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5141 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5142 eturn6=eturn6+eello_turn6(i,jj,kk)
5143 cd write (2,*) 'multibody_eello:eturn6',eturn6
5147 else if (j1.eq.j) then
5148 C Contacts I-J and I-(J+1) occur simultaneously.
5149 C The system loses extra energy.
5150 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5155 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5156 c & ' jj=',jj,' kk=',kk
5158 C Contacts I-J and (I+1)-J occur simultaneously.
5159 C The system loses extra energy.
5160 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5167 c------------------------------------------------------------------------------
5168 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5169 implicit real*8 (a-h,o-z)
5170 include 'DIMENSIONS'
5171 include 'COMMON.IOUNITS'
5172 include 'COMMON.DERIV'
5173 include 'COMMON.INTERACT'
5174 include 'COMMON.CONTACTS'
5175 double precision gx(3),gx1(3)
5185 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5186 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5187 C Following 4 lines for diagnostics.
5192 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5194 c write (iout,*)'Contacts have occurred for peptide groups',
5195 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5196 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5197 C Calculate the multi-body contribution to energy.
5198 ecorr=ecorr+ekont*ees
5200 C Calculate multi-body contributions to the gradient.
5202 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5203 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5204 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5205 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5206 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5207 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5208 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5209 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5210 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5211 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5212 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5213 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5214 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5215 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5219 gradcorr(ll,m)=gradcorr(ll,m)+
5220 & ees*ekl*gacont_hbr(ll,jj,i)-
5221 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5222 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5227 gradcorr(ll,m)=gradcorr(ll,m)+
5228 & ees*eij*gacont_hbr(ll,kk,k)-
5229 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5230 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5237 C---------------------------------------------------------------------------
5238 subroutine dipole(i,j,jj)
5239 implicit real*8 (a-h,o-z)
5240 include 'DIMENSIONS'
5241 include 'sizesclu.dat'
5242 include 'COMMON.IOUNITS'
5243 include 'COMMON.CHAIN'
5244 include 'COMMON.FFIELD'
5245 include 'COMMON.DERIV'
5246 include 'COMMON.INTERACT'
5247 include 'COMMON.CONTACTS'
5248 include 'COMMON.TORSION'
5249 include 'COMMON.VAR'
5250 include 'COMMON.GEO'
5251 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5253 iti1 = itortyp(itype(i+1))
5254 if (j.lt.nres-1) then
5255 if (itype(j).le.ntyp) then
5256 itj1 = itortyp(itype(j+1))
5264 dipi(iii,1)=Ub2(iii,i)
5265 dipderi(iii)=Ub2der(iii,i)
5266 dipi(iii,2)=b1(iii,iti1)
5267 dipj(iii,1)=Ub2(iii,j)
5268 dipderj(iii)=Ub2der(iii,j)
5269 dipj(iii,2)=b1(iii,itj1)
5273 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5276 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5279 if (.not.calc_grad) return
5284 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5288 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5293 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5294 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5296 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5298 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5300 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5304 C---------------------------------------------------------------------------
5305 subroutine calc_eello(i,j,k,l,jj,kk)
5307 C This subroutine computes matrices and vectors needed to calculate
5308 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5310 implicit real*8 (a-h,o-z)
5311 include 'DIMENSIONS'
5312 include 'sizesclu.dat'
5313 include 'COMMON.IOUNITS'
5314 include 'COMMON.CHAIN'
5315 include 'COMMON.DERIV'
5316 include 'COMMON.INTERACT'
5317 include 'COMMON.CONTACTS'
5318 include 'COMMON.TORSION'
5319 include 'COMMON.VAR'
5320 include 'COMMON.GEO'
5321 include 'COMMON.FFIELD'
5322 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5323 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5326 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5327 cd & ' jj=',jj,' kk=',kk
5328 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5331 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5332 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5335 call transpose2(aa1(1,1),aa1t(1,1))
5336 call transpose2(aa2(1,1),aa2t(1,1))
5339 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5340 & aa1tder(1,1,lll,kkk))
5341 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5342 & aa2tder(1,1,lll,kkk))
5346 C parallel orientation of the two CA-CA-CA frames.
5348 if (i.gt.1 .and. itype(i).le.ntyp) then
5349 iti=itortyp(itype(i))
5353 itk1=itortyp(itype(k+1))
5354 itj=itortyp(itype(j))
5355 c if (l.lt.nres-1) then
5356 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5357 itl1=itortyp(itype(l+1))
5361 C A1 kernel(j+1) A2T
5363 cd write (iout,'(3f10.5,5x,3f10.5)')
5364 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5366 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5367 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5368 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5369 C Following matrices are needed only for 6-th order cumulants
5370 IF (wcorr6.gt.0.0d0) THEN
5371 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5372 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5373 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5374 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5375 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5376 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5377 & ADtEAderx(1,1,1,1,1,1))
5379 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5380 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5381 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5382 & ADtEA1derx(1,1,1,1,1,1))
5384 C End 6-th order cumulants
5387 cd write (2,*) 'In calc_eello6'
5389 cd write (2,*) 'iii=',iii
5391 cd write (2,*) 'kkk=',kkk
5393 cd write (2,'(3(2f10.5),5x)')
5394 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5399 call transpose2(EUgder(1,1,k),auxmat(1,1))
5400 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5401 call transpose2(EUg(1,1,k),auxmat(1,1))
5402 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5403 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5407 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5408 & EAEAderx(1,1,lll,kkk,iii,1))
5412 C A1T kernel(i+1) A2
5413 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5414 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5415 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5416 C Following matrices are needed only for 6-th order cumulants
5417 IF (wcorr6.gt.0.0d0) THEN
5418 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5419 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5420 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5421 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5422 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5423 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5424 & ADtEAderx(1,1,1,1,1,2))
5425 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5426 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5427 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5428 & ADtEA1derx(1,1,1,1,1,2))
5430 C End 6-th order cumulants
5431 call transpose2(EUgder(1,1,l),auxmat(1,1))
5432 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5433 call transpose2(EUg(1,1,l),auxmat(1,1))
5434 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5435 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5439 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5440 & EAEAderx(1,1,lll,kkk,iii,2))
5445 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5446 C They are needed only when the fifth- or the sixth-order cumulants are
5448 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5449 call transpose2(AEA(1,1,1),auxmat(1,1))
5450 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5451 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5452 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5453 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5454 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5455 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5456 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5457 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5458 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5459 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5460 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5461 call transpose2(AEA(1,1,2),auxmat(1,1))
5462 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5463 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5464 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5465 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5466 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5467 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5468 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5469 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5470 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5471 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5472 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5473 C Calculate the Cartesian derivatives of the vectors.
5477 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5478 call matvec2(auxmat(1,1),b1(1,iti),
5479 & AEAb1derx(1,lll,kkk,iii,1,1))
5480 call matvec2(auxmat(1,1),Ub2(1,i),
5481 & AEAb2derx(1,lll,kkk,iii,1,1))
5482 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5483 & AEAb1derx(1,lll,kkk,iii,2,1))
5484 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5485 & AEAb2derx(1,lll,kkk,iii,2,1))
5486 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5487 call matvec2(auxmat(1,1),b1(1,itj),
5488 & AEAb1derx(1,lll,kkk,iii,1,2))
5489 call matvec2(auxmat(1,1),Ub2(1,j),
5490 & AEAb2derx(1,lll,kkk,iii,1,2))
5491 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5492 & AEAb1derx(1,lll,kkk,iii,2,2))
5493 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5494 & AEAb2derx(1,lll,kkk,iii,2,2))
5501 C Antiparallel orientation of the two CA-CA-CA frames.
5503 if (i.gt.1 .and. itype(i).le.ntyp) then
5504 iti=itortyp(itype(i))
5508 itk1=itortyp(itype(k+1))
5509 itl=itortyp(itype(l))
5510 itj=itortyp(itype(j))
5511 c if (j.lt.nres-1) then
5512 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5513 itj1=itortyp(itype(j+1))
5517 C A2 kernel(j-1)T A1T
5518 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5519 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5520 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5521 C Following matrices are needed only for 6-th order cumulants
5522 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5523 & j.eq.i+4 .and. l.eq.i+3)) THEN
5524 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5525 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5526 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5527 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5528 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5529 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5530 & ADtEAderx(1,1,1,1,1,1))
5531 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5532 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5533 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5534 & ADtEA1derx(1,1,1,1,1,1))
5536 C End 6-th order cumulants
5537 call transpose2(EUgder(1,1,k),auxmat(1,1))
5538 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5539 call transpose2(EUg(1,1,k),auxmat(1,1))
5540 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5541 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5545 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5546 & EAEAderx(1,1,lll,kkk,iii,1))
5550 C A2T kernel(i+1)T A1
5551 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5552 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5553 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5554 C Following matrices are needed only for 6-th order cumulants
5555 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5556 & j.eq.i+4 .and. l.eq.i+3)) THEN
5557 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5558 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5559 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5560 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5561 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5562 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5563 & ADtEAderx(1,1,1,1,1,2))
5564 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5565 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5566 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5567 & ADtEA1derx(1,1,1,1,1,2))
5569 C End 6-th order cumulants
5570 call transpose2(EUgder(1,1,j),auxmat(1,1))
5571 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5572 call transpose2(EUg(1,1,j),auxmat(1,1))
5573 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5574 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5578 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5579 & EAEAderx(1,1,lll,kkk,iii,2))
5584 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5585 C They are needed only when the fifth- or the sixth-order cumulants are
5587 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5588 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5589 call transpose2(AEA(1,1,1),auxmat(1,1))
5590 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5591 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5592 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5593 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5594 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5595 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5596 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5597 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5598 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5599 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5600 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5601 call transpose2(AEA(1,1,2),auxmat(1,1))
5602 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5603 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5604 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5605 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5606 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5607 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5608 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5609 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5610 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5611 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5612 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5613 C Calculate the Cartesian derivatives of the vectors.
5617 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5618 call matvec2(auxmat(1,1),b1(1,iti),
5619 & AEAb1derx(1,lll,kkk,iii,1,1))
5620 call matvec2(auxmat(1,1),Ub2(1,i),
5621 & AEAb2derx(1,lll,kkk,iii,1,1))
5622 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5623 & AEAb1derx(1,lll,kkk,iii,2,1))
5624 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5625 & AEAb2derx(1,lll,kkk,iii,2,1))
5626 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5627 call matvec2(auxmat(1,1),b1(1,itl),
5628 & AEAb1derx(1,lll,kkk,iii,1,2))
5629 call matvec2(auxmat(1,1),Ub2(1,l),
5630 & AEAb2derx(1,lll,kkk,iii,1,2))
5631 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5632 & AEAb1derx(1,lll,kkk,iii,2,2))
5633 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5634 & AEAb2derx(1,lll,kkk,iii,2,2))
5643 C---------------------------------------------------------------------------
5644 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5645 & KK,KKderg,AKA,AKAderg,AKAderx)
5649 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5650 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5651 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5656 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5658 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5661 cd if (lprn) write (2,*) 'In kernel'
5663 cd if (lprn) write (2,*) 'kkk=',kkk
5665 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5666 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5668 cd write (2,*) 'lll=',lll
5669 cd write (2,*) 'iii=1'
5671 cd write (2,'(3(2f10.5),5x)')
5672 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5675 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5676 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5678 cd write (2,*) 'lll=',lll
5679 cd write (2,*) 'iii=2'
5681 cd write (2,'(3(2f10.5),5x)')
5682 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5689 C---------------------------------------------------------------------------
5690 double precision function eello4(i,j,k,l,jj,kk)
5691 implicit real*8 (a-h,o-z)
5692 include 'DIMENSIONS'
5693 include 'sizesclu.dat'
5694 include 'COMMON.IOUNITS'
5695 include 'COMMON.CHAIN'
5696 include 'COMMON.DERIV'
5697 include 'COMMON.INTERACT'
5698 include 'COMMON.CONTACTS'
5699 include 'COMMON.TORSION'
5700 include 'COMMON.VAR'
5701 include 'COMMON.GEO'
5702 double precision pizda(2,2),ggg1(3),ggg2(3)
5703 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5707 cd print *,'eello4:',i,j,k,l,jj,kk
5708 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5709 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5710 cold eij=facont_hb(jj,i)
5711 cold ekl=facont_hb(kk,k)
5713 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5715 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5716 gcorr_loc(k-1)=gcorr_loc(k-1)
5717 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5719 gcorr_loc(l-1)=gcorr_loc(l-1)
5720 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5722 gcorr_loc(j-1)=gcorr_loc(j-1)
5723 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5728 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5729 & -EAEAderx(2,2,lll,kkk,iii,1)
5730 cd derx(lll,kkk,iii)=0.0d0
5734 cd gcorr_loc(l-1)=0.0d0
5735 cd gcorr_loc(j-1)=0.0d0
5736 cd gcorr_loc(k-1)=0.0d0
5738 cd write (iout,*)'Contacts have occurred for peptide groups',
5739 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5740 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5741 if (j.lt.nres-1) then
5748 if (l.lt.nres-1) then
5756 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5757 ggg1(ll)=eel4*g_contij(ll,1)
5758 ggg2(ll)=eel4*g_contij(ll,2)
5759 ghalf=0.5d0*ggg1(ll)
5761 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5762 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5763 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5764 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5765 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5766 ghalf=0.5d0*ggg2(ll)
5768 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5769 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5770 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5771 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5776 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5777 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5782 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5783 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5789 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5794 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5798 cd write (2,*) iii,gcorr_loc(iii)
5802 cd write (2,*) 'ekont',ekont
5803 cd write (iout,*) 'eello4',ekont*eel4
5806 C---------------------------------------------------------------------------
5807 double precision function eello5(i,j,k,l,jj,kk)
5808 implicit real*8 (a-h,o-z)
5809 include 'DIMENSIONS'
5810 include 'sizesclu.dat'
5811 include 'COMMON.IOUNITS'
5812 include 'COMMON.CHAIN'
5813 include 'COMMON.DERIV'
5814 include 'COMMON.INTERACT'
5815 include 'COMMON.CONTACTS'
5816 include 'COMMON.TORSION'
5817 include 'COMMON.VAR'
5818 include 'COMMON.GEO'
5819 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5820 double precision ggg1(3),ggg2(3)
5821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5826 C /l\ / \ \ / \ / \ / C
5827 C / \ / \ \ / \ / \ / C
5828 C j| o |l1 | o | o| o | | o |o C
5829 C \ |/k\| |/ \| / |/ \| |/ \| C
5830 C \i/ \ / \ / / \ / \ C
5832 C (I) (II) (III) (IV) C
5834 C eello5_1 eello5_2 eello5_3 eello5_4 C
5836 C Antiparallel chains C
5839 C /j\ / \ \ / \ / \ / C
5840 C / \ / \ \ / \ / \ / C
5841 C j1| o |l | o | o| o | | o |o C
5842 C \ |/k\| |/ \| / |/ \| |/ \| C
5843 C \i/ \ / \ / / \ / \ C
5845 C (I) (II) (III) (IV) C
5847 C eello5_1 eello5_2 eello5_3 eello5_4 C
5849 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5851 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5852 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5857 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5859 itk=itortyp(itype(k))
5860 itl=itortyp(itype(l))
5861 itj=itortyp(itype(j))
5866 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5867 cd & eel5_3_num,eel5_4_num)
5871 derx(lll,kkk,iii)=0.0d0
5875 cd eij=facont_hb(jj,i)
5876 cd ekl=facont_hb(kk,k)
5878 cd write (iout,*)'Contacts have occurred for peptide groups',
5879 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5881 C Contribution from the graph I.
5882 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5883 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5884 call transpose2(EUg(1,1,k),auxmat(1,1))
5885 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5886 vv(1)=pizda(1,1)-pizda(2,2)
5887 vv(2)=pizda(1,2)+pizda(2,1)
5888 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5889 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5891 C Explicit gradient in virtual-dihedral angles.
5892 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5893 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5894 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5895 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5896 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5897 vv(1)=pizda(1,1)-pizda(2,2)
5898 vv(2)=pizda(1,2)+pizda(2,1)
5899 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5900 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5901 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5902 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5903 vv(1)=pizda(1,1)-pizda(2,2)
5904 vv(2)=pizda(1,2)+pizda(2,1)
5906 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5907 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5908 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5910 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5911 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5912 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5914 C Cartesian gradient
5918 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5920 vv(1)=pizda(1,1)-pizda(2,2)
5921 vv(2)=pizda(1,2)+pizda(2,1)
5922 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5923 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5931 C Contribution from graph II
5932 call transpose2(EE(1,1,itk),auxmat(1,1))
5933 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)+pizda(2,2)
5935 vv(2)=pizda(2,1)-pizda(1,2)
5936 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5937 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5939 C Explicit gradient in virtual-dihedral angles.
5940 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5941 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5942 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5943 vv(1)=pizda(1,1)+pizda(2,2)
5944 vv(2)=pizda(2,1)-pizda(1,2)
5946 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5947 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5948 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5950 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5951 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5952 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5954 C Cartesian gradient
5958 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5960 vv(1)=pizda(1,1)+pizda(2,2)
5961 vv(2)=pizda(2,1)-pizda(1,2)
5962 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5963 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5964 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5973 C Parallel orientation
5974 C Contribution from graph III
5975 call transpose2(EUg(1,1,l),auxmat(1,1))
5976 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5977 vv(1)=pizda(1,1)-pizda(2,2)
5978 vv(2)=pizda(1,2)+pizda(2,1)
5979 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5980 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5982 C Explicit gradient in virtual-dihedral angles.
5983 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5984 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5985 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5986 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5987 vv(1)=pizda(1,1)-pizda(2,2)
5988 vv(2)=pizda(1,2)+pizda(2,1)
5989 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5990 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5991 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5992 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5993 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5994 vv(1)=pizda(1,1)-pizda(2,2)
5995 vv(2)=pizda(1,2)+pizda(2,1)
5996 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5997 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5998 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5999 C Cartesian gradient
6003 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6005 vv(1)=pizda(1,1)-pizda(2,2)
6006 vv(2)=pizda(1,2)+pizda(2,1)
6007 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6008 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6009 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6015 C Contribution from graph IV
6017 call transpose2(EE(1,1,itl),auxmat(1,1))
6018 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6019 vv(1)=pizda(1,1)+pizda(2,2)
6020 vv(2)=pizda(2,1)-pizda(1,2)
6021 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6022 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6024 C Explicit gradient in virtual-dihedral angles.
6025 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6026 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6027 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6028 vv(1)=pizda(1,1)+pizda(2,2)
6029 vv(2)=pizda(2,1)-pizda(1,2)
6030 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6031 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6032 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6033 C Cartesian gradient
6037 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6039 vv(1)=pizda(1,1)+pizda(2,2)
6040 vv(2)=pizda(2,1)-pizda(1,2)
6041 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6042 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6043 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6049 C Antiparallel orientation
6050 C Contribution from graph III
6052 call transpose2(EUg(1,1,j),auxmat(1,1))
6053 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6054 vv(1)=pizda(1,1)-pizda(2,2)
6055 vv(2)=pizda(1,2)+pizda(2,1)
6056 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6057 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6059 C Explicit gradient in virtual-dihedral angles.
6060 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6061 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6062 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6063 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6064 vv(1)=pizda(1,1)-pizda(2,2)
6065 vv(2)=pizda(1,2)+pizda(2,1)
6066 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6067 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6068 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6069 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6070 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6071 vv(1)=pizda(1,1)-pizda(2,2)
6072 vv(2)=pizda(1,2)+pizda(2,1)
6073 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6074 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6075 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6076 C Cartesian gradient
6080 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6082 vv(1)=pizda(1,1)-pizda(2,2)
6083 vv(2)=pizda(1,2)+pizda(2,1)
6084 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6085 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6086 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6092 C Contribution from graph IV
6094 call transpose2(EE(1,1,itj),auxmat(1,1))
6095 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6096 vv(1)=pizda(1,1)+pizda(2,2)
6097 vv(2)=pizda(2,1)-pizda(1,2)
6098 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6099 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6101 C Explicit gradient in virtual-dihedral angles.
6102 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6103 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6104 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6105 vv(1)=pizda(1,1)+pizda(2,2)
6106 vv(2)=pizda(2,1)-pizda(1,2)
6107 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6108 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6109 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6110 C Cartesian gradient
6114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6116 vv(1)=pizda(1,1)+pizda(2,2)
6117 vv(2)=pizda(2,1)-pizda(1,2)
6118 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6119 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6120 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6127 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6128 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6129 cd write (2,*) 'ijkl',i,j,k,l
6130 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6131 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6133 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6134 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6135 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6136 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6138 if (j.lt.nres-1) then
6145 if (l.lt.nres-1) then
6155 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6157 ggg1(ll)=eel5*g_contij(ll,1)
6158 ggg2(ll)=eel5*g_contij(ll,2)
6159 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6160 ghalf=0.5d0*ggg1(ll)
6162 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6163 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6164 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6165 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6166 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6167 ghalf=0.5d0*ggg2(ll)
6169 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6170 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6171 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6172 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6177 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6178 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6183 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6184 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6190 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6195 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6199 cd write (2,*) iii,g_corr5_loc(iii)
6203 cd write (2,*) 'ekont',ekont
6204 cd write (iout,*) 'eello5',ekont*eel5
6207 c--------------------------------------------------------------------------
6208 double precision function eello6(i,j,k,l,jj,kk)
6209 implicit real*8 (a-h,o-z)
6210 include 'DIMENSIONS'
6211 include 'sizesclu.dat'
6212 include 'COMMON.IOUNITS'
6213 include 'COMMON.CHAIN'
6214 include 'COMMON.DERIV'
6215 include 'COMMON.INTERACT'
6216 include 'COMMON.CONTACTS'
6217 include 'COMMON.TORSION'
6218 include 'COMMON.VAR'
6219 include 'COMMON.GEO'
6220 include 'COMMON.FFIELD'
6221 double precision ggg1(3),ggg2(3)
6222 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6227 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6235 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6236 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6240 derx(lll,kkk,iii)=0.0d0
6244 cd eij=facont_hb(jj,i)
6245 cd ekl=facont_hb(kk,k)
6251 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6252 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6253 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6254 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6255 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6256 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6258 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6259 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6260 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6261 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6262 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6263 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6267 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6269 C If turn contributions are considered, they will be handled separately.
6270 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6271 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6272 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6273 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6274 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6275 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6276 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6279 if (j.lt.nres-1) then
6286 if (l.lt.nres-1) then
6294 ggg1(ll)=eel6*g_contij(ll,1)
6295 ggg2(ll)=eel6*g_contij(ll,2)
6296 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6297 ghalf=0.5d0*ggg1(ll)
6299 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6300 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6301 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6302 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6303 ghalf=0.5d0*ggg2(ll)
6304 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6306 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6307 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6308 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6309 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6314 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6315 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6320 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6321 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6327 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6332 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6336 cd write (2,*) iii,g_corr6_loc(iii)
6340 cd write (2,*) 'ekont',ekont
6341 cd write (iout,*) 'eello6',ekont*eel6
6344 c--------------------------------------------------------------------------
6345 double precision function eello6_graph1(i,j,k,l,imat,swap)
6346 implicit real*8 (a-h,o-z)
6347 include 'DIMENSIONS'
6348 include 'sizesclu.dat'
6349 include 'COMMON.IOUNITS'
6350 include 'COMMON.CHAIN'
6351 include 'COMMON.DERIV'
6352 include 'COMMON.INTERACT'
6353 include 'COMMON.CONTACTS'
6354 include 'COMMON.TORSION'
6355 include 'COMMON.VAR'
6356 include 'COMMON.GEO'
6357 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6363 C Parallel Antiparallel C
6369 C \ j|/k\| / \ |/k\|l / C
6374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6375 itk=itortyp(itype(k))
6376 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6377 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6378 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6379 call transpose2(EUgC(1,1,k),auxmat(1,1))
6380 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6381 vv1(1)=pizda1(1,1)-pizda1(2,2)
6382 vv1(2)=pizda1(1,2)+pizda1(2,1)
6383 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6384 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6385 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6386 s5=scalar2(vv(1),Dtobr2(1,i))
6387 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6388 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6389 if (.not. calc_grad) return
6390 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6391 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6392 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6393 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6394 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6395 & +scalar2(vv(1),Dtobr2der(1,i)))
6396 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6397 vv1(1)=pizda1(1,1)-pizda1(2,2)
6398 vv1(2)=pizda1(1,2)+pizda1(2,1)
6399 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6400 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6402 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6403 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6404 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6405 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6406 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6408 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6409 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6410 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6411 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6412 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6414 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6415 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6416 vv1(1)=pizda1(1,1)-pizda1(2,2)
6417 vv1(2)=pizda1(1,2)+pizda1(2,1)
6418 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6419 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6420 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6421 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6430 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6431 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6432 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6433 call transpose2(EUgC(1,1,k),auxmat(1,1))
6434 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6436 vv1(1)=pizda1(1,1)-pizda1(2,2)
6437 vv1(2)=pizda1(1,2)+pizda1(2,1)
6438 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6439 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6440 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6441 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6442 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6443 s5=scalar2(vv(1),Dtobr2(1,i))
6444 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6450 c----------------------------------------------------------------------------
6451 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6452 implicit real*8 (a-h,o-z)
6453 include 'DIMENSIONS'
6454 include 'sizesclu.dat'
6455 include 'COMMON.IOUNITS'
6456 include 'COMMON.CHAIN'
6457 include 'COMMON.DERIV'
6458 include 'COMMON.INTERACT'
6459 include 'COMMON.CONTACTS'
6460 include 'COMMON.TORSION'
6461 include 'COMMON.VAR'
6462 include 'COMMON.GEO'
6464 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6465 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6468 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6470 C Parallel Antiparallel C
6476 C \ j|/k\| \ |/k\|l C
6481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6482 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6483 C AL 7/4/01 s1 would occur in the sixth-order moment,
6484 C but not in a cluster cumulant
6486 s1=dip(1,jj,i)*dip(1,kk,k)
6488 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6489 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6490 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6491 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6492 call transpose2(EUg(1,1,k),auxmat(1,1))
6493 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6494 vv(1)=pizda(1,1)-pizda(2,2)
6495 vv(2)=pizda(1,2)+pizda(2,1)
6496 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6497 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6499 eello6_graph2=-(s1+s2+s3+s4)
6501 eello6_graph2=-(s2+s3+s4)
6504 if (.not. calc_grad) return
6505 C Derivatives in gamma(i-1)
6508 s1=dipderg(1,jj,i)*dip(1,kk,k)
6510 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6511 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6512 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6513 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6515 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6517 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6519 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6521 C Derivatives in gamma(k-1)
6523 s1=dip(1,jj,i)*dipderg(1,kk,k)
6525 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6526 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6527 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6528 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6529 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6530 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6531 vv(1)=pizda(1,1)-pizda(2,2)
6532 vv(2)=pizda(1,2)+pizda(2,1)
6533 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6537 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6539 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6540 C Derivatives in gamma(j-1) or gamma(l-1)
6543 s1=dipderg(3,jj,i)*dip(1,kk,k)
6545 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6546 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6547 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6548 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6549 vv(1)=pizda(1,1)-pizda(2,2)
6550 vv(2)=pizda(1,2)+pizda(2,1)
6551 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6554 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6556 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6559 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6560 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6562 C Derivatives in gamma(l-1) or gamma(j-1)
6565 s1=dip(1,jj,i)*dipderg(3,kk,k)
6567 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6568 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6569 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6570 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6571 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6572 vv(1)=pizda(1,1)-pizda(2,2)
6573 vv(2)=pizda(1,2)+pizda(2,1)
6574 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6577 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6579 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6582 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6583 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6585 C Cartesian derivatives.
6587 write (2,*) 'In eello6_graph2'
6589 write (2,*) 'iii=',iii
6591 write (2,*) 'kkk=',kkk
6593 write (2,'(3(2f10.5),5x)')
6594 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6604 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6606 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6609 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6611 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6612 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6614 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6615 call transpose2(EUg(1,1,k),auxmat(1,1))
6616 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6618 vv(1)=pizda(1,1)-pizda(2,2)
6619 vv(2)=pizda(1,2)+pizda(2,1)
6620 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6621 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6628 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6637 c----------------------------------------------------------------------------
6638 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6639 implicit real*8 (a-h,o-z)
6640 include 'DIMENSIONS'
6641 include 'sizesclu.dat'
6642 include 'COMMON.IOUNITS'
6643 include 'COMMON.CHAIN'
6644 include 'COMMON.DERIV'
6645 include 'COMMON.INTERACT'
6646 include 'COMMON.CONTACTS'
6647 include 'COMMON.TORSION'
6648 include 'COMMON.VAR'
6649 include 'COMMON.GEO'
6650 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6652 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6654 C Parallel Antiparallel C
6660 C j|/k\| / |/k\|l / C
6665 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6667 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6668 C energy moment and not to the cluster cumulant.
6669 iti=itortyp(itype(i))
6670 c if (j.lt.nres-1) then
6671 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6672 itj1=itortyp(itype(j+1))
6676 itk=itortyp(itype(k))
6677 itk1=itortyp(itype(k+1))
6678 c if (l.lt.nres-1) then
6679 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6680 itl1=itortyp(itype(l+1))
6685 s1=dip(4,jj,i)*dip(4,kk,k)
6687 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6688 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6689 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6690 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6691 call transpose2(EE(1,1,itk),auxmat(1,1))
6692 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6693 vv(1)=pizda(1,1)+pizda(2,2)
6694 vv(2)=pizda(2,1)-pizda(1,2)
6695 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6696 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6698 eello6_graph3=-(s1+s2+s3+s4)
6700 eello6_graph3=-(s2+s3+s4)
6703 if (.not. calc_grad) return
6704 C Derivatives in gamma(k-1)
6705 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6706 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6707 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6708 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6709 C Derivatives in gamma(l-1)
6710 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6711 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6712 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6713 vv(1)=pizda(1,1)+pizda(2,2)
6714 vv(2)=pizda(2,1)-pizda(1,2)
6715 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6716 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6717 C Cartesian derivatives.
6723 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6725 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6728 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6730 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6731 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6733 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6734 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6736 vv(1)=pizda(1,1)+pizda(2,2)
6737 vv(2)=pizda(2,1)-pizda(1,2)
6738 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6742 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6745 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6747 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6749 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6755 c----------------------------------------------------------------------------
6756 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6757 implicit real*8 (a-h,o-z)
6758 include 'DIMENSIONS'
6759 include 'sizesclu.dat'
6760 include 'COMMON.IOUNITS'
6761 include 'COMMON.CHAIN'
6762 include 'COMMON.DERIV'
6763 include 'COMMON.INTERACT'
6764 include 'COMMON.CONTACTS'
6765 include 'COMMON.TORSION'
6766 include 'COMMON.VAR'
6767 include 'COMMON.GEO'
6768 include 'COMMON.FFIELD'
6769 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6770 & auxvec1(2),auxmat1(2,2)
6772 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6774 C Parallel Antiparallel C
6780 C \ j|/k\| \ |/k\|l C
6785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6787 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6788 C energy moment and not to the cluster cumulant.
6789 cd write (2,*) 'eello_graph4: wturn6',wturn6
6790 iti=itortyp(itype(i))
6791 itj=itortyp(itype(j))
6792 c if (j.lt.nres-1) then
6793 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6794 itj1=itortyp(itype(j+1))
6798 itk=itortyp(itype(k))
6799 c if (k.lt.nres-1) then
6800 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6801 itk1=itortyp(itype(k+1))
6805 itl=itortyp(itype(l))
6806 if (l.lt.nres-1) then
6807 itl1=itortyp(itype(l+1))
6811 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6812 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6813 cd & ' itl',itl,' itl1',itl1
6816 s1=dip(3,jj,i)*dip(3,kk,k)
6818 s1=dip(2,jj,j)*dip(2,kk,l)
6821 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6822 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6824 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6825 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6827 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6828 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6830 call transpose2(EUg(1,1,k),auxmat(1,1))
6831 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6832 vv(1)=pizda(1,1)-pizda(2,2)
6833 vv(2)=pizda(2,1)+pizda(1,2)
6834 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6835 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6837 eello6_graph4=-(s1+s2+s3+s4)
6839 eello6_graph4=-(s2+s3+s4)
6841 if (.not. calc_grad) return
6842 C Derivatives in gamma(i-1)
6846 s1=dipderg(2,jj,i)*dip(3,kk,k)
6848 s1=dipderg(4,jj,j)*dip(2,kk,l)
6851 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6853 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6854 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6856 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6857 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6859 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6860 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6861 cd write (2,*) 'turn6 derivatives'
6863 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6865 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6869 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6871 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6875 C Derivatives in gamma(k-1)
6878 s1=dip(3,jj,i)*dipderg(2,kk,k)
6880 s1=dip(2,jj,j)*dipderg(4,kk,l)
6883 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6884 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6886 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6887 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6889 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6890 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6892 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6893 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6894 vv(1)=pizda(1,1)-pizda(2,2)
6895 vv(2)=pizda(2,1)+pizda(1,2)
6896 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6897 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6899 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6901 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6905 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6907 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6910 C Derivatives in gamma(j-1) or gamma(l-1)
6911 if (l.eq.j+1 .and. l.gt.1) then
6912 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6913 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6914 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6915 vv(1)=pizda(1,1)-pizda(2,2)
6916 vv(2)=pizda(2,1)+pizda(1,2)
6917 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6918 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6919 else if (j.gt.1) then
6920 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6921 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6922 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6923 vv(1)=pizda(1,1)-pizda(2,2)
6924 vv(2)=pizda(2,1)+pizda(1,2)
6925 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6926 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6927 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6929 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6932 C Cartesian derivatives.
6939 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6941 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6945 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6947 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6951 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6953 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6955 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6956 & b1(1,itj1),auxvec(1))
6957 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6959 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6960 & b1(1,itl1),auxvec(1))
6961 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6963 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6965 vv(1)=pizda(1,1)-pizda(2,2)
6966 vv(2)=pizda(2,1)+pizda(1,2)
6967 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6969 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6971 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6974 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6977 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6980 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6982 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6984 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6988 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6990 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6993 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6995 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7003 c----------------------------------------------------------------------------
7004 double precision function eello_turn6(i,jj,kk)
7005 implicit real*8 (a-h,o-z)
7006 include 'DIMENSIONS'
7007 include 'sizesclu.dat'
7008 include 'COMMON.IOUNITS'
7009 include 'COMMON.CHAIN'
7010 include 'COMMON.DERIV'
7011 include 'COMMON.INTERACT'
7012 include 'COMMON.CONTACTS'
7013 include 'COMMON.TORSION'
7014 include 'COMMON.VAR'
7015 include 'COMMON.GEO'
7016 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7017 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7019 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7020 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7021 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7022 C the respective energy moment and not to the cluster cumulant.
7027 iti=itortyp(itype(i))
7028 itk=itortyp(itype(k))
7029 itk1=itortyp(itype(k+1))
7030 itl=itortyp(itype(l))
7031 itj=itortyp(itype(j))
7032 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7033 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7034 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7039 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7041 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7045 derx_turn(lll,kkk,iii)=0.0d0
7052 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7054 cd write (2,*) 'eello6_5',eello6_5
7056 call transpose2(AEA(1,1,1),auxmat(1,1))
7057 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7058 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7059 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7063 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7064 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7065 s2 = scalar2(b1(1,itk),vtemp1(1))
7067 call transpose2(AEA(1,1,2),atemp(1,1))
7068 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7069 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7070 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7074 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7075 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7076 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7078 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7079 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7080 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7081 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7082 ss13 = scalar2(b1(1,itk),vtemp4(1))
7083 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7087 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7093 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7095 C Derivatives in gamma(i+2)
7097 call transpose2(AEA(1,1,1),auxmatd(1,1))
7098 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7099 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7100 call transpose2(AEAderg(1,1,2),atempd(1,1))
7101 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7102 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7106 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7107 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7108 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7114 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7115 C Derivatives in gamma(i+3)
7117 call transpose2(AEA(1,1,1),auxmatd(1,1))
7118 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7119 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7120 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7124 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7125 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7126 s2d = scalar2(b1(1,itk),vtemp1d(1))
7128 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7129 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7131 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7133 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7134 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7135 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7145 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7146 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7148 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7149 & -0.5d0*ekont*(s2d+s12d)
7151 C Derivatives in gamma(i+4)
7152 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7153 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7154 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7156 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7157 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7158 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7168 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7170 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7172 C Derivatives in gamma(i+5)
7174 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7175 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7176 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7180 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7181 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7182 s2d = scalar2(b1(1,itk),vtemp1d(1))
7184 call transpose2(AEA(1,1,2),atempd(1,1))
7185 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7186 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7190 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7191 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7193 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7194 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7195 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7205 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7206 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7208 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7209 & -0.5d0*ekont*(s2d+s12d)
7211 C Cartesian derivatives
7216 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7217 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7218 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7222 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7223 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7225 s2d = scalar2(b1(1,itk),vtemp1d(1))
7227 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7228 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7229 s8d = -(atempd(1,1)+atempd(2,2))*
7230 & scalar2(cc(1,1,itl),vtemp2(1))
7234 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7236 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7237 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7244 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7247 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7251 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7252 & - 0.5d0*(s8d+s12d)
7254 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7263 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7265 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7266 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7267 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7268 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7269 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7271 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7272 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7273 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7277 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7278 cd & 16*eel_turn6_num
7280 if (j.lt.nres-1) then
7287 if (l.lt.nres-1) then
7295 ggg1(ll)=eel_turn6*g_contij(ll,1)
7296 ggg2(ll)=eel_turn6*g_contij(ll,2)
7297 ghalf=0.5d0*ggg1(ll)
7299 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7300 & +ekont*derx_turn(ll,2,1)
7301 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7302 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7303 & +ekont*derx_turn(ll,4,1)
7304 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7305 ghalf=0.5d0*ggg2(ll)
7307 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7308 & +ekont*derx_turn(ll,2,2)
7309 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7310 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7311 & +ekont*derx_turn(ll,4,2)
7312 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7317 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7322 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7328 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7333 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7337 cd write (2,*) iii,g_corr6_loc(iii)
7340 eello_turn6=ekont*eel_turn6
7341 cd write (2,*) 'ekont',ekont
7342 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7345 crc-------------------------------------------------
7346 SUBROUTINE MATVEC2(A1,V1,V2)
7347 implicit real*8 (a-h,o-z)
7348 include 'DIMENSIONS'
7349 DIMENSION A1(2,2),V1(2),V2(2)
7353 c 3 VI=VI+A1(I,K)*V1(K)
7357 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7358 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7363 C---------------------------------------
7364 SUBROUTINE MATMAT2(A1,A2,A3)
7365 implicit real*8 (a-h,o-z)
7366 include 'DIMENSIONS'
7367 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7368 c DIMENSION AI3(2,2)
7372 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7378 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7379 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7380 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7381 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7389 c-------------------------------------------------------------------------
7390 double precision function scalar2(u,v)
7392 double precision u(2),v(2)
7395 scalar2=u(1)*v(1)+u(2)*v(2)
7399 C-----------------------------------------------------------------------------
7401 subroutine transpose2(a,at)
7403 double precision a(2,2),at(2,2)
7410 c--------------------------------------------------------------------------
7411 subroutine transpose(n,a,at)
7414 double precision a(n,n),at(n,n)
7422 C---------------------------------------------------------------------------
7423 subroutine prodmat3(a1,a2,kk,transp,prod)
7426 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7428 crc double precision auxmat(2,2),prod_(2,2)
7431 crc call transpose2(kk(1,1),auxmat(1,1))
7432 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7433 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7435 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7436 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7437 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7438 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7439 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7440 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7441 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7442 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7445 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7446 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7448 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7449 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7450 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7451 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7452 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7453 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7454 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7455 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7458 c call transpose2(a2(1,1),a2t(1,1))
7461 crc print *,((prod_(i,j),i=1,2),j=1,2)
7462 crc print *,((prod(i,j),i=1,2),j=1,2)
7466 C-----------------------------------------------------------------------------
7467 double precision function scalar(u,v)
7469 double precision u(3),v(3)