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
127 c call enerprint(energia(0),frac)
129 energia(2)=evdw2-evdw2_14
146 energia(8)=eello_turn3
147 energia(9)=eello_turn4
156 energia(20)=edihcnstr
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 & +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
367 if (itypi.eq.ntyp1) cycle
368 itypi1=iabs(itype(i+1))
375 C Calculate SC interaction energy.
378 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
379 cd & 'iend=',iend(i,iint)
380 do j=istart(i,iint),iend(i,iint)
382 if (itypj.eq.ntyp1) cycle
386 C Change 12/1/95 to calculate four-body interactions
387 rij=xj*xj+yj*yj+zj*zj
389 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
390 eps0ij=eps(itypi,itypj)
392 e1=fac*fac*aa(itypi,itypj)
393 e2=fac*bb(itypi,itypj)
395 ij=icant(itypi,itypj)
396 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
397 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
398 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
399 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
400 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
401 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
402 if (bb(itypi,itypj).gt.0.0d0) then
409 C Calculate the components of the gradient in DC and X
411 fac=-rrij*(e1+evdwij)
416 gvdwx(k,i)=gvdwx(k,i)-gg(k)
417 gvdwx(k,j)=gvdwx(k,j)+gg(k)
421 gvdwc(l,k)=gvdwc(l,k)+gg(l)
426 C 12/1/95, revised on 5/20/97
428 C Calculate the contact function. The ith column of the array JCONT will
429 C contain the numbers of atoms that make contacts with the atom I (of numbers
430 C greater than I). The arrays FACONT and GACONT will contain the values of
431 C the contact function and its derivative.
433 C Uncomment next line, if the correlation interactions include EVDW explicitly.
434 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
435 C Uncomment next line, if the correlation interactions are contact function only
436 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
438 sigij=sigma(itypi,itypj)
439 r0ij=rs0(itypi,itypj)
441 C Check whether the SC's are not too far to make a contact.
444 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
445 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
447 if (fcont.gt.0.0D0) then
448 C If the SC-SC distance if close to sigma, apply spline.
449 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
450 cAdam & fcont1,fprimcont1)
451 cAdam fcont1=1.0d0-fcont1
452 cAdam if (fcont1.gt.0.0d0) then
453 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
454 cAdam fcont=fcont*fcont1
456 C Uncomment following 4 lines to have the geometric average of the epsilon0's
457 cga eps0ij=1.0d0/dsqrt(eps0ij)
459 cga gg(k)=gg(k)*eps0ij
461 cga eps0ij=-evdwij*eps0ij
462 C Uncomment for AL's type of SC correlation interactions.
464 num_conti=num_conti+1
466 facont(num_conti,i)=fcont*eps0ij
467 fprimcont=eps0ij*fprimcont/rij
469 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
470 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
471 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
472 C Uncomment following 3 lines for Skolnick's type of SC correlation.
473 gacont(1,num_conti,i)=-fprimcont*xj
474 gacont(2,num_conti,i)=-fprimcont*yj
475 gacont(3,num_conti,i)=-fprimcont*zj
476 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
477 cd write (iout,'(2i3,3f10.5)')
478 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
484 num_cont(i)=num_conti
489 gvdwc(j,i)=expon*gvdwc(j,i)
490 gvdwx(j,i)=expon*gvdwx(j,i)
494 C******************************************************************************
498 C To save time, the factor of EXPON has been extracted from ALL components
499 C of GVDWC and GRADX. Remember to multiply them by this factor before further
502 C******************************************************************************
505 C-----------------------------------------------------------------------------
506 subroutine eljk(evdw,evdw_t)
508 C This subroutine calculates the interaction energy of nonbonded side chains
509 C assuming the LJK potential of interaction.
511 implicit real*8 (a-h,o-z)
513 include 'sizesclu.dat'
514 include "DIMENSIONS.COMPAR"
517 include 'COMMON.LOCAL'
518 include 'COMMON.CHAIN'
519 include 'COMMON.DERIV'
520 include 'COMMON.INTERACT'
521 include 'COMMON.IOUNITS'
522 include 'COMMON.NAMES'
527 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
532 if (itypi.eq.ntyp1) cycle
533 itypi1=iabs(itype(i+1))
538 C Calculate SC interaction energy.
541 do j=istart(i,iint),iend(i,iint)
543 if (itypj.eq.ntyp1) cycle
547 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
549 e_augm=augm(itypi,itypj)*fac_augm
552 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
553 fac=r_shift_inv**expon
554 e1=fac*fac*aa(itypi,itypj)
555 e2=fac*bb(itypi,itypj)
557 ij=icant(itypi,itypj)
558 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
559 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
560 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
561 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
562 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
563 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
564 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
565 if (bb(itypi,itypj).gt.0.0d0) then
572 C Calculate the components of the gradient in DC and X
574 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
579 gvdwx(k,i)=gvdwx(k,i)-gg(k)
580 gvdwx(k,j)=gvdwx(k,j)+gg(k)
584 gvdwc(l,k)=gvdwc(l,k)+gg(l)
594 gvdwc(j,i)=expon*gvdwc(j,i)
595 gvdwx(j,i)=expon*gvdwx(j,i)
601 C-----------------------------------------------------------------------------
602 subroutine ebp(evdw,evdw_t)
604 C This subroutine calculates the interaction energy of nonbonded side chains
605 C assuming the Berne-Pechukas potential of interaction.
607 implicit real*8 (a-h,o-z)
609 include 'sizesclu.dat'
610 include "DIMENSIONS.COMPAR"
613 include 'COMMON.LOCAL'
614 include 'COMMON.CHAIN'
615 include 'COMMON.DERIV'
616 include 'COMMON.NAMES'
617 include 'COMMON.INTERACT'
618 include 'COMMON.IOUNITS'
619 include 'COMMON.CALC'
621 c double precision rrsave(maxdim)
627 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
628 c if (icall.eq.0) then
636 if (itypi.eq.ntyp1) cycle
637 itypi1=iabs(itype(i+1))
641 dxi=dc_norm(1,nres+i)
642 dyi=dc_norm(2,nres+i)
643 dzi=dc_norm(3,nres+i)
644 dsci_inv=vbld_inv(i+nres)
646 C Calculate SC interaction energy.
649 do j=istart(i,iint),iend(i,iint)
652 if (itypj.eq.ntyp1) cycle
653 dscj_inv=vbld_inv(j+nres)
654 chi1=chi(itypi,itypj)
655 chi2=chi(itypj,itypi)
662 alf12=0.5D0*(alf1+alf2)
663 C For diagnostics only!!!
676 dxj=dc_norm(1,nres+j)
677 dyj=dc_norm(2,nres+j)
678 dzj=dc_norm(3,nres+j)
679 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
680 cd if (icall.eq.0) then
686 C Calculate the angle-dependent terms of energy & contributions to derivatives.
688 C Calculate whole angle-dependent part of epsilon and contributions
690 fac=(rrij*sigsq)**expon2
691 e1=fac*fac*aa(itypi,itypj)
692 e2=fac*bb(itypi,itypj)
693 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
694 eps2der=evdwij*eps3rt
695 eps3der=evdwij*eps2rt
696 evdwij=evdwij*eps2rt*eps3rt
697 ij=icant(itypi,itypj)
698 aux=eps1*eps2rt**2*eps3rt**2
699 if (bb(itypi,itypj).gt.0.0d0) then
706 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
707 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
708 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
709 cd & restyp(itypi),i,restyp(itypj),j,
710 cd & epsi,sigm,chi1,chi2,chip1,chip2,
711 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
712 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
715 C Calculate gradient components.
716 e1=e1*eps1*eps2rt**2*eps3rt**2
717 fac=-expon*(e1+evdwij)
720 C Calculate radial part of the gradient
724 C Calculate the angular part of the gradient and sum add the contributions
725 C to the appropriate components of the Cartesian gradient.
734 C-----------------------------------------------------------------------------
735 subroutine egb(evdw,evdw_t)
737 C This subroutine calculates the interaction energy of nonbonded side chains
738 C assuming the Gay-Berne potential of interaction.
740 implicit real*8 (a-h,o-z)
742 include 'sizesclu.dat'
743 include "DIMENSIONS.COMPAR"
746 include 'COMMON.LOCAL'
747 include 'COMMON.CHAIN'
748 include 'COMMON.DERIV'
749 include 'COMMON.NAMES'
750 include 'COMMON.INTERACT'
751 include 'COMMON.IOUNITS'
752 include 'COMMON.CALC'
757 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
761 c if (icall.gt.0) lprn=.true.
765 if (itypi.eq.ntyp1) cycle
766 itypi1=iabs(itype(i+1))
770 dxi=dc_norm(1,nres+i)
771 dyi=dc_norm(2,nres+i)
772 dzi=dc_norm(3,nres+i)
773 dsci_inv=vbld_inv(i+nres)
775 C Calculate SC interaction energy.
778 do j=istart(i,iint),iend(i,iint)
781 if (itypj.eq.ntyp1) cycle
782 dscj_inv=vbld_inv(j+nres)
783 sig0ij=sigma(itypi,itypj)
784 chi1=chi(itypi,itypj)
785 chi2=chi(itypj,itypi)
792 alf12=0.5D0*(alf1+alf2)
793 C For diagnostics only!!!
806 dxj=dc_norm(1,nres+j)
807 dyj=dc_norm(2,nres+j)
808 dzj=dc_norm(3,nres+j)
809 c write (iout,*) i,j,xj,yj,zj
810 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
812 C Calculate angle-dependent terms of energy and contributions to their
816 sig=sig0ij*dsqrt(sigsq)
817 rij_shift=1.0D0/rij-sig+sig0ij
818 C I hate to put IF's in the loops, but here don't have another choice!!!!
819 if (rij_shift.le.0.0D0) then
824 c---------------------------------------------------------------
825 rij_shift=1.0D0/rij_shift
827 e1=fac*fac*aa(itypi,itypj)
828 e2=fac*bb(itypi,itypj)
829 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
830 eps2der=evdwij*eps3rt
831 eps3der=evdwij*eps2rt
832 evdwij=evdwij*eps2rt*eps3rt
833 if (bb(itypi,itypj).gt.0) then
838 ij=icant(itypi,itypj)
839 aux=eps1*eps2rt**2*eps3rt**2
840 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
841 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
842 c & aux*e2/eps(itypi,itypj)
844 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
845 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
846 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
847 c & restyp(itypi),i,restyp(itypj),j,
848 c & epsi,sigm,chi1,chi2,chip1,chip2,
849 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
850 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
852 c write (iout,*) "pratial sum", evdw,evdw_t
855 C Calculate gradient components.
856 e1=e1*eps1*eps2rt**2*eps3rt**2
857 fac=-expon*(e1+evdwij)*rij_shift
860 C Calculate the radial part of the gradient
864 C Calculate angular part of the gradient.
872 C-----------------------------------------------------------------------------
873 subroutine egbv(evdw,evdw_t)
875 C This subroutine calculates the interaction energy of nonbonded side chains
876 C assuming the Gay-Berne-Vorobjev potential of interaction.
878 implicit real*8 (a-h,o-z)
880 include 'sizesclu.dat'
881 include "DIMENSIONS.COMPAR"
884 include 'COMMON.LOCAL'
885 include 'COMMON.CHAIN'
886 include 'COMMON.DERIV'
887 include 'COMMON.NAMES'
888 include 'COMMON.INTERACT'
889 include 'COMMON.IOUNITS'
890 include 'COMMON.CALC'
897 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
900 c if (icall.gt.0) lprn=.true.
904 if (itypi.eq.ntyp1) cycle
905 itypi1=iabs(itype(i+1))
909 dxi=dc_norm(1,nres+i)
910 dyi=dc_norm(2,nres+i)
911 dzi=dc_norm(3,nres+i)
912 dsci_inv=vbld_inv(i+nres)
914 C Calculate SC interaction energy.
917 do j=istart(i,iint),iend(i,iint)
920 if (itypj.eq.ntyp1) cycle
921 dscj_inv=vbld_inv(j+nres)
922 sig0ij=sigma(itypi,itypj)
924 chi1=chi(itypi,itypj)
925 chi2=chi(itypj,itypi)
932 alf12=0.5D0*(alf1+alf2)
933 C For diagnostics only!!!
946 dxj=dc_norm(1,nres+j)
947 dyj=dc_norm(2,nres+j)
948 dzj=dc_norm(3,nres+j)
949 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
951 C Calculate angle-dependent terms of energy and contributions to their
955 sig=sig0ij*dsqrt(sigsq)
956 rij_shift=1.0D0/rij-sig+r0ij
957 C I hate to put IF's in the loops, but here don't have another choice!!!!
958 if (rij_shift.le.0.0D0) then
963 c---------------------------------------------------------------
964 rij_shift=1.0D0/rij_shift
966 e1=fac*fac*aa(itypi,itypj)
967 e2=fac*bb(itypi,itypj)
968 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
969 eps2der=evdwij*eps3rt
970 eps3der=evdwij*eps2rt
972 e_augm=augm(itypi,itypj)*fac_augm
973 evdwij=evdwij*eps2rt*eps3rt
974 if (bb(itypi,itypj).gt.0.0d0) then
975 evdw=evdw+evdwij+e_augm
977 evdw_t=evdw_t+evdwij+e_augm
979 ij=icant(itypi,itypj)
980 aux=eps1*eps2rt**2*eps3rt**2
982 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
983 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
984 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
985 c & restyp(itypi),i,restyp(itypj),j,
986 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
987 c & chi1,chi2,chip1,chip2,
988 c & eps1,eps2rt**2,eps3rt**2,
989 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
993 C Calculate gradient components.
994 e1=e1*eps1*eps2rt**2*eps3rt**2
995 fac=-expon*(e1+evdwij)*rij_shift
997 fac=rij*fac-2*expon*rrij*e_augm
998 C Calculate the radial part of the gradient
1002 C Calculate angular part of the gradient.
1010 C-----------------------------------------------------------------------------
1011 subroutine sc_angular
1012 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1013 C om12. Called by ebp, egb, and egbv.
1015 include 'COMMON.CALC'
1019 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1020 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1021 om12=dxi*dxj+dyi*dyj+dzi*dzj
1023 C Calculate eps1(om12) and its derivative in om12
1024 faceps1=1.0D0-om12*chiom12
1025 faceps1_inv=1.0D0/faceps1
1026 eps1=dsqrt(faceps1_inv)
1027 C Following variable is eps1*deps1/dom12
1028 eps1_om12=faceps1_inv*chiom12
1029 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1034 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1035 sigsq=1.0D0-facsig*faceps1_inv
1036 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1037 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1038 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1039 C Calculate eps2 and its derivatives in om1, om2, and om12.
1042 chipom12=chip12*om12
1043 facp=1.0D0-om12*chipom12
1045 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1046 C Following variable is the square root of eps2
1047 eps2rt=1.0D0-facp1*facp_inv
1048 C Following three variables are the derivatives of the square root of eps
1049 C in om1, om2, and om12.
1050 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1051 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1052 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1053 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1054 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1055 C Calculate whole angle-dependent part of epsilon and contributions
1056 C to its derivatives
1059 C----------------------------------------------------------------------------
1061 implicit real*8 (a-h,o-z)
1062 include 'DIMENSIONS'
1063 include 'sizesclu.dat'
1064 include 'COMMON.CHAIN'
1065 include 'COMMON.DERIV'
1066 include 'COMMON.CALC'
1067 double precision dcosom1(3),dcosom2(3)
1068 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1069 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1070 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1071 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1073 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1074 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1077 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1080 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1081 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1082 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1083 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1084 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1085 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1088 C Calculate the components of the gradient in DC and X
1092 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1097 c------------------------------------------------------------------------------
1098 subroutine vec_and_deriv
1099 implicit real*8 (a-h,o-z)
1100 include 'DIMENSIONS'
1101 include 'sizesclu.dat'
1102 include 'COMMON.IOUNITS'
1103 include 'COMMON.GEO'
1104 include 'COMMON.VAR'
1105 include 'COMMON.LOCAL'
1106 include 'COMMON.CHAIN'
1107 include 'COMMON.VECTORS'
1108 include 'COMMON.DERIV'
1109 include 'COMMON.INTERACT'
1110 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1111 C Compute the local reference systems. For reference system (i), the
1112 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1113 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1115 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1116 if (i.eq.nres-1) then
1117 C Case of the last full residue
1118 C Compute the Z-axis
1119 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1120 costh=dcos(pi-theta(nres))
1121 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1126 C Compute the derivatives of uz
1128 uzder(2,1,1)=-dc_norm(3,i-1)
1129 uzder(3,1,1)= dc_norm(2,i-1)
1130 uzder(1,2,1)= dc_norm(3,i-1)
1132 uzder(3,2,1)=-dc_norm(1,i-1)
1133 uzder(1,3,1)=-dc_norm(2,i-1)
1134 uzder(2,3,1)= dc_norm(1,i-1)
1137 uzder(2,1,2)= dc_norm(3,i)
1138 uzder(3,1,2)=-dc_norm(2,i)
1139 uzder(1,2,2)=-dc_norm(3,i)
1141 uzder(3,2,2)= dc_norm(1,i)
1142 uzder(1,3,2)= dc_norm(2,i)
1143 uzder(2,3,2)=-dc_norm(1,i)
1146 C Compute the Y-axis
1149 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1152 C Compute the derivatives of uy
1155 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1156 & -dc_norm(k,i)*dc_norm(j,i-1)
1157 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1159 uyder(j,j,1)=uyder(j,j,1)-costh
1160 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1165 uygrad(l,k,j,i)=uyder(l,k,j)
1166 uzgrad(l,k,j,i)=uzder(l,k,j)
1170 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1171 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1172 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1173 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1177 C Compute the Z-axis
1178 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1179 costh=dcos(pi-theta(i+2))
1180 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1185 C Compute the derivatives of uz
1187 uzder(2,1,1)=-dc_norm(3,i+1)
1188 uzder(3,1,1)= dc_norm(2,i+1)
1189 uzder(1,2,1)= dc_norm(3,i+1)
1191 uzder(3,2,1)=-dc_norm(1,i+1)
1192 uzder(1,3,1)=-dc_norm(2,i+1)
1193 uzder(2,3,1)= dc_norm(1,i+1)
1196 uzder(2,1,2)= dc_norm(3,i)
1197 uzder(3,1,2)=-dc_norm(2,i)
1198 uzder(1,2,2)=-dc_norm(3,i)
1200 uzder(3,2,2)= dc_norm(1,i)
1201 uzder(1,3,2)= dc_norm(2,i)
1202 uzder(2,3,2)=-dc_norm(1,i)
1205 C Compute the Y-axis
1208 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1211 C Compute the derivatives of uy
1214 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1215 & -dc_norm(k,i)*dc_norm(j,i+1)
1216 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1218 uyder(j,j,1)=uyder(j,j,1)-costh
1219 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1224 uygrad(l,k,j,i)=uyder(l,k,j)
1225 uzgrad(l,k,j,i)=uzder(l,k,j)
1229 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1230 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1231 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1232 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1238 vbld_inv_temp(1)=vbld_inv(i+1)
1239 if (i.lt.nres-1) then
1240 vbld_inv_temp(2)=vbld_inv(i+2)
1242 vbld_inv_temp(2)=vbld_inv(i)
1247 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1248 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1256 C-----------------------------------------------------------------------------
1257 subroutine vec_and_deriv_test
1258 implicit real*8 (a-h,o-z)
1259 include 'DIMENSIONS'
1260 include 'sizesclu.dat'
1261 include 'COMMON.IOUNITS'
1262 include 'COMMON.GEO'
1263 include 'COMMON.VAR'
1264 include 'COMMON.LOCAL'
1265 include 'COMMON.CHAIN'
1266 include 'COMMON.VECTORS'
1267 dimension uyder(3,3,2),uzder(3,3,2)
1268 C Compute the local reference systems. For reference system (i), the
1269 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1270 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1272 if (i.eq.nres-1) then
1273 C Case of the last full residue
1274 C Compute the Z-axis
1275 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1276 costh=dcos(pi-theta(nres))
1277 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1278 c write (iout,*) 'fac',fac,
1279 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1280 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1284 C Compute the derivatives of uz
1286 uzder(2,1,1)=-dc_norm(3,i-1)
1287 uzder(3,1,1)= dc_norm(2,i-1)
1288 uzder(1,2,1)= dc_norm(3,i-1)
1290 uzder(3,2,1)=-dc_norm(1,i-1)
1291 uzder(1,3,1)=-dc_norm(2,i-1)
1292 uzder(2,3,1)= dc_norm(1,i-1)
1295 uzder(2,1,2)= dc_norm(3,i)
1296 uzder(3,1,2)=-dc_norm(2,i)
1297 uzder(1,2,2)=-dc_norm(3,i)
1299 uzder(3,2,2)= dc_norm(1,i)
1300 uzder(1,3,2)= dc_norm(2,i)
1301 uzder(2,3,2)=-dc_norm(1,i)
1303 C Compute the Y-axis
1305 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1308 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1309 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1310 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1312 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1315 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1316 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1319 c write (iout,*) 'facy',facy,
1320 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1321 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1323 uy(k,i)=facy*uy(k,i)
1325 C Compute the derivatives of uy
1328 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1329 & -dc_norm(k,i)*dc_norm(j,i-1)
1330 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1332 c uyder(j,j,1)=uyder(j,j,1)-costh
1333 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1334 uyder(j,j,1)=uyder(j,j,1)
1335 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1336 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1342 uygrad(l,k,j,i)=uyder(l,k,j)
1343 uzgrad(l,k,j,i)=uzder(l,k,j)
1347 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1348 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1349 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1350 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1353 C Compute the Z-axis
1354 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1355 costh=dcos(pi-theta(i+2))
1356 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1357 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1361 C Compute the derivatives of uz
1363 uzder(2,1,1)=-dc_norm(3,i+1)
1364 uzder(3,1,1)= dc_norm(2,i+1)
1365 uzder(1,2,1)= dc_norm(3,i+1)
1367 uzder(3,2,1)=-dc_norm(1,i+1)
1368 uzder(1,3,1)=-dc_norm(2,i+1)
1369 uzder(2,3,1)= dc_norm(1,i+1)
1372 uzder(2,1,2)= dc_norm(3,i)
1373 uzder(3,1,2)=-dc_norm(2,i)
1374 uzder(1,2,2)=-dc_norm(3,i)
1376 uzder(3,2,2)= dc_norm(1,i)
1377 uzder(1,3,2)= dc_norm(2,i)
1378 uzder(2,3,2)=-dc_norm(1,i)
1380 C Compute the Y-axis
1382 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1383 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1384 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1386 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1389 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1390 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1393 c write (iout,*) 'facy',facy,
1394 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1395 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1397 uy(k,i)=facy*uy(k,i)
1399 C Compute the derivatives of uy
1402 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1403 & -dc_norm(k,i)*dc_norm(j,i+1)
1404 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1406 c uyder(j,j,1)=uyder(j,j,1)-costh
1407 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1408 uyder(j,j,1)=uyder(j,j,1)
1409 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1410 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1416 uygrad(l,k,j,i)=uyder(l,k,j)
1417 uzgrad(l,k,j,i)=uzder(l,k,j)
1421 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1422 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1423 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1424 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1431 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1432 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1439 C-----------------------------------------------------------------------------
1440 subroutine check_vecgrad
1441 implicit real*8 (a-h,o-z)
1442 include 'DIMENSIONS'
1443 include 'sizesclu.dat'
1444 include 'COMMON.IOUNITS'
1445 include 'COMMON.GEO'
1446 include 'COMMON.VAR'
1447 include 'COMMON.LOCAL'
1448 include 'COMMON.CHAIN'
1449 include 'COMMON.VECTORS'
1450 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1451 dimension uyt(3,maxres),uzt(3,maxres)
1452 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1453 double precision delta /1.0d-7/
1456 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1457 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1458 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1459 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1460 cd & (dc_norm(if90,i),if90=1,3)
1461 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1462 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1463 cd write(iout,'(a)')
1469 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1470 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1483 cd write (iout,*) 'i=',i
1485 erij(k)=dc_norm(k,i)
1489 dc_norm(k,i)=erij(k)
1491 dc_norm(j,i)=dc_norm(j,i)+delta
1492 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1494 c dc_norm(k,i)=dc_norm(k,i)/fac
1496 c write (iout,*) (dc_norm(k,i),k=1,3)
1497 c write (iout,*) (erij(k),k=1,3)
1500 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1501 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1502 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1503 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1505 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1506 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1507 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1510 dc_norm(k,i)=erij(k)
1513 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1514 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1515 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1516 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1517 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1518 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1519 cd write (iout,'(a)')
1524 C--------------------------------------------------------------------------
1525 subroutine set_matrices
1526 implicit real*8 (a-h,o-z)
1527 include 'DIMENSIONS'
1528 include 'sizesclu.dat'
1529 include 'COMMON.IOUNITS'
1530 include 'COMMON.GEO'
1531 include 'COMMON.VAR'
1532 include 'COMMON.LOCAL'
1533 include 'COMMON.CHAIN'
1534 include 'COMMON.DERIV'
1535 include 'COMMON.INTERACT'
1536 include 'COMMON.CONTACTS'
1537 include 'COMMON.TORSION'
1538 include 'COMMON.VECTORS'
1539 include 'COMMON.FFIELD'
1540 double precision auxvec(2),auxmat(2,2)
1542 C Compute the virtual-bond-torsional-angle dependent quantities needed
1543 C to calculate the el-loc multibody terms of various order.
1546 if (i .lt. nres+1) then
1583 if (i .gt. 3 .and. i .lt. nres+1) then
1584 obrot_der(1,i-2)=-sin1
1585 obrot_der(2,i-2)= cos1
1586 Ugder(1,1,i-2)= sin1
1587 Ugder(1,2,i-2)=-cos1
1588 Ugder(2,1,i-2)=-cos1
1589 Ugder(2,2,i-2)=-sin1
1592 obrot2_der(1,i-2)=-dwasin2
1593 obrot2_der(2,i-2)= dwacos2
1594 Ug2der(1,1,i-2)= dwasin2
1595 Ug2der(1,2,i-2)=-dwacos2
1596 Ug2der(2,1,i-2)=-dwacos2
1597 Ug2der(2,2,i-2)=-dwasin2
1599 obrot_der(1,i-2)=0.0d0
1600 obrot_der(2,i-2)=0.0d0
1601 Ugder(1,1,i-2)=0.0d0
1602 Ugder(1,2,i-2)=0.0d0
1603 Ugder(2,1,i-2)=0.0d0
1604 Ugder(2,2,i-2)=0.0d0
1605 obrot2_der(1,i-2)=0.0d0
1606 obrot2_der(2,i-2)=0.0d0
1607 Ug2der(1,1,i-2)=0.0d0
1608 Ug2der(1,2,i-2)=0.0d0
1609 Ug2der(2,1,i-2)=0.0d0
1610 Ug2der(2,2,i-2)=0.0d0
1612 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1613 if (itype(i-2).le.ntyp) then
1614 iti = itortyp(itype(i-2))
1621 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1622 if (itype(i-1).le.ntyp) then
1623 iti1 = itortyp(itype(i-1))
1630 cd write (iout,*) '*******i',i,' iti1',iti
1631 cd write (iout,*) 'b1',b1(:,iti)
1632 cd write (iout,*) 'b2',b2(:,iti)
1633 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1634 c print *,"itilde1 i iti iti1",i,iti,iti1
1635 if (i .gt. iatel_s+2) then
1636 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1637 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1638 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1639 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1640 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1641 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1642 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1652 DtUg2(l,k,i-2)=0.0d0
1656 c print *,"itilde2 i iti iti1",i,iti,iti1
1657 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1658 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1659 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1660 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1661 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1662 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1663 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1664 c print *,"itilde3 i iti iti1",i,iti,iti1
1666 muder(k,i-2)=Ub2der(k,i-2)
1668 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1669 if (itype(i-1).le.ntyp) then
1670 iti1 = itortyp(itype(i-1))
1678 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1680 C Vectors and matrices dependent on a single virtual-bond dihedral.
1681 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1682 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1683 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1684 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1685 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1686 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1687 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1688 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1689 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1690 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1691 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1693 C Matrices dependent on two consecutive virtual-bond dihedrals.
1694 C The order of matrices is from left to right.
1696 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1697 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1698 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1699 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1700 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1701 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1702 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1703 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1706 cd iti = itortyp(itype(i))
1709 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1710 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1715 C--------------------------------------------------------------------------
1716 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1718 C This subroutine calculates the average interaction energy and its gradient
1719 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1720 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1721 C The potential depends both on the distance of peptide-group centers and on
1722 C the orientation of the CA-CA virtual bonds.
1724 implicit real*8 (a-h,o-z)
1725 include 'DIMENSIONS'
1726 include 'sizesclu.dat'
1727 include 'COMMON.CONTROL'
1728 include 'COMMON.IOUNITS'
1729 include 'COMMON.GEO'
1730 include 'COMMON.VAR'
1731 include 'COMMON.LOCAL'
1732 include 'COMMON.CHAIN'
1733 include 'COMMON.DERIV'
1734 include 'COMMON.INTERACT'
1735 include 'COMMON.CONTACTS'
1736 include 'COMMON.TORSION'
1737 include 'COMMON.VECTORS'
1738 include 'COMMON.FFIELD'
1739 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1740 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1741 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1742 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1743 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1744 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1745 double precision scal_el /0.5d0/
1747 C 13-go grudnia roku pamietnego...
1748 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1749 & 0.0d0,1.0d0,0.0d0,
1750 & 0.0d0,0.0d0,1.0d0/
1751 cd write(iout,*) 'In EELEC'
1753 cd write(iout,*) 'Type',i
1754 cd write(iout,*) 'B1',B1(:,i)
1755 cd write(iout,*) 'B2',B2(:,i)
1756 cd write(iout,*) 'CC',CC(:,:,i)
1757 cd write(iout,*) 'DD',DD(:,:,i)
1758 cd write(iout,*) 'EE',EE(:,:,i)
1760 cd call check_vecgrad
1762 if (icheckgrad.eq.1) then
1764 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1766 dc_norm(k,i)=dc(k,i)*fac
1768 c write (iout,*) 'i',i,' fac',fac
1771 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1772 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1773 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1774 cd if (wel_loc.gt.0.0d0) then
1775 if (icheckgrad.eq.1) then
1776 call vec_and_deriv_test
1783 cd write (iout,*) 'i=',i
1785 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1788 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1789 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1802 cd print '(a)','Enter EELEC'
1803 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1805 gel_loc_loc(i)=0.0d0
1808 do i=iatel_s,iatel_e
1809 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1810 if (itel(i).eq.0) goto 1215
1814 dx_normi=dc_norm(1,i)
1815 dy_normi=dc_norm(2,i)
1816 dz_normi=dc_norm(3,i)
1817 xmedi=c(1,i)+0.5d0*dxi
1818 ymedi=c(2,i)+0.5d0*dyi
1819 zmedi=c(3,i)+0.5d0*dzi
1821 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1822 do j=ielstart(i),ielend(i)
1823 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1824 if (itel(j).eq.0) goto 1216
1828 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1829 aaa=app(iteli,itelj)
1830 bbb=bpp(iteli,itelj)
1831 C Diagnostics only!!!
1837 ael6i=ael6(iteli,itelj)
1838 ael3i=ael3(iteli,itelj)
1842 dx_normj=dc_norm(1,j)
1843 dy_normj=dc_norm(2,j)
1844 dz_normj=dc_norm(3,j)
1845 xj=c(1,j)+0.5D0*dxj-xmedi
1846 yj=c(2,j)+0.5D0*dyj-ymedi
1847 zj=c(3,j)+0.5D0*dzj-zmedi
1848 rij=xj*xj+yj*yj+zj*zj
1854 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1855 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1856 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1857 fac=cosa-3.0D0*cosb*cosg
1859 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1860 if (j.eq.i+2) ev1=scal_el*ev1
1865 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1868 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1869 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1870 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1873 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1874 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1875 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1876 cd & xmedi,ymedi,zmedi,xj,yj,zj
1878 C Calculate contributions to the Cartesian gradient.
1881 facvdw=-6*rrmij*(ev1+evdwij)
1882 facel=-3*rrmij*(el1+eesij)
1889 * Radial derivatives. First process both termini of the fragment (i,j)
1896 gelc(k,i)=gelc(k,i)+ghalf
1897 gelc(k,j)=gelc(k,j)+ghalf
1900 * Loop over residues i+1 thru j-1.
1904 gelc(l,k)=gelc(l,k)+ggg(l)
1912 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1913 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1916 * Loop over residues i+1 thru j-1.
1920 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1927 fac=-3*rrmij*(facvdw+facvdw+facel)
1933 * Radial derivatives. First process both termini of the fragment (i,j)
1940 gelc(k,i)=gelc(k,i)+ghalf
1941 gelc(k,j)=gelc(k,j)+ghalf
1944 * Loop over residues i+1 thru j-1.
1948 gelc(l,k)=gelc(l,k)+ggg(l)
1955 ecosa=2.0D0*fac3*fac1+fac4
1958 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1959 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1961 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1962 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1964 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1965 cd & (dcosg(k),k=1,3)
1967 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1971 gelc(k,i)=gelc(k,i)+ghalf
1972 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1973 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1974 gelc(k,j)=gelc(k,j)+ghalf
1975 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1976 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1980 gelc(l,k)=gelc(l,k)+ggg(l)
1985 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1986 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1987 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1989 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1990 C energy of a peptide unit is assumed in the form of a second-order
1991 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1992 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1993 C are computed for EVERY pair of non-contiguous peptide groups.
1995 if (j.lt.nres-1) then
2006 muij(kkk)=mu(k,i)*mu(l,j)
2009 cd write (iout,*) 'EELEC: i',i,' j',j
2010 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2011 cd write(iout,*) 'muij',muij
2012 ury=scalar(uy(1,i),erij)
2013 urz=scalar(uz(1,i),erij)
2014 vry=scalar(uy(1,j),erij)
2015 vrz=scalar(uz(1,j),erij)
2016 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2017 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2018 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2019 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2020 C For diagnostics only
2025 fac=dsqrt(-ael6i)*r3ij
2026 cd write (2,*) 'fac=',fac
2027 C For diagnostics only
2033 cd write (iout,'(4i5,4f10.5)')
2034 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2035 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2036 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2037 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2038 cd write (iout,'(4f10.5)')
2039 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2040 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2041 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2042 cd write (iout,'(2i3,9f10.5/)') i,j,
2043 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2045 C Derivatives of the elements of A in virtual-bond vectors
2046 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2053 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2054 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2055 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2056 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2057 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2058 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2059 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2060 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2061 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2062 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2063 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2064 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2074 C Compute radial contributions to the gradient
2096 C Add the contributions coming from er
2099 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2100 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2101 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2102 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2105 C Derivatives in DC(i)
2106 ghalf1=0.5d0*agg(k,1)
2107 ghalf2=0.5d0*agg(k,2)
2108 ghalf3=0.5d0*agg(k,3)
2109 ghalf4=0.5d0*agg(k,4)
2110 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2111 & -3.0d0*uryg(k,2)*vry)+ghalf1
2112 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2113 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2114 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2115 & -3.0d0*urzg(k,2)*vry)+ghalf3
2116 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2117 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2118 C Derivatives in DC(i+1)
2119 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2120 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2121 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2122 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2123 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2124 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2125 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2126 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2127 C Derivatives in DC(j)
2128 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2129 & -3.0d0*vryg(k,2)*ury)+ghalf1
2130 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2131 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2132 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2133 & -3.0d0*vryg(k,2)*urz)+ghalf3
2134 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2135 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2136 C Derivatives in DC(j+1) or DC(nres-1)
2137 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2138 & -3.0d0*vryg(k,3)*ury)
2139 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2140 & -3.0d0*vrzg(k,3)*ury)
2141 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2142 & -3.0d0*vryg(k,3)*urz)
2143 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2144 & -3.0d0*vrzg(k,3)*urz)
2149 C Derivatives in DC(i+1)
2150 cd aggi1(k,1)=agg(k,1)
2151 cd aggi1(k,2)=agg(k,2)
2152 cd aggi1(k,3)=agg(k,3)
2153 cd aggi1(k,4)=agg(k,4)
2154 C Derivatives in DC(j)
2159 C Derivatives in DC(j+1)
2164 if (j.eq.nres-1 .and. i.lt.j-2) then
2166 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2167 cd aggj1(k,l)=agg(k,l)
2173 C Check the loc-el terms by numerical integration
2183 aggi(k,l)=-aggi(k,l)
2184 aggi1(k,l)=-aggi1(k,l)
2185 aggj(k,l)=-aggj(k,l)
2186 aggj1(k,l)=-aggj1(k,l)
2189 if (j.lt.nres-1) then
2195 aggi(k,l)=-aggi(k,l)
2196 aggi1(k,l)=-aggi1(k,l)
2197 aggj(k,l)=-aggj(k,l)
2198 aggj1(k,l)=-aggj1(k,l)
2209 aggi(k,l)=-aggi(k,l)
2210 aggi1(k,l)=-aggi1(k,l)
2211 aggj(k,l)=-aggj(k,l)
2212 aggj1(k,l)=-aggj1(k,l)
2218 IF (wel_loc.gt.0.0d0) THEN
2219 C Contribution to the local-electrostatic energy coming from the i-j pair
2220 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2222 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2223 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2224 eel_loc=eel_loc+eel_loc_ij
2225 C Partial derivatives in virtual-bond dihedral angles gamma
2228 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2229 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2230 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2231 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2232 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2233 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2234 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2235 cd write(iout,*) 'agg ',agg
2236 cd write(iout,*) 'aggi ',aggi
2237 cd write(iout,*) 'aggi1',aggi1
2238 cd write(iout,*) 'aggj ',aggj
2239 cd write(iout,*) 'aggj1',aggj1
2241 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2243 ggg(l)=agg(l,1)*muij(1)+
2244 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2248 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2251 C Remaining derivatives of eello
2253 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2254 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2255 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2256 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2257 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2258 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2259 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2260 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2264 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2265 C Contributions from turns
2270 call eturn34(i,j,eello_turn3,eello_turn4)
2272 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2273 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2275 C Calculate the contact function. The ith column of the array JCONT will
2276 C contain the numbers of atoms that make contacts with the atom I (of numbers
2277 C greater than I). The arrays FACONT and GACONT will contain the values of
2278 C the contact function and its derivative.
2279 c r0ij=1.02D0*rpp(iteli,itelj)
2280 c r0ij=1.11D0*rpp(iteli,itelj)
2281 r0ij=2.20D0*rpp(iteli,itelj)
2282 c r0ij=1.55D0*rpp(iteli,itelj)
2283 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2284 if (fcont.gt.0.0D0) then
2285 num_conti=num_conti+1
2286 if (num_conti.gt.maxconts) then
2287 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2288 & ' will skip next contacts for this conf.'
2290 jcont_hb(num_conti,i)=j
2291 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2292 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2293 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2295 d_cont(num_conti,i)=rij
2296 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2297 C --- Electrostatic-interaction matrix ---
2298 a_chuj(1,1,num_conti,i)=a22
2299 a_chuj(1,2,num_conti,i)=a23
2300 a_chuj(2,1,num_conti,i)=a32
2301 a_chuj(2,2,num_conti,i)=a33
2302 C --- Gradient of rij
2304 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2307 c a_chuj(1,1,num_conti,i)=-0.61d0
2308 c a_chuj(1,2,num_conti,i)= 0.4d0
2309 c a_chuj(2,1,num_conti,i)= 0.65d0
2310 c a_chuj(2,2,num_conti,i)= 0.50d0
2311 c else if (i.eq.2) then
2312 c a_chuj(1,1,num_conti,i)= 0.0d0
2313 c a_chuj(1,2,num_conti,i)= 0.0d0
2314 c a_chuj(2,1,num_conti,i)= 0.0d0
2315 c a_chuj(2,2,num_conti,i)= 0.0d0
2317 C --- and its gradients
2318 cd write (iout,*) 'i',i,' j',j
2320 cd write (iout,*) 'iii 1 kkk',kkk
2321 cd write (iout,*) agg(kkk,:)
2324 cd write (iout,*) 'iii 2 kkk',kkk
2325 cd write (iout,*) aggi(kkk,:)
2328 cd write (iout,*) 'iii 3 kkk',kkk
2329 cd write (iout,*) aggi1(kkk,:)
2332 cd write (iout,*) 'iii 4 kkk',kkk
2333 cd write (iout,*) aggj(kkk,:)
2336 cd write (iout,*) 'iii 5 kkk',kkk
2337 cd write (iout,*) aggj1(kkk,:)
2344 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2345 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2346 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2347 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2348 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2350 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2356 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2357 C Calculate contact energies
2359 wij=cosa-3.0D0*cosb*cosg
2362 c fac3=dsqrt(-ael6i)/r0ij**3
2363 fac3=dsqrt(-ael6i)*r3ij
2364 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2365 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2367 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2368 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2369 C Diagnostics. Comment out or remove after debugging!
2370 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2371 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2372 c ees0m(num_conti,i)=0.0D0
2374 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2375 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2376 facont_hb(num_conti,i)=fcont
2378 C Angular derivatives of the contact function
2379 ees0pij1=fac3/ees0pij
2380 ees0mij1=fac3/ees0mij
2381 fac3p=-3.0D0*fac3*rrmij
2382 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2383 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2385 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2386 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2387 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2388 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2389 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2390 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2391 ecosap=ecosa1+ecosa2
2392 ecosbp=ecosb1+ecosb2
2393 ecosgp=ecosg1+ecosg2
2394 ecosam=ecosa1-ecosa2
2395 ecosbm=ecosb1-ecosb2
2396 ecosgm=ecosg1-ecosg2
2405 fprimcont=fprimcont/rij
2406 cd facont_hb(num_conti,i)=1.0D0
2407 C Following line is for diagnostics.
2410 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2411 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2414 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2415 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2417 gggp(1)=gggp(1)+ees0pijp*xj
2418 gggp(2)=gggp(2)+ees0pijp*yj
2419 gggp(3)=gggp(3)+ees0pijp*zj
2420 gggm(1)=gggm(1)+ees0mijp*xj
2421 gggm(2)=gggm(2)+ees0mijp*yj
2422 gggm(3)=gggm(3)+ees0mijp*zj
2423 C Derivatives due to the contact function
2424 gacont_hbr(1,num_conti,i)=fprimcont*xj
2425 gacont_hbr(2,num_conti,i)=fprimcont*yj
2426 gacont_hbr(3,num_conti,i)=fprimcont*zj
2428 ghalfp=0.5D0*gggp(k)
2429 ghalfm=0.5D0*gggm(k)
2430 gacontp_hb1(k,num_conti,i)=ghalfp
2431 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2432 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2433 gacontp_hb2(k,num_conti,i)=ghalfp
2434 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2435 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2436 gacontp_hb3(k,num_conti,i)=gggp(k)
2437 gacontm_hb1(k,num_conti,i)=ghalfm
2438 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2439 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2440 gacontm_hb2(k,num_conti,i)=ghalfm
2441 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2442 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2443 gacontm_hb3(k,num_conti,i)=gggm(k)
2446 C Diagnostics. Comment out or remove after debugging!
2448 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2449 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2450 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2451 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2452 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2453 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2456 endif ! num_conti.le.maxconts
2461 num_cont_hb(i)=num_conti
2465 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2466 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2468 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2469 ccc eel_loc=eel_loc+eello_turn3
2472 C-----------------------------------------------------------------------------
2473 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2474 C Third- and fourth-order contributions from turns
2475 implicit real*8 (a-h,o-z)
2476 include 'DIMENSIONS'
2477 include 'sizesclu.dat'
2478 include 'COMMON.IOUNITS'
2479 include 'COMMON.GEO'
2480 include 'COMMON.VAR'
2481 include 'COMMON.LOCAL'
2482 include 'COMMON.CHAIN'
2483 include 'COMMON.DERIV'
2484 include 'COMMON.INTERACT'
2485 include 'COMMON.CONTACTS'
2486 include 'COMMON.TORSION'
2487 include 'COMMON.VECTORS'
2488 include 'COMMON.FFIELD'
2490 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2491 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2492 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2493 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2494 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2495 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2499 C Third-order contributions
2506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2507 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2508 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2509 call transpose2(auxmat(1,1),auxmat1(1,1))
2510 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2511 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2512 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2513 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2514 cd & ' eello_turn3_num',4*eello_turn3_num
2516 C Derivatives in gamma(i)
2517 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2518 call transpose2(auxmat2(1,1),pizda(1,1))
2519 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2520 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2521 C Derivatives in gamma(i+1)
2522 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2523 call transpose2(auxmat2(1,1),pizda(1,1))
2524 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2525 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2526 & +0.5d0*(pizda(1,1)+pizda(2,2))
2527 C Cartesian derivatives
2529 a_temp(1,1)=aggi(l,1)
2530 a_temp(1,2)=aggi(l,2)
2531 a_temp(2,1)=aggi(l,3)
2532 a_temp(2,2)=aggi(l,4)
2533 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2534 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2535 & +0.5d0*(pizda(1,1)+pizda(2,2))
2536 a_temp(1,1)=aggi1(l,1)
2537 a_temp(1,2)=aggi1(l,2)
2538 a_temp(2,1)=aggi1(l,3)
2539 a_temp(2,2)=aggi1(l,4)
2540 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2541 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2542 & +0.5d0*(pizda(1,1)+pizda(2,2))
2543 a_temp(1,1)=aggj(l,1)
2544 a_temp(1,2)=aggj(l,2)
2545 a_temp(2,1)=aggj(l,3)
2546 a_temp(2,2)=aggj(l,4)
2547 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2548 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2549 & +0.5d0*(pizda(1,1)+pizda(2,2))
2550 a_temp(1,1)=aggj1(l,1)
2551 a_temp(1,2)=aggj1(l,2)
2552 a_temp(2,1)=aggj1(l,3)
2553 a_temp(2,2)=aggj1(l,4)
2554 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2555 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2556 & +0.5d0*(pizda(1,1)+pizda(2,2))
2559 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2560 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2562 C Fourth-order contributions
2570 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2571 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2572 iti1=itortyp(itype(i+1))
2573 iti2=itortyp(itype(i+2))
2574 iti3=itortyp(itype(i+3))
2575 call transpose2(EUg(1,1,i+1),e1t(1,1))
2576 call transpose2(Eug(1,1,i+2),e2t(1,1))
2577 call transpose2(Eug(1,1,i+3),e3t(1,1))
2578 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2579 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2580 s1=scalar2(b1(1,iti2),auxvec(1))
2581 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2582 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2583 s2=scalar2(b1(1,iti1),auxvec(1))
2584 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2585 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2586 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2587 eello_turn4=eello_turn4-(s1+s2+s3)
2588 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2589 cd & ' eello_turn4_num',8*eello_turn4_num
2590 C Derivatives in gamma(i)
2592 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2593 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2594 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2595 s1=scalar2(b1(1,iti2),auxvec(1))
2596 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2597 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2598 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2599 C Derivatives in gamma(i+1)
2600 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2601 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2602 s2=scalar2(b1(1,iti1),auxvec(1))
2603 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2604 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2605 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2606 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2607 C Derivatives in gamma(i+2)
2608 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2609 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2610 s1=scalar2(b1(1,iti2),auxvec(1))
2611 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2612 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2613 s2=scalar2(b1(1,iti1),auxvec(1))
2614 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2615 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2616 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2617 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2618 C Cartesian derivatives
2619 C Derivatives of this turn contributions in DC(i+2)
2620 if (j.lt.nres-1) then
2622 a_temp(1,1)=agg(l,1)
2623 a_temp(1,2)=agg(l,2)
2624 a_temp(2,1)=agg(l,3)
2625 a_temp(2,2)=agg(l,4)
2626 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2627 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2628 s1=scalar2(b1(1,iti2),auxvec(1))
2629 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2630 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2631 s2=scalar2(b1(1,iti1),auxvec(1))
2632 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2633 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2636 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2639 C Remaining derivatives of this turn contribution
2641 a_temp(1,1)=aggi(l,1)
2642 a_temp(1,2)=aggi(l,2)
2643 a_temp(2,1)=aggi(l,3)
2644 a_temp(2,2)=aggi(l,4)
2645 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2646 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2647 s1=scalar2(b1(1,iti2),auxvec(1))
2648 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2649 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2650 s2=scalar2(b1(1,iti1),auxvec(1))
2651 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2652 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2653 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2654 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2655 a_temp(1,1)=aggi1(l,1)
2656 a_temp(1,2)=aggi1(l,2)
2657 a_temp(2,1)=aggi1(l,3)
2658 a_temp(2,2)=aggi1(l,4)
2659 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2660 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2661 s1=scalar2(b1(1,iti2),auxvec(1))
2662 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2663 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2664 s2=scalar2(b1(1,iti1),auxvec(1))
2665 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2666 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2667 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2668 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2669 a_temp(1,1)=aggj(l,1)
2670 a_temp(1,2)=aggj(l,2)
2671 a_temp(2,1)=aggj(l,3)
2672 a_temp(2,2)=aggj(l,4)
2673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2675 s1=scalar2(b1(1,iti2),auxvec(1))
2676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2678 s2=scalar2(b1(1,iti1),auxvec(1))
2679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2683 a_temp(1,1)=aggj1(l,1)
2684 a_temp(1,2)=aggj1(l,2)
2685 a_temp(2,1)=aggj1(l,3)
2686 a_temp(2,2)=aggj1(l,4)
2687 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2688 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2689 s1=scalar2(b1(1,iti2),auxvec(1))
2690 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2691 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2692 s2=scalar2(b1(1,iti1),auxvec(1))
2693 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2694 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2695 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2696 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2702 C-----------------------------------------------------------------------------
2703 subroutine vecpr(u,v,w)
2704 implicit real*8(a-h,o-z)
2705 dimension u(3),v(3),w(3)
2706 w(1)=u(2)*v(3)-u(3)*v(2)
2707 w(2)=-u(1)*v(3)+u(3)*v(1)
2708 w(3)=u(1)*v(2)-u(2)*v(1)
2711 C-----------------------------------------------------------------------------
2712 subroutine unormderiv(u,ugrad,unorm,ungrad)
2713 C This subroutine computes the derivatives of a normalized vector u, given
2714 C the derivatives computed without normalization conditions, ugrad. Returns
2717 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2718 double precision vec(3)
2719 double precision scalar
2721 c write (2,*) 'ugrad',ugrad
2724 vec(i)=scalar(ugrad(1,i),u(1))
2726 c write (2,*) 'vec',vec
2729 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2732 c write (2,*) 'ungrad',ungrad
2735 C-----------------------------------------------------------------------------
2736 subroutine escp(evdw2,evdw2_14)
2738 C This subroutine calculates the excluded-volume interaction energy between
2739 C peptide-group centers and side chains and its gradient in virtual-bond and
2740 C side-chain vectors.
2742 implicit real*8 (a-h,o-z)
2743 include 'DIMENSIONS'
2744 include 'sizesclu.dat'
2745 include 'COMMON.GEO'
2746 include 'COMMON.VAR'
2747 include 'COMMON.LOCAL'
2748 include 'COMMON.CHAIN'
2749 include 'COMMON.DERIV'
2750 include 'COMMON.INTERACT'
2751 include 'COMMON.FFIELD'
2752 include 'COMMON.IOUNITS'
2756 cd print '(a)','Enter ESCP'
2757 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2758 c & ' scal14',scal14
2759 do i=iatscp_s,iatscp_e
2760 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2762 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2763 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2764 if (iteli.eq.0) goto 1225
2765 xi=0.5D0*(c(1,i)+c(1,i+1))
2766 yi=0.5D0*(c(2,i)+c(2,i+1))
2767 zi=0.5D0*(c(3,i)+c(3,i+1))
2769 do iint=1,nscp_gr(i)
2771 do j=iscpstart(i,iint),iscpend(i,iint)
2772 itypj=iabs(itype(j))
2773 if (itypj.eq.ntyp1) cycle
2774 C Uncomment following three lines for SC-p interactions
2778 C Uncomment following three lines for Ca-p interactions
2782 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2784 e1=fac*fac*aad(itypj,iteli)
2785 e2=fac*bad(itypj,iteli)
2786 if (iabs(j-i) .le. 2) then
2789 evdw2_14=evdw2_14+e1+e2
2792 c write (iout,*) i,j,evdwij
2796 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2798 fac=-(evdwij+e1)*rrij
2803 cd write (iout,*) 'j<i'
2804 C Uncomment following three lines for SC-p interactions
2806 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2809 cd write (iout,*) 'j>i'
2812 C Uncomment following line for SC-p interactions
2813 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2817 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2821 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2822 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2825 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2835 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2836 gradx_scp(j,i)=expon*gradx_scp(j,i)
2839 C******************************************************************************
2843 C To save time the factor EXPON has been extracted from ALL components
2844 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2847 C******************************************************************************
2850 C--------------------------------------------------------------------------
2851 subroutine edis(ehpb)
2853 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2855 implicit real*8 (a-h,o-z)
2856 include 'DIMENSIONS'
2857 include 'sizesclu.dat'
2858 include 'COMMON.SBRIDGE'
2859 include 'COMMON.CHAIN'
2860 include 'COMMON.DERIV'
2861 include 'COMMON.VAR'
2862 include 'COMMON.INTERACT'
2865 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2866 cd print *,'link_start=',link_start,' link_end=',link_end
2867 if (link_end.eq.0) return
2868 do i=link_start,link_end
2869 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2870 C CA-CA distance used in regularization of structure.
2873 C iii and jjj point to the residues for which the distance is assigned.
2874 if (ii.gt.nres) then
2881 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2882 C distance and angle dependent SS bond potential.
2883 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2884 & iabs(itype(jjj)).eq.1) then
2885 call ssbond_ene(iii,jjj,eij)
2888 C Calculate the distance between the two points and its difference from the
2892 C Get the force constant corresponding to this distance.
2894 C Calculate the contribution to energy.
2895 ehpb=ehpb+waga*rdis*rdis
2897 C Evaluate gradient.
2900 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2901 cd & ' waga=',waga,' fac=',fac
2903 ggg(j)=fac*(c(j,jj)-c(j,ii))
2905 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2906 C If this is a SC-SC distance, we need to calculate the contributions to the
2907 C Cartesian gradient in the SC vectors (ghpbx).
2910 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2911 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2916 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2924 C--------------------------------------------------------------------------
2925 subroutine ssbond_ene(i,j,eij)
2927 C Calculate the distance and angle dependent SS-bond potential energy
2928 C using a free-energy function derived based on RHF/6-31G** ab initio
2929 C calculations of diethyl disulfide.
2931 C A. Liwo and U. Kozlowska, 11/24/03
2933 implicit real*8 (a-h,o-z)
2934 include 'DIMENSIONS'
2935 include 'sizesclu.dat'
2936 include 'COMMON.SBRIDGE'
2937 include 'COMMON.CHAIN'
2938 include 'COMMON.DERIV'
2939 include 'COMMON.LOCAL'
2940 include 'COMMON.INTERACT'
2941 include 'COMMON.VAR'
2942 include 'COMMON.IOUNITS'
2943 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2944 itypi=iabs(itype(i))
2948 dxi=dc_norm(1,nres+i)
2949 dyi=dc_norm(2,nres+i)
2950 dzi=dc_norm(3,nres+i)
2951 dsci_inv=dsc_inv(itypi)
2952 itypj=iabs(itype(j))
2953 dscj_inv=dsc_inv(itypj)
2957 dxj=dc_norm(1,nres+j)
2958 dyj=dc_norm(2,nres+j)
2959 dzj=dc_norm(3,nres+j)
2960 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2965 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2966 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2967 om12=dxi*dxj+dyi*dyj+dzi*dzj
2969 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2970 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2976 deltat12=om2-om1+2.0d0
2978 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2979 & +akct*deltad*deltat12
2980 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2981 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2982 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2983 c & " deltat12",deltat12," eij",eij
2984 ed=2*akcm*deltad+akct*deltat12
2986 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2987 eom1=-2*akth*deltat1-pom1-om2*pom2
2988 eom2= 2*akth*deltat2+pom1-om1*pom2
2991 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2994 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2995 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2996 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2997 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3000 C Calculate the components of the gradient in DC and X
3004 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3009 C--------------------------------------------------------------------------
3010 subroutine ebond(estr)
3012 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3014 implicit real*8 (a-h,o-z)
3015 include 'DIMENSIONS'
3016 include 'sizesclu.dat'
3017 include 'COMMON.LOCAL'
3018 include 'COMMON.GEO'
3019 include 'COMMON.INTERACT'
3020 include 'COMMON.DERIV'
3021 include 'COMMON.VAR'
3022 include 'COMMON.CHAIN'
3023 include 'COMMON.IOUNITS'
3024 include 'COMMON.NAMES'
3025 include 'COMMON.FFIELD'
3026 include 'COMMON.CONTROL'
3027 logical energy_dec /.false./
3028 double precision u(3),ud(3)
3032 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3033 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3035 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3036 & *dc(j,i-1)/vbld(i)
3038 if (energy_dec) write(iout,*)
3039 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3041 diff = vbld(i)-vbldp0
3042 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3045 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3050 estr=0.5d0*AKP*estr+estr1
3052 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3056 if (iti.ne.10 .and. iti.ne.ntyp1) then
3059 diff=vbld(i+nres)-vbldsc0(1,iti)
3060 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3061 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3062 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3064 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3068 diff=vbld(i+nres)-vbldsc0(j,iti)
3069 ud(j)=aksc(j,iti)*diff
3070 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3084 uprod2=uprod2*u(k)*u(k)
3088 usumsqder=usumsqder+ud(j)*uprod2
3090 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3091 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3092 estr=estr+uprod/usum
3094 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3102 C--------------------------------------------------------------------------
3103 subroutine ebend(etheta)
3105 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3106 C angles gamma and its derivatives in consecutive thetas and gammas.
3108 implicit real*8 (a-h,o-z)
3109 include 'DIMENSIONS'
3110 include 'sizesclu.dat'
3111 include 'COMMON.LOCAL'
3112 include 'COMMON.GEO'
3113 include 'COMMON.INTERACT'
3114 include 'COMMON.DERIV'
3115 include 'COMMON.VAR'
3116 include 'COMMON.CHAIN'
3117 include 'COMMON.IOUNITS'
3118 include 'COMMON.NAMES'
3119 include 'COMMON.FFIELD'
3120 common /calcthet/ term1,term2,termm,diffak,ratak,
3121 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3122 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3123 double precision y(2),z(2)
3125 time11=dexp(-2*time)
3128 c write (iout,*) "nres",nres
3129 c write (*,'(a,i2)') 'EBEND ICG=',icg
3130 c write (iout,*) ithet_start,ithet_end
3131 do i=ithet_start,ithet_end
3132 if (itype(i-1).eq.ntyp1) cycle
3133 C Zero the energy function and its derivative at 0 or pi.
3134 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3136 ichir1=isign(1,itype(i-2))
3137 ichir2=isign(1,itype(i))
3138 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3139 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3140 if (itype(i-1).eq.10) then
3141 itype1=isign(10,itype(i-2))
3142 ichir11=isign(1,itype(i-2))
3143 ichir12=isign(1,itype(i-2))
3144 itype2=isign(10,itype(i))
3145 ichir21=isign(1,itype(i))
3146 ichir22=isign(1,itype(i))
3148 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3152 call proc_proc(phii,icrc)
3153 if (icrc.eq.1) phii=150.0
3163 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3167 call proc_proc(phii1,icrc)
3168 if (icrc.eq.1) phii1=150.0
3180 C Calculate the "mean" value of theta from the part of the distribution
3181 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3182 C In following comments this theta will be referred to as t_c.
3183 thet_pred_mean=0.0d0
3185 athetk=athet(k,it,ichir1,ichir2)
3186 bthetk=bthet(k,it,ichir1,ichir2)
3188 athetk=athet(k,itype1,ichir11,ichir12)
3189 bthetk=bthet(k,itype2,ichir21,ichir22)
3191 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3193 c write (iout,*) "thet_pred_mean",thet_pred_mean
3194 dthett=thet_pred_mean*ssd
3195 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3196 c write (iout,*) "thet_pred_mean",thet_pred_mean
3197 C Derivatives of the "mean" values in gamma1 and gamma2.
3198 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3199 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3200 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3201 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3203 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3204 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3205 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3206 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3208 if (theta(i).gt.pi-delta) then
3209 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3211 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3212 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3213 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3215 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3217 else if (theta(i).lt.delta) then
3218 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3219 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3220 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3222 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3223 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3226 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3229 etheta=etheta+ethetai
3230 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3231 c & rad2deg*phii,rad2deg*phii1,ethetai
3232 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3233 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3234 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3237 C Ufff.... We've done all this!!!
3240 C---------------------------------------------------------------------------
3241 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3243 implicit real*8 (a-h,o-z)
3244 include 'DIMENSIONS'
3245 include 'COMMON.LOCAL'
3246 include 'COMMON.IOUNITS'
3247 common /calcthet/ term1,term2,termm,diffak,ratak,
3248 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3249 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3250 C Calculate the contributions to both Gaussian lobes.
3251 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3252 C The "polynomial part" of the "standard deviation" of this part of
3256 sig=sig*thet_pred_mean+polthet(j,it)
3258 C Derivative of the "interior part" of the "standard deviation of the"
3259 C gamma-dependent Gaussian lobe in t_c.
3260 sigtc=3*polthet(3,it)
3262 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3265 C Set the parameters of both Gaussian lobes of the distribution.
3266 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3267 fac=sig*sig+sigc0(it)
3270 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3271 sigsqtc=-4.0D0*sigcsq*sigtc
3272 c print *,i,sig,sigtc,sigsqtc
3273 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3274 sigtc=-sigtc/(fac*fac)
3275 C Following variable is sigma(t_c)**(-2)
3276 sigcsq=sigcsq*sigcsq
3278 sig0inv=1.0D0/sig0i**2
3279 delthec=thetai-thet_pred_mean
3280 delthe0=thetai-theta0i
3281 term1=-0.5D0*sigcsq*delthec*delthec
3282 term2=-0.5D0*sig0inv*delthe0*delthe0
3283 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3284 C NaNs in taking the logarithm. We extract the largest exponent which is added
3285 C to the energy (this being the log of the distribution) at the end of energy
3286 C term evaluation for this virtual-bond angle.
3287 if (term1.gt.term2) then
3289 term2=dexp(term2-termm)
3293 term1=dexp(term1-termm)
3296 C The ratio between the gamma-independent and gamma-dependent lobes of
3297 C the distribution is a Gaussian function of thet_pred_mean too.
3298 diffak=gthet(2,it)-thet_pred_mean
3299 ratak=diffak/gthet(3,it)**2
3300 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3301 C Let's differentiate it in thet_pred_mean NOW.
3303 C Now put together the distribution terms to make complete distribution.
3304 termexp=term1+ak*term2
3305 termpre=sigc+ak*sig0i
3306 C Contribution of the bending energy from this theta is just the -log of
3307 C the sum of the contributions from the two lobes and the pre-exponential
3308 C factor. Simple enough, isn't it?
3309 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3310 C NOW the derivatives!!!
3311 C 6/6/97 Take into account the deformation.
3312 E_theta=(delthec*sigcsq*term1
3313 & +ak*delthe0*sig0inv*term2)/termexp
3314 E_tc=((sigtc+aktc*sig0i)/termpre
3315 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3316 & aktc*term2)/termexp)
3319 c-----------------------------------------------------------------------------
3320 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3321 implicit real*8 (a-h,o-z)
3322 include 'DIMENSIONS'
3323 include 'COMMON.LOCAL'
3324 include 'COMMON.IOUNITS'
3325 common /calcthet/ term1,term2,termm,diffak,ratak,
3326 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3327 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3328 delthec=thetai-thet_pred_mean
3329 delthe0=thetai-theta0i
3330 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3331 t3 = thetai-thet_pred_mean
3335 t14 = t12+t6*sigsqtc
3337 t21 = thetai-theta0i
3343 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3344 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3345 & *(-t12*t9-ak*sig0inv*t27)
3349 C--------------------------------------------------------------------------
3350 subroutine ebend(etheta)
3352 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3353 C angles gamma and its derivatives in consecutive thetas and gammas.
3354 C ab initio-derived potentials from
3355 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3357 implicit real*8 (a-h,o-z)
3358 include 'DIMENSIONS'
3359 include 'sizesclu.dat'
3360 include 'COMMON.LOCAL'
3361 include 'COMMON.GEO'
3362 include 'COMMON.INTERACT'
3363 include 'COMMON.DERIV'
3364 include 'COMMON.VAR'
3365 include 'COMMON.CHAIN'
3366 include 'COMMON.IOUNITS'
3367 include 'COMMON.NAMES'
3368 include 'COMMON.FFIELD'
3369 include 'COMMON.CONTROL'
3370 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3371 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3372 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3373 & sinph1ph2(maxdouble,maxdouble)
3374 logical lprn /.false./, lprn1 /.false./
3376 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3377 do i=ithet_start,ithet_end
3378 if (itype(i-1).eq.ntyp1) cycle
3379 if (iabs(itype(i+1)).eq.20) iblock=2
3380 if (iabs(itype(i+1)).ne.20) iblock=1
3384 theti2=0.5d0*theta(i)
3385 CC Ta zmina jest niewlasciwa
3386 ityp2=ithetyp((itype(i-1)))
3388 coskt(k)=dcos(k*theti2)
3389 sinkt(k)=dsin(k*theti2)
3391 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3394 if (phii.ne.phii) phii=150.0
3398 ityp1=ithetyp((itype(i-2)))
3400 cosph1(k)=dcos(k*phii)
3401 sinph1(k)=dsin(k*phii)
3411 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3414 if (phii1.ne.phii1) phii1=150.0
3419 ityp3=ithetyp((itype(i)))
3421 cosph2(k)=dcos(k*phii1)
3422 sinph2(k)=dsin(k*phii1)
3432 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3433 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3435 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3438 ccl=cosph1(l)*cosph2(k-l)
3439 ssl=sinph1(l)*sinph2(k-l)
3440 scl=sinph1(l)*cosph2(k-l)
3441 csl=cosph1(l)*sinph2(k-l)
3442 cosph1ph2(l,k)=ccl-ssl
3443 cosph1ph2(k,l)=ccl+ssl
3444 sinph1ph2(l,k)=scl+csl
3445 sinph1ph2(k,l)=scl-csl
3449 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3450 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3451 write (iout,*) "coskt and sinkt"
3453 write (iout,*) k,coskt(k),sinkt(k)
3457 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3458 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3461 & write (iout,*) "k",k," aathet",
3462 & aathet(k,ityp1,ityp2,ityp3,iblock),
3463 & " ethetai",ethetai
3466 write (iout,*) "cosph and sinph"
3468 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3470 write (iout,*) "cosph1ph2 and sinph2ph2"
3473 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3474 & sinph1ph2(l,k),sinph1ph2(k,l)
3477 write(iout,*) "ethetai",ethetai
3481 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3482 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3483 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3484 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3485 ethetai=ethetai+sinkt(m)*aux
3486 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3487 dephii=dephii+k*sinkt(m)*(
3488 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3489 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3490 dephii1=dephii1+k*sinkt(m)*(
3491 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3492 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3494 & write (iout,*) "m",m," k",k," bbthet",
3495 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3496 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3497 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3498 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3502 & write(iout,*) "ethetai",ethetai
3506 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3507 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3508 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3509 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3510 ethetai=ethetai+sinkt(m)*aux
3511 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3512 dephii=dephii+l*sinkt(m)*(
3513 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3514 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3515 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3516 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3517 dephii1=dephii1+(k-l)*sinkt(m)*(
3518 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3519 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3520 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3521 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3523 write (iout,*) "m",m," k",k," l",l," ffthet",
3524 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3525 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3526 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3527 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3528 & " ethetai",ethetai
3529 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3530 & cosph1ph2(k,l)*sinkt(m),
3531 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3537 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3538 & i,theta(i)*rad2deg,phii*rad2deg,
3539 & phii1*rad2deg,ethetai
3540 etheta=etheta+ethetai
3541 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3542 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3543 gloc(nphi+i-2,icg)=wang*dethetai
3549 c-----------------------------------------------------------------------------
3550 subroutine esc(escloc)
3551 C Calculate the local energy of a side chain and its derivatives in the
3552 C corresponding virtual-bond valence angles THETA and the spherical angles
3554 implicit real*8 (a-h,o-z)
3555 include 'DIMENSIONS'
3556 include 'sizesclu.dat'
3557 include 'COMMON.GEO'
3558 include 'COMMON.LOCAL'
3559 include 'COMMON.VAR'
3560 include 'COMMON.INTERACT'
3561 include 'COMMON.DERIV'
3562 include 'COMMON.CHAIN'
3563 include 'COMMON.IOUNITS'
3564 include 'COMMON.NAMES'
3565 include 'COMMON.FFIELD'
3566 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3567 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3568 common /sccalc/ time11,time12,time112,theti,it,nlobit
3571 c write (iout,'(a)') 'ESC'
3572 do i=loc_start,loc_end
3574 if (it.eq.ntyp1) cycle
3575 if (it.eq.10) goto 1
3576 nlobit=nlob(iabs(it))
3577 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3578 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3579 theti=theta(i+1)-pipol
3583 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3585 if (x(2).gt.pi-delta) then
3589 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3591 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3592 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3594 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3595 & ddersc0(1),dersc(1))
3596 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3597 & ddersc0(3),dersc(3))
3599 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3601 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3602 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3603 & dersc0(2),esclocbi,dersc02)
3604 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3606 call splinthet(x(2),0.5d0*delta,ss,ssd)
3611 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3613 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3614 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3616 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3618 c write (iout,*) escloci
3619 else if (x(2).lt.delta) then
3623 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3625 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3626 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3628 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3629 & ddersc0(1),dersc(1))
3630 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3631 & ddersc0(3),dersc(3))
3633 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3635 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3636 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3637 & dersc0(2),esclocbi,dersc02)
3638 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3643 call splinthet(x(2),0.5d0*delta,ss,ssd)
3645 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3647 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3648 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3650 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3651 c write (iout,*) escloci
3653 call enesc(x,escloci,dersc,ddummy,.false.)
3656 escloc=escloc+escloci
3657 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3659 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3661 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3662 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3667 C---------------------------------------------------------------------------
3668 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3669 implicit real*8 (a-h,o-z)
3670 include 'DIMENSIONS'
3671 include 'COMMON.GEO'
3672 include 'COMMON.LOCAL'
3673 include 'COMMON.IOUNITS'
3674 common /sccalc/ time11,time12,time112,theti,it,nlobit
3675 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3676 double precision contr(maxlob,-1:1)
3678 c write (iout,*) 'it=',it,' nlobit=',nlobit
3682 if (mixed) ddersc(j)=0.0d0
3686 C Because of periodicity of the dependence of the SC energy in omega we have
3687 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3688 C To avoid underflows, first compute & store the exponents.
3696 z(k)=x(k)-censc(k,j,it)
3701 Axk=Axk+gaussc(l,k,j,it)*z(l)
3707 expfac=expfac+Ax(k,j,iii)*z(k)
3715 C As in the case of ebend, we want to avoid underflows in exponentiation and
3716 C subsequent NaNs and INFs in energy calculation.
3717 C Find the largest exponent
3721 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3725 cd print *,'it=',it,' emin=',emin
3727 C Compute the contribution to SC energy and derivatives
3731 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3732 cd print *,'j=',j,' expfac=',expfac
3733 escloc_i=escloc_i+expfac
3735 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3739 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3740 & +gaussc(k,2,j,it))*expfac
3747 dersc(1)=dersc(1)/cos(theti)**2
3748 ddersc(1)=ddersc(1)/cos(theti)**2
3751 escloci=-(dlog(escloc_i)-emin)
3753 dersc(j)=dersc(j)/escloc_i
3757 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3762 C------------------------------------------------------------------------------
3763 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3764 implicit real*8 (a-h,o-z)
3765 include 'DIMENSIONS'
3766 include 'COMMON.GEO'
3767 include 'COMMON.LOCAL'
3768 include 'COMMON.IOUNITS'
3769 common /sccalc/ time11,time12,time112,theti,it,nlobit
3770 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3771 double precision contr(maxlob)
3782 z(k)=x(k)-censc(k,j,it)
3788 Axk=Axk+gaussc(l,k,j,it)*z(l)
3794 expfac=expfac+Ax(k,j)*z(k)
3799 C As in the case of ebend, we want to avoid underflows in exponentiation and
3800 C subsequent NaNs and INFs in energy calculation.
3801 C Find the largest exponent
3804 if (emin.gt.contr(j)) emin=contr(j)
3808 C Compute the contribution to SC energy and derivatives
3812 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3813 escloc_i=escloc_i+expfac
3815 dersc(k)=dersc(k)+Ax(k,j)*expfac
3817 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3818 & +gaussc(1,2,j,it))*expfac
3822 dersc(1)=dersc(1)/cos(theti)**2
3823 dersc12=dersc12/cos(theti)**2
3824 escloci=-(dlog(escloc_i)-emin)
3826 dersc(j)=dersc(j)/escloc_i
3828 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3832 c----------------------------------------------------------------------------------
3833 subroutine esc(escloc)
3834 C Calculate the local energy of a side chain and its derivatives in the
3835 C corresponding virtual-bond valence angles THETA and the spherical angles
3836 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3837 C added by Urszula Kozlowska. 07/11/2007
3839 implicit real*8 (a-h,o-z)
3840 include 'DIMENSIONS'
3841 include 'sizesclu.dat'
3842 include 'COMMON.GEO'
3843 include 'COMMON.LOCAL'
3844 include 'COMMON.VAR'
3845 include 'COMMON.SCROT'
3846 include 'COMMON.INTERACT'
3847 include 'COMMON.DERIV'
3848 include 'COMMON.CHAIN'
3849 include 'COMMON.IOUNITS'
3850 include 'COMMON.NAMES'
3851 include 'COMMON.FFIELD'
3852 include 'COMMON.CONTROL'
3853 include 'COMMON.VECTORS'
3854 double precision x_prime(3),y_prime(3),z_prime(3)
3855 & , sumene,dsc_i,dp2_i,x(65),
3856 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3857 & de_dxx,de_dyy,de_dzz,de_dt
3858 double precision s1_t,s1_6_t,s2_t,s2_6_t
3860 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3861 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3862 & dt_dCi(3),dt_dCi1(3)
3863 common /sccalc/ time11,time12,time112,theti,it,nlobit
3866 do i=loc_start,loc_end
3867 if (itype(i).eq.ntyp1) cycle
3868 costtab(i+1) =dcos(theta(i+1))
3869 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3870 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3871 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3872 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3873 cosfac=dsqrt(cosfac2)
3874 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3875 sinfac=dsqrt(sinfac2)
3877 if (it.eq.10) goto 1
3879 C Compute the axes of tghe local cartesian coordinates system; store in
3880 c x_prime, y_prime and z_prime
3887 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3888 C & dc_norm(3,i+nres)
3890 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3891 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3894 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3897 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3898 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3899 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3900 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3901 c & " xy",scalar(x_prime(1),y_prime(1)),
3902 c & " xz",scalar(x_prime(1),z_prime(1)),
3903 c & " yy",scalar(y_prime(1),y_prime(1)),
3904 c & " yz",scalar(y_prime(1),z_prime(1)),
3905 c & " zz",scalar(z_prime(1),z_prime(1))
3907 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3908 C to local coordinate system. Store in xx, yy, zz.
3914 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3915 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3916 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3923 C Compute the energy of the ith side cbain
3925 c write (2,*) "xx",xx," yy",yy," zz",zz
3928 x(j) = sc_parmin(j,it)
3931 Cc diagnostics - remove later
3933 yy1 = dsin(alph(2))*dcos(omeg(2))
3934 zz1 = -dsin(alph(2))*dsin(omeg(2))
3935 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3936 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3938 C," --- ", xx_w,yy_w,zz_w
3941 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3942 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3944 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3945 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3947 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3948 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3949 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3950 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3951 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3953 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3954 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3955 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3956 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3957 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3959 dsc_i = 0.743d0+x(61)
3961 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3962 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3963 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3964 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3965 s1=(1+x(63))/(0.1d0 + dscp1)
3966 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3967 s2=(1+x(65))/(0.1d0 + dscp2)
3968 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3969 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3970 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3971 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3973 c & dscp1,dscp2,sumene
3974 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3975 escloc = escloc + sumene
3976 c write (2,*) "escloc",escloc
3977 if (.not. calc_grad) goto 1
3980 C This section to check the numerical derivatives of the energy of ith side
3981 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3982 C #define DEBUG in the code to turn it on.
3984 write (2,*) "sumene =",sumene
3988 write (2,*) xx,yy,zz
3989 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3990 de_dxx_num=(sumenep-sumene)/aincr
3992 write (2,*) "xx+ sumene from enesc=",sumenep
3995 write (2,*) xx,yy,zz
3996 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3997 de_dyy_num=(sumenep-sumene)/aincr
3999 write (2,*) "yy+ sumene from enesc=",sumenep
4002 write (2,*) xx,yy,zz
4003 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4004 de_dzz_num=(sumenep-sumene)/aincr
4006 write (2,*) "zz+ sumene from enesc=",sumenep
4007 costsave=cost2tab(i+1)
4008 sintsave=sint2tab(i+1)
4009 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4010 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4011 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4012 de_dt_num=(sumenep-sumene)/aincr
4013 write (2,*) " t+ sumene from enesc=",sumenep
4014 cost2tab(i+1)=costsave
4015 sint2tab(i+1)=sintsave
4016 C End of diagnostics section.
4019 C Compute the gradient of esc
4021 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4022 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4023 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4024 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4025 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4026 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4027 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4028 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4029 pom1=(sumene3*sint2tab(i+1)+sumene1)
4030 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4031 pom2=(sumene4*cost2tab(i+1)+sumene2)
4032 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4033 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4034 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4035 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4037 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4038 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4039 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4041 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4042 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4043 & +(pom1+pom2)*pom_dx
4045 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4048 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4049 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4050 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4052 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4053 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4054 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4055 & +x(59)*zz**2 +x(60)*xx*zz
4056 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4057 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4058 & +(pom1-pom2)*pom_dy
4060 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4063 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4064 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4065 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4066 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4067 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4068 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4069 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4070 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4072 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4075 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4076 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4077 & +pom1*pom_dt1+pom2*pom_dt2
4079 write(2,*), "de_dt = ", de_dt,de_dt_num
4083 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4084 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4085 cosfac2xx=cosfac2*xx
4086 sinfac2yy=sinfac2*yy
4088 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4090 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4092 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4093 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4094 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4095 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4096 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4097 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4098 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4099 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4100 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4101 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4105 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4106 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4107 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4108 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4111 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4112 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4113 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4115 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4116 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4120 dXX_Ctab(k,i)=dXX_Ci(k)
4121 dXX_C1tab(k,i)=dXX_Ci1(k)
4122 dYY_Ctab(k,i)=dYY_Ci(k)
4123 dYY_C1tab(k,i)=dYY_Ci1(k)
4124 dZZ_Ctab(k,i)=dZZ_Ci(k)
4125 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4126 dXX_XYZtab(k,i)=dXX_XYZ(k)
4127 dYY_XYZtab(k,i)=dYY_XYZ(k)
4128 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4132 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4133 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4134 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4135 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4136 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4138 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4139 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4140 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4141 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4142 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4143 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4144 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4145 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4147 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4148 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4150 C to check gradient call subroutine check_grad
4157 c------------------------------------------------------------------------------
4158 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4160 C This procedure calculates two-body contact function g(rij) and its derivative:
4163 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4166 C where x=(rij-r0ij)/delta
4168 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4171 double precision rij,r0ij,eps0ij,fcont,fprimcont
4172 double precision x,x2,x4,delta
4176 if (x.lt.-1.0D0) then
4179 else if (x.le.1.0D0) then
4182 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4183 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4190 c------------------------------------------------------------------------------
4191 subroutine splinthet(theti,delta,ss,ssder)
4192 implicit real*8 (a-h,o-z)
4193 include 'DIMENSIONS'
4194 include 'sizesclu.dat'
4195 include 'COMMON.VAR'
4196 include 'COMMON.GEO'
4199 if (theti.gt.pipol) then
4200 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4202 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4207 c------------------------------------------------------------------------------
4208 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4210 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4211 double precision ksi,ksi2,ksi3,a1,a2,a3
4212 a1=fprim0*delta/(f1-f0)
4218 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4219 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4222 c------------------------------------------------------------------------------
4223 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4225 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4226 double precision ksi,ksi2,ksi3,a1,a2,a3
4231 a2=3*(f1x-f0x)-2*fprim0x*delta
4232 a3=fprim0x*delta-2*(f1x-f0x)
4233 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4236 C-----------------------------------------------------------------------------
4238 C-----------------------------------------------------------------------------
4239 subroutine etor(etors,edihcnstr,fact)
4240 implicit real*8 (a-h,o-z)
4241 include 'DIMENSIONS'
4242 include 'sizesclu.dat'
4243 include 'COMMON.VAR'
4244 include 'COMMON.GEO'
4245 include 'COMMON.LOCAL'
4246 include 'COMMON.TORSION'
4247 include 'COMMON.INTERACT'
4248 include 'COMMON.DERIV'
4249 include 'COMMON.CHAIN'
4250 include 'COMMON.NAMES'
4251 include 'COMMON.IOUNITS'
4252 include 'COMMON.FFIELD'
4253 include 'COMMON.TORCNSTR'
4255 C Set lprn=.true. for debugging
4259 do i=iphi_start,iphi_end
4260 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4261 & .or. itype(i).eq.ntyp1) cycle
4262 itori=itortyp(itype(i-2))
4263 itori1=itortyp(itype(i-1))
4266 C Proline-Proline pair is a special case...
4267 if (itori.eq.3 .and. itori1.eq.3) then
4268 if (phii.gt.-dwapi3) then
4270 fac=1.0D0/(1.0D0-cosphi)
4271 etorsi=v1(1,3,3)*fac
4272 etorsi=etorsi+etorsi
4273 etors=etors+etorsi-v1(1,3,3)
4274 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4277 v1ij=v1(j+1,itori,itori1)
4278 v2ij=v2(j+1,itori,itori1)
4281 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4282 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4286 v1ij=v1(j,itori,itori1)
4287 v2ij=v2(j,itori,itori1)
4290 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4291 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4295 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4296 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4297 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4298 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4299 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4301 ! 6/20/98 - dihedral angle constraints
4304 itori=idih_constr(i)
4307 if (difi.gt.drange(i)) then
4309 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4310 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4311 else if (difi.lt.-drange(i)) then
4313 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4314 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4316 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4317 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4319 ! write (iout,*) 'edihcnstr',edihcnstr
4322 c------------------------------------------------------------------------------
4324 subroutine etor(etors,edihcnstr,fact)
4325 implicit real*8 (a-h,o-z)
4326 include 'DIMENSIONS'
4327 include 'sizesclu.dat'
4328 include 'COMMON.VAR'
4329 include 'COMMON.GEO'
4330 include 'COMMON.LOCAL'
4331 include 'COMMON.TORSION'
4332 include 'COMMON.INTERACT'
4333 include 'COMMON.DERIV'
4334 include 'COMMON.CHAIN'
4335 include 'COMMON.NAMES'
4336 include 'COMMON.IOUNITS'
4337 include 'COMMON.FFIELD'
4338 include 'COMMON.TORCNSTR'
4340 C Set lprn=.true. for debugging
4344 do i=iphi_start,iphi_end
4345 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4346 & .or. itype(i).eq.ntyp1) cycle
4347 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4348 if (iabs(itype(i)).eq.20) then
4353 itori=itortyp(itype(i-2))
4354 itori1=itortyp(itype(i-1))
4357 C Regular cosine and sine terms
4358 do j=1,nterm(itori,itori1,iblock)
4359 v1ij=v1(j,itori,itori1,iblock)
4360 v2ij=v2(j,itori,itori1,iblock)
4363 etors=etors+v1ij*cosphi+v2ij*sinphi
4364 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4368 C E = SUM ----------------------------------- - v1
4369 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4371 cosphi=dcos(0.5d0*phii)
4372 sinphi=dsin(0.5d0*phii)
4373 do j=1,nlor(itori,itori1,iblock)
4374 vl1ij=vlor1(j,itori,itori1)
4375 vl2ij=vlor2(j,itori,itori1)
4376 vl3ij=vlor3(j,itori,itori1)
4377 pom=vl2ij*cosphi+vl3ij*sinphi
4378 pom1=1.0d0/(pom*pom+1.0d0)
4379 etors=etors+vl1ij*pom1
4381 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4383 C Subtract the constant term
4384 etors=etors-v0(itori,itori1,iblock)
4386 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4387 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4388 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4389 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4390 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4393 ! 6/20/98 - dihedral angle constraints
4396 itori=idih_constr(i)
4398 difi=pinorm(phii-phi0(i))
4400 if (difi.gt.drange(i)) then
4402 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4403 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4404 edihi=0.25d0*ftors*difi**4
4405 else if (difi.lt.-drange(i)) then
4407 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4408 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4409 edihi=0.25d0*ftors*difi**4
4413 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4415 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4416 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4418 ! write (iout,*) 'edihcnstr',edihcnstr
4421 c----------------------------------------------------------------------------
4422 subroutine etor_d(etors_d,fact2)
4423 C 6/23/01 Compute double torsional energy
4424 implicit real*8 (a-h,o-z)
4425 include 'DIMENSIONS'
4426 include 'sizesclu.dat'
4427 include 'COMMON.VAR'
4428 include 'COMMON.GEO'
4429 include 'COMMON.LOCAL'
4430 include 'COMMON.TORSION'
4431 include 'COMMON.INTERACT'
4432 include 'COMMON.DERIV'
4433 include 'COMMON.CHAIN'
4434 include 'COMMON.NAMES'
4435 include 'COMMON.IOUNITS'
4436 include 'COMMON.FFIELD'
4437 include 'COMMON.TORCNSTR'
4439 C Set lprn=.true. for debugging
4443 do i=iphi_start,iphi_end-1
4444 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4445 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4446 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4448 itori=itortyp(itype(i-2))
4449 itori1=itortyp(itype(i-1))
4450 itori2=itortyp(itype(i))
4456 if (iabs(itype(i+1)).eq.20) iblock=2
4457 C Regular cosine and sine terms
4458 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4459 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4460 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4461 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4462 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4463 cosphi1=dcos(j*phii)
4464 sinphi1=dsin(j*phii)
4465 cosphi2=dcos(j*phii1)
4466 sinphi2=dsin(j*phii1)
4467 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4468 & v2cij*cosphi2+v2sij*sinphi2
4469 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4470 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4472 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4474 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4475 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4476 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4477 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4478 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4479 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4480 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4481 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4482 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4483 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4484 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4485 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4486 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4487 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4490 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4491 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4497 c------------------------------------------------------------------------------
4498 subroutine eback_sc_corr(esccor)
4499 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4500 c conformational states; temporarily implemented as differences
4501 c between UNRES torsional potentials (dependent on three types of
4502 c residues) and the torsional potentials dependent on all 20 types
4503 c of residues computed from AM1 energy surfaces of terminally-blocked
4504 c amino-acid residues.
4505 implicit real*8 (a-h,o-z)
4506 include 'DIMENSIONS'
4507 include 'sizesclu.dat'
4508 include 'COMMON.VAR'
4509 include 'COMMON.GEO'
4510 include 'COMMON.LOCAL'
4511 include 'COMMON.TORSION'
4512 include 'COMMON.SCCOR'
4513 include 'COMMON.INTERACT'
4514 include 'COMMON.DERIV'
4515 include 'COMMON.CHAIN'
4516 include 'COMMON.NAMES'
4517 include 'COMMON.IOUNITS'
4518 include 'COMMON.FFIELD'
4519 include 'COMMON.CONTROL'
4521 C Set lprn=.true. for debugging
4524 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4526 do i=itau_start,itau_end
4527 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
4529 isccori=isccortyp(itype(i-2))
4530 isccori1=isccortyp(itype(i-1))
4532 do intertyp=1,3 !intertyp
4533 cc Added 09 May 2012 (Adasko)
4534 cc Intertyp means interaction type of backbone mainchain correlation:
4535 c 1 = SC...Ca...Ca...Ca
4536 c 2 = Ca...Ca...Ca...SC
4537 c 3 = SC...Ca...Ca...SCi
4539 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4540 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4541 & (itype(i-1).eq.ntyp1)))
4542 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4543 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4544 & .or.(itype(i).eq.ntyp1)))
4545 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4546 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4547 & (itype(i-3).eq.ntyp1)))) cycle
4548 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4549 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4551 do j=1,nterm_sccor(isccori,isccori1)
4552 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4553 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4554 cosphi=dcos(j*tauangle(intertyp,i))
4555 sinphi=dsin(j*tauangle(intertyp,i))
4556 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4557 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4559 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4560 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4562 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4563 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4564 & (v1sccor(j,1,itori,itori1),j=1,6),
4565 & (v2sccor(j,1,itori,itori1),j=1,6)
4566 gsccor_loc(i-3)=gloci
4571 c------------------------------------------------------------------------------
4572 subroutine multibody(ecorr)
4573 C This subroutine calculates multi-body contributions to energy following
4574 C the idea of Skolnick et al. If side chains I and J make a contact and
4575 C at the same time side chains I+1 and J+1 make a contact, an extra
4576 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4577 implicit real*8 (a-h,o-z)
4578 include 'DIMENSIONS'
4579 include 'COMMON.IOUNITS'
4580 include 'COMMON.DERIV'
4581 include 'COMMON.INTERACT'
4582 include 'COMMON.CONTACTS'
4583 double precision gx(3),gx1(3)
4586 C Set lprn=.true. for debugging
4590 write (iout,'(a)') 'Contact function values:'
4592 write (iout,'(i2,20(1x,i2,f10.5))')
4593 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4608 num_conti=num_cont(i)
4609 num_conti1=num_cont(i1)
4614 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4615 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4616 cd & ' ishift=',ishift
4617 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4618 C The system gains extra energy.
4619 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4620 endif ! j1==j+-ishift
4629 c------------------------------------------------------------------------------
4630 double precision function esccorr(i,j,k,l,jj,kk)
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 include 'COMMON.IOUNITS'
4634 include 'COMMON.DERIV'
4635 include 'COMMON.INTERACT'
4636 include 'COMMON.CONTACTS'
4637 double precision gx(3),gx1(3)
4642 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4643 C Calculate the multi-body contribution to energy.
4644 C Calculate multi-body contributions to the gradient.
4645 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4646 cd & k,l,(gacont(m,kk,k),m=1,3)
4648 gx(m) =ekl*gacont(m,jj,i)
4649 gx1(m)=eij*gacont(m,kk,k)
4650 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4651 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4652 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4653 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4657 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4662 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4668 c------------------------------------------------------------------------------
4670 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4671 implicit real*8 (a-h,o-z)
4672 include 'DIMENSIONS'
4673 integer dimen1,dimen2,atom,indx
4674 double precision buffer(dimen1,dimen2)
4675 double precision zapas
4676 common /contacts_hb/ zapas(3,20,maxres,7),
4677 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4678 & num_cont_hb(maxres),jcont_hb(20,maxres)
4679 num_kont=num_cont_hb(atom)
4683 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4686 buffer(i,indx+22)=facont_hb(i,atom)
4687 buffer(i,indx+23)=ees0p(i,atom)
4688 buffer(i,indx+24)=ees0m(i,atom)
4689 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4691 buffer(1,indx+26)=dfloat(num_kont)
4694 c------------------------------------------------------------------------------
4695 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4696 implicit real*8 (a-h,o-z)
4697 include 'DIMENSIONS'
4698 integer dimen1,dimen2,atom,indx
4699 double precision buffer(dimen1,dimen2)
4700 double precision zapas
4701 common /contacts_hb/ zapas(3,20,maxres,7),
4702 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4703 & num_cont_hb(maxres),jcont_hb(20,maxres)
4704 num_kont=buffer(1,indx+26)
4705 num_kont_old=num_cont_hb(atom)
4706 num_cont_hb(atom)=num_kont+num_kont_old
4711 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4714 facont_hb(ii,atom)=buffer(i,indx+22)
4715 ees0p(ii,atom)=buffer(i,indx+23)
4716 ees0m(ii,atom)=buffer(i,indx+24)
4717 jcont_hb(ii,atom)=buffer(i,indx+25)
4721 c------------------------------------------------------------------------------
4723 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4724 C This subroutine calculates multi-body contributions to hydrogen-bonding
4725 implicit real*8 (a-h,o-z)
4726 include 'DIMENSIONS'
4727 include 'sizesclu.dat'
4728 include 'COMMON.IOUNITS'
4730 include 'COMMON.INFO'
4732 include 'COMMON.FFIELD'
4733 include 'COMMON.DERIV'
4734 include 'COMMON.INTERACT'
4735 include 'COMMON.CONTACTS'
4737 parameter (max_cont=maxconts)
4738 parameter (max_dim=2*(8*3+2))
4739 parameter (msglen1=max_cont*max_dim*4)
4740 parameter (msglen2=2*msglen1)
4741 integer source,CorrelType,CorrelID,Error
4742 double precision buffer(max_cont,max_dim)
4744 double precision gx(3),gx1(3)
4747 C Set lprn=.true. for debugging
4752 if (fgProcs.le.1) goto 30
4754 write (iout,'(a)') 'Contact function values:'
4756 write (iout,'(2i3,50(1x,i2,f5.2))')
4757 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4758 & j=1,num_cont_hb(i))
4761 C Caution! Following code assumes that electrostatic interactions concerning
4762 C a given atom are split among at most two processors!
4772 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4775 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4776 if (MyRank.gt.0) then
4777 C Send correlation contributions to the preceding processor
4779 nn=num_cont_hb(iatel_s)
4780 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4781 cd write (iout,*) 'The BUFFER array:'
4783 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4785 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4787 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4788 C Clear the contacts of the atom passed to the neighboring processor
4789 nn=num_cont_hb(iatel_s+1)
4791 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4793 num_cont_hb(iatel_s)=0
4795 cd write (iout,*) 'Processor ',MyID,MyRank,
4796 cd & ' is sending correlation contribution to processor',MyID-1,
4797 cd & ' msglen=',msglen
4798 cd write (*,*) 'Processor ',MyID,MyRank,
4799 cd & ' is sending correlation contribution to processor',MyID-1,
4800 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4801 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4802 cd write (iout,*) 'Processor ',MyID,
4803 cd & ' has sent correlation contribution to processor',MyID-1,
4804 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4805 cd write (*,*) 'Processor ',MyID,
4806 cd & ' has sent correlation contribution to processor',MyID-1,
4807 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4809 endif ! (MyRank.gt.0)
4813 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4814 if (MyRank.lt.fgProcs-1) then
4815 C Receive correlation contributions from the next processor
4817 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4818 cd write (iout,*) 'Processor',MyID,
4819 cd & ' is receiving correlation contribution from processor',MyID+1,
4820 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4821 cd write (*,*) 'Processor',MyID,
4822 cd & ' is receiving correlation contribution from processor',MyID+1,
4823 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4825 do while (nbytes.le.0)
4826 call mp_probe(MyID+1,CorrelType,nbytes)
4828 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4829 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4830 cd write (iout,*) 'Processor',MyID,
4831 cd & ' has received correlation contribution from processor',MyID+1,
4832 cd & ' msglen=',msglen,' nbytes=',nbytes
4833 cd write (iout,*) 'The received BUFFER array:'
4835 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4837 if (msglen.eq.msglen1) then
4838 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4839 else if (msglen.eq.msglen2) then
4840 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4841 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4844 & 'ERROR!!!! message length changed while processing correlations.'
4846 & 'ERROR!!!! message length changed while processing correlations.'
4847 call mp_stopall(Error)
4848 endif ! msglen.eq.msglen1
4849 endif ! MyRank.lt.fgProcs-1
4856 write (iout,'(a)') 'Contact function values:'
4858 write (iout,'(2i3,50(1x,i2,f5.2))')
4859 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4860 & j=1,num_cont_hb(i))
4864 C Remove the loop below after debugging !!!
4871 C Calculate the local-electrostatic correlation terms
4872 do i=iatel_s,iatel_e+1
4874 num_conti=num_cont_hb(i)
4875 num_conti1=num_cont_hb(i+1)
4880 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4881 c & ' jj=',jj,' kk=',kk
4882 if (j1.eq.j+1 .or. j1.eq.j-1) then
4883 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4884 C The system gains extra energy.
4885 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4887 else if (j1.eq.j) then
4888 C Contacts I-J and I-(J+1) occur simultaneously.
4889 C The system loses extra energy.
4890 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4895 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4896 c & ' jj=',jj,' kk=',kk
4898 C Contacts I-J and (I+1)-J occur simultaneously.
4899 C The system loses extra energy.
4900 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4907 c------------------------------------------------------------------------------
4908 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4910 C This subroutine calculates multi-body contributions to hydrogen-bonding
4911 implicit real*8 (a-h,o-z)
4912 include 'DIMENSIONS'
4913 include 'sizesclu.dat'
4914 include 'COMMON.IOUNITS'
4916 include 'COMMON.INFO'
4918 include 'COMMON.FFIELD'
4919 include 'COMMON.DERIV'
4920 include 'COMMON.INTERACT'
4921 include 'COMMON.CONTACTS'
4923 parameter (max_cont=maxconts)
4924 parameter (max_dim=2*(8*3+2))
4925 parameter (msglen1=max_cont*max_dim*4)
4926 parameter (msglen2=2*msglen1)
4927 integer source,CorrelType,CorrelID,Error
4928 double precision buffer(max_cont,max_dim)
4930 double precision gx(3),gx1(3)
4933 C Set lprn=.true. for debugging
4939 if (fgProcs.le.1) goto 30
4941 write (iout,'(a)') 'Contact function values:'
4943 write (iout,'(2i3,50(1x,i2,f5.2))')
4944 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4945 & j=1,num_cont_hb(i))
4948 C Caution! Following code assumes that electrostatic interactions concerning
4949 C a given atom are split among at most two processors!
4959 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4962 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4963 if (MyRank.gt.0) then
4964 C Send correlation contributions to the preceding processor
4966 nn=num_cont_hb(iatel_s)
4967 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4968 cd write (iout,*) 'The BUFFER array:'
4970 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4972 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4974 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4975 C Clear the contacts of the atom passed to the neighboring processor
4976 nn=num_cont_hb(iatel_s+1)
4978 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4980 num_cont_hb(iatel_s)=0
4982 cd write (iout,*) 'Processor ',MyID,MyRank,
4983 cd & ' is sending correlation contribution to processor',MyID-1,
4984 cd & ' msglen=',msglen
4985 cd write (*,*) 'Processor ',MyID,MyRank,
4986 cd & ' is sending correlation contribution to processor',MyID-1,
4987 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4988 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4989 cd write (iout,*) 'Processor ',MyID,
4990 cd & ' has sent correlation contribution to processor',MyID-1,
4991 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4992 cd write (*,*) 'Processor ',MyID,
4993 cd & ' has sent correlation contribution to processor',MyID-1,
4994 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4996 endif ! (MyRank.gt.0)
5000 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5001 if (MyRank.lt.fgProcs-1) then
5002 C Receive correlation contributions from the next processor
5004 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5005 cd write (iout,*) 'Processor',MyID,
5006 cd & ' is receiving correlation contribution from processor',MyID+1,
5007 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5008 cd write (*,*) 'Processor',MyID,
5009 cd & ' is receiving correlation contribution from processor',MyID+1,
5010 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5012 do while (nbytes.le.0)
5013 call mp_probe(MyID+1,CorrelType,nbytes)
5015 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5016 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5017 cd write (iout,*) 'Processor',MyID,
5018 cd & ' has received correlation contribution from processor',MyID+1,
5019 cd & ' msglen=',msglen,' nbytes=',nbytes
5020 cd write (iout,*) 'The received BUFFER array:'
5022 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5024 if (msglen.eq.msglen1) then
5025 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5026 else if (msglen.eq.msglen2) then
5027 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5028 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5031 & 'ERROR!!!! message length changed while processing correlations.'
5033 & 'ERROR!!!! message length changed while processing correlations.'
5034 call mp_stopall(Error)
5035 endif ! msglen.eq.msglen1
5036 endif ! MyRank.lt.fgProcs-1
5043 write (iout,'(a)') 'Contact function values:'
5045 write (iout,'(2i3,50(1x,i2,f5.2))')
5046 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5047 & j=1,num_cont_hb(i))
5053 C Remove the loop below after debugging !!!
5060 C Calculate the dipole-dipole interaction energies
5061 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5062 do i=iatel_s,iatel_e+1
5063 num_conti=num_cont_hb(i)
5070 C Calculate the local-electrostatic correlation terms
5071 do i=iatel_s,iatel_e+1
5073 num_conti=num_cont_hb(i)
5074 num_conti1=num_cont_hb(i+1)
5079 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5080 c & ' jj=',jj,' kk=',kk
5081 if (j1.eq.j+1 .or. j1.eq.j-1) then
5082 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5083 C The system gains extra energy.
5085 sqd1=dsqrt(d_cont(jj,i))
5086 sqd2=dsqrt(d_cont(kk,i1))
5087 sred_geom = sqd1*sqd2
5088 IF (sred_geom.lt.cutoff_corr) THEN
5089 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5091 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5092 c & ' jj=',jj,' kk=',kk
5093 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5094 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5096 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5097 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5100 cd write (iout,*) 'sred_geom=',sred_geom,
5101 cd & ' ekont=',ekont,' fprim=',fprimcont
5102 call calc_eello(i,j,i+1,j1,jj,kk)
5103 if (wcorr4.gt.0.0d0)
5104 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5105 if (wcorr5.gt.0.0d0)
5106 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5107 c print *,"wcorr5",ecorr5
5108 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5109 cd write(2,*)'ijkl',i,j,i+1,j1
5110 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5111 & .or. wturn6.eq.0.0d0))then
5112 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5113 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5114 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5115 cd & 'ecorr6=',ecorr6
5116 cd write (iout,'(4e15.5)') sred_geom,
5117 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5118 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5119 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5120 else if (wturn6.gt.0.0d0
5121 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5122 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5123 eturn6=eturn6+eello_turn6(i,jj,kk)
5124 cd write (2,*) 'multibody_eello:eturn6',eturn6
5128 else if (j1.eq.j) then
5129 C Contacts I-J and I-(J+1) occur simultaneously.
5130 C The system loses extra energy.
5131 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5136 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5137 c & ' jj=',jj,' kk=',kk
5139 C Contacts I-J and (I+1)-J occur simultaneously.
5140 C The system loses extra energy.
5141 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5148 c------------------------------------------------------------------------------
5149 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5150 implicit real*8 (a-h,o-z)
5151 include 'DIMENSIONS'
5152 include 'COMMON.IOUNITS'
5153 include 'COMMON.DERIV'
5154 include 'COMMON.INTERACT'
5155 include 'COMMON.CONTACTS'
5156 double precision gx(3),gx1(3)
5166 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5167 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5168 C Following 4 lines for diagnostics.
5173 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5175 c write (iout,*)'Contacts have occurred for peptide groups',
5176 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5177 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5178 C Calculate the multi-body contribution to energy.
5179 ecorr=ecorr+ekont*ees
5181 C Calculate multi-body contributions to the gradient.
5183 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5184 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5185 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5186 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5187 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5188 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5189 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5190 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5191 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5192 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5193 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5194 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5195 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5196 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5200 gradcorr(ll,m)=gradcorr(ll,m)+
5201 & ees*ekl*gacont_hbr(ll,jj,i)-
5202 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5203 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5208 gradcorr(ll,m)=gradcorr(ll,m)+
5209 & ees*eij*gacont_hbr(ll,kk,k)-
5210 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5211 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5218 C---------------------------------------------------------------------------
5219 subroutine dipole(i,j,jj)
5220 implicit real*8 (a-h,o-z)
5221 include 'DIMENSIONS'
5222 include 'sizesclu.dat'
5223 include 'COMMON.IOUNITS'
5224 include 'COMMON.CHAIN'
5225 include 'COMMON.FFIELD'
5226 include 'COMMON.DERIV'
5227 include 'COMMON.INTERACT'
5228 include 'COMMON.CONTACTS'
5229 include 'COMMON.TORSION'
5230 include 'COMMON.VAR'
5231 include 'COMMON.GEO'
5232 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5234 iti1 = itortyp(itype(i+1))
5235 if (j.lt.nres-1) then
5236 itj1 = itortyp(itype(j+1))
5241 dipi(iii,1)=Ub2(iii,i)
5242 dipderi(iii)=Ub2der(iii,i)
5243 dipi(iii,2)=b1(iii,iti1)
5244 dipj(iii,1)=Ub2(iii,j)
5245 dipderj(iii)=Ub2der(iii,j)
5246 dipj(iii,2)=b1(iii,itj1)
5250 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5253 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5256 if (.not.calc_grad) return
5261 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5265 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5270 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5271 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5273 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5275 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5277 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5281 C---------------------------------------------------------------------------
5282 subroutine calc_eello(i,j,k,l,jj,kk)
5284 C This subroutine computes matrices and vectors needed to calculate
5285 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5287 implicit real*8 (a-h,o-z)
5288 include 'DIMENSIONS'
5289 include 'sizesclu.dat'
5290 include 'COMMON.IOUNITS'
5291 include 'COMMON.CHAIN'
5292 include 'COMMON.DERIV'
5293 include 'COMMON.INTERACT'
5294 include 'COMMON.CONTACTS'
5295 include 'COMMON.TORSION'
5296 include 'COMMON.VAR'
5297 include 'COMMON.GEO'
5298 include 'COMMON.FFIELD'
5299 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5300 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5303 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5304 cd & ' jj=',jj,' kk=',kk
5305 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5308 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5309 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5312 call transpose2(aa1(1,1),aa1t(1,1))
5313 call transpose2(aa2(1,1),aa2t(1,1))
5316 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5317 & aa1tder(1,1,lll,kkk))
5318 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5319 & aa2tder(1,1,lll,kkk))
5323 C parallel orientation of the two CA-CA-CA frames.
5325 iti=itortyp(itype(i))
5329 itk1=itortyp(itype(k+1))
5330 itj=itortyp(itype(j))
5331 if (l.lt.nres-1) then
5332 itl1=itortyp(itype(l+1))
5336 C A1 kernel(j+1) A2T
5338 cd write (iout,'(3f10.5,5x,3f10.5)')
5339 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5341 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5342 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5343 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5344 C Following matrices are needed only for 6-th order cumulants
5345 IF (wcorr6.gt.0.0d0) THEN
5346 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5347 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5348 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5349 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5350 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5351 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5352 & ADtEAderx(1,1,1,1,1,1))
5354 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5355 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5356 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5357 & ADtEA1derx(1,1,1,1,1,1))
5359 C End 6-th order cumulants
5362 cd write (2,*) 'In calc_eello6'
5364 cd write (2,*) 'iii=',iii
5366 cd write (2,*) 'kkk=',kkk
5368 cd write (2,'(3(2f10.5),5x)')
5369 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5374 call transpose2(EUgder(1,1,k),auxmat(1,1))
5375 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5376 call transpose2(EUg(1,1,k),auxmat(1,1))
5377 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5378 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5382 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5383 & EAEAderx(1,1,lll,kkk,iii,1))
5387 C A1T kernel(i+1) A2
5388 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5389 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5390 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5391 C Following matrices are needed only for 6-th order cumulants
5392 IF (wcorr6.gt.0.0d0) THEN
5393 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5394 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5395 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5396 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5397 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5398 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5399 & ADtEAderx(1,1,1,1,1,2))
5400 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5401 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5402 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5403 & ADtEA1derx(1,1,1,1,1,2))
5405 C End 6-th order cumulants
5406 call transpose2(EUgder(1,1,l),auxmat(1,1))
5407 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5408 call transpose2(EUg(1,1,l),auxmat(1,1))
5409 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5410 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5414 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5415 & EAEAderx(1,1,lll,kkk,iii,2))
5420 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5421 C They are needed only when the fifth- or the sixth-order cumulants are
5423 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5424 call transpose2(AEA(1,1,1),auxmat(1,1))
5425 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5426 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5427 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5428 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5429 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5430 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5431 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5432 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5433 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5434 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5435 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5436 call transpose2(AEA(1,1,2),auxmat(1,1))
5437 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5438 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5439 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5440 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5441 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5442 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5443 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5444 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5445 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5446 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5447 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5448 C Calculate the Cartesian derivatives of the vectors.
5452 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5453 call matvec2(auxmat(1,1),b1(1,iti),
5454 & AEAb1derx(1,lll,kkk,iii,1,1))
5455 call matvec2(auxmat(1,1),Ub2(1,i),
5456 & AEAb2derx(1,lll,kkk,iii,1,1))
5457 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5458 & AEAb1derx(1,lll,kkk,iii,2,1))
5459 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5460 & AEAb2derx(1,lll,kkk,iii,2,1))
5461 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5462 call matvec2(auxmat(1,1),b1(1,itj),
5463 & AEAb1derx(1,lll,kkk,iii,1,2))
5464 call matvec2(auxmat(1,1),Ub2(1,j),
5465 & AEAb2derx(1,lll,kkk,iii,1,2))
5466 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5467 & AEAb1derx(1,lll,kkk,iii,2,2))
5468 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5469 & AEAb2derx(1,lll,kkk,iii,2,2))
5476 C Antiparallel orientation of the two CA-CA-CA frames.
5478 iti=itortyp(itype(i))
5482 itk1=itortyp(itype(k+1))
5483 itl=itortyp(itype(l))
5484 itj=itortyp(itype(j))
5485 if (j.lt.nres-1) then
5486 itj1=itortyp(itype(j+1))
5490 C A2 kernel(j-1)T A1T
5491 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5492 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5493 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5494 C Following matrices are needed only for 6-th order cumulants
5495 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5496 & j.eq.i+4 .and. l.eq.i+3)) THEN
5497 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5498 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5499 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5500 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5501 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5502 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5503 & ADtEAderx(1,1,1,1,1,1))
5504 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5505 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5506 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5507 & ADtEA1derx(1,1,1,1,1,1))
5509 C End 6-th order cumulants
5510 call transpose2(EUgder(1,1,k),auxmat(1,1))
5511 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5512 call transpose2(EUg(1,1,k),auxmat(1,1))
5513 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5514 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5518 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5519 & EAEAderx(1,1,lll,kkk,iii,1))
5523 C A2T kernel(i+1)T A1
5524 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5525 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5526 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5527 C Following matrices are needed only for 6-th order cumulants
5528 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5529 & j.eq.i+4 .and. l.eq.i+3)) THEN
5530 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5531 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5532 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5533 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5534 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5535 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5536 & ADtEAderx(1,1,1,1,1,2))
5537 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5538 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5539 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5540 & ADtEA1derx(1,1,1,1,1,2))
5542 C End 6-th order cumulants
5543 call transpose2(EUgder(1,1,j),auxmat(1,1))
5544 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5545 call transpose2(EUg(1,1,j),auxmat(1,1))
5546 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5547 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5551 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5552 & EAEAderx(1,1,lll,kkk,iii,2))
5557 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5558 C They are needed only when the fifth- or the sixth-order cumulants are
5560 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5561 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5562 call transpose2(AEA(1,1,1),auxmat(1,1))
5563 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5564 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5565 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5566 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5567 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5568 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5569 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5570 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5571 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5572 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5573 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5574 call transpose2(AEA(1,1,2),auxmat(1,1))
5575 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5576 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5577 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5578 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5579 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5580 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5581 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5582 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5583 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5584 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5585 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5586 C Calculate the Cartesian derivatives of the vectors.
5590 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5591 call matvec2(auxmat(1,1),b1(1,iti),
5592 & AEAb1derx(1,lll,kkk,iii,1,1))
5593 call matvec2(auxmat(1,1),Ub2(1,i),
5594 & AEAb2derx(1,lll,kkk,iii,1,1))
5595 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5596 & AEAb1derx(1,lll,kkk,iii,2,1))
5597 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5598 & AEAb2derx(1,lll,kkk,iii,2,1))
5599 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5600 call matvec2(auxmat(1,1),b1(1,itl),
5601 & AEAb1derx(1,lll,kkk,iii,1,2))
5602 call matvec2(auxmat(1,1),Ub2(1,l),
5603 & AEAb2derx(1,lll,kkk,iii,1,2))
5604 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5605 & AEAb1derx(1,lll,kkk,iii,2,2))
5606 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5607 & AEAb2derx(1,lll,kkk,iii,2,2))
5616 C---------------------------------------------------------------------------
5617 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5618 & KK,KKderg,AKA,AKAderg,AKAderx)
5622 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5623 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5624 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5629 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5631 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5634 cd if (lprn) write (2,*) 'In kernel'
5636 cd if (lprn) write (2,*) 'kkk=',kkk
5638 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5639 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5641 cd write (2,*) 'lll=',lll
5642 cd write (2,*) 'iii=1'
5644 cd write (2,'(3(2f10.5),5x)')
5645 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5648 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5649 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5651 cd write (2,*) 'lll=',lll
5652 cd write (2,*) 'iii=2'
5654 cd write (2,'(3(2f10.5),5x)')
5655 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5662 C---------------------------------------------------------------------------
5663 double precision function eello4(i,j,k,l,jj,kk)
5664 implicit real*8 (a-h,o-z)
5665 include 'DIMENSIONS'
5666 include 'sizesclu.dat'
5667 include 'COMMON.IOUNITS'
5668 include 'COMMON.CHAIN'
5669 include 'COMMON.DERIV'
5670 include 'COMMON.INTERACT'
5671 include 'COMMON.CONTACTS'
5672 include 'COMMON.TORSION'
5673 include 'COMMON.VAR'
5674 include 'COMMON.GEO'
5675 double precision pizda(2,2),ggg1(3),ggg2(3)
5676 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5680 cd print *,'eello4:',i,j,k,l,jj,kk
5681 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5682 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5683 cold eij=facont_hb(jj,i)
5684 cold ekl=facont_hb(kk,k)
5686 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5688 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5689 gcorr_loc(k-1)=gcorr_loc(k-1)
5690 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5692 gcorr_loc(l-1)=gcorr_loc(l-1)
5693 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5695 gcorr_loc(j-1)=gcorr_loc(j-1)
5696 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5701 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5702 & -EAEAderx(2,2,lll,kkk,iii,1)
5703 cd derx(lll,kkk,iii)=0.0d0
5707 cd gcorr_loc(l-1)=0.0d0
5708 cd gcorr_loc(j-1)=0.0d0
5709 cd gcorr_loc(k-1)=0.0d0
5711 cd write (iout,*)'Contacts have occurred for peptide groups',
5712 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5713 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5714 if (j.lt.nres-1) then
5721 if (l.lt.nres-1) then
5729 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5730 ggg1(ll)=eel4*g_contij(ll,1)
5731 ggg2(ll)=eel4*g_contij(ll,2)
5732 ghalf=0.5d0*ggg1(ll)
5734 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5735 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5736 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5737 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5738 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5739 ghalf=0.5d0*ggg2(ll)
5741 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5742 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5743 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5744 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5749 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5750 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5755 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5756 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5762 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5767 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5771 cd write (2,*) iii,gcorr_loc(iii)
5775 cd write (2,*) 'ekont',ekont
5776 cd write (iout,*) 'eello4',ekont*eel4
5779 C---------------------------------------------------------------------------
5780 double precision function eello5(i,j,k,l,jj,kk)
5781 implicit real*8 (a-h,o-z)
5782 include 'DIMENSIONS'
5783 include 'sizesclu.dat'
5784 include 'COMMON.IOUNITS'
5785 include 'COMMON.CHAIN'
5786 include 'COMMON.DERIV'
5787 include 'COMMON.INTERACT'
5788 include 'COMMON.CONTACTS'
5789 include 'COMMON.TORSION'
5790 include 'COMMON.VAR'
5791 include 'COMMON.GEO'
5792 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5793 double precision ggg1(3),ggg2(3)
5794 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5799 C /l\ / \ \ / \ / \ / C
5800 C / \ / \ \ / \ / \ / C
5801 C j| o |l1 | o | o| o | | o |o C
5802 C \ |/k\| |/ \| / |/ \| |/ \| C
5803 C \i/ \ / \ / / \ / \ C
5805 C (I) (II) (III) (IV) C
5807 C eello5_1 eello5_2 eello5_3 eello5_4 C
5809 C Antiparallel chains C
5812 C /j\ / \ \ / \ / \ / C
5813 C / \ / \ \ / \ / \ / C
5814 C j1| o |l | o | o| o | | o |o C
5815 C \ |/k\| |/ \| / |/ \| |/ \| C
5816 C \i/ \ / \ / / \ / \ C
5818 C (I) (II) (III) (IV) C
5820 C eello5_1 eello5_2 eello5_3 eello5_4 C
5822 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5824 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5825 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5830 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5832 itk=itortyp(itype(k))
5833 itl=itortyp(itype(l))
5834 itj=itortyp(itype(j))
5839 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5840 cd & eel5_3_num,eel5_4_num)
5844 derx(lll,kkk,iii)=0.0d0
5848 cd eij=facont_hb(jj,i)
5849 cd ekl=facont_hb(kk,k)
5851 cd write (iout,*)'Contacts have occurred for peptide groups',
5852 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5854 C Contribution from the graph I.
5855 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5856 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5857 call transpose2(EUg(1,1,k),auxmat(1,1))
5858 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5859 vv(1)=pizda(1,1)-pizda(2,2)
5860 vv(2)=pizda(1,2)+pizda(2,1)
5861 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5862 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5864 C Explicit gradient in virtual-dihedral angles.
5865 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5866 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5867 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5868 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5869 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5870 vv(1)=pizda(1,1)-pizda(2,2)
5871 vv(2)=pizda(1,2)+pizda(2,1)
5872 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5873 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5874 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5875 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5876 vv(1)=pizda(1,1)-pizda(2,2)
5877 vv(2)=pizda(1,2)+pizda(2,1)
5879 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5880 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5881 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5883 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5884 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5885 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5887 C Cartesian gradient
5891 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5893 vv(1)=pizda(1,1)-pizda(2,2)
5894 vv(2)=pizda(1,2)+pizda(2,1)
5895 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5896 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5897 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5904 C Contribution from graph II
5905 call transpose2(EE(1,1,itk),auxmat(1,1))
5906 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5907 vv(1)=pizda(1,1)+pizda(2,2)
5908 vv(2)=pizda(2,1)-pizda(1,2)
5909 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5910 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5912 C Explicit gradient in virtual-dihedral angles.
5913 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5914 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5915 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5916 vv(1)=pizda(1,1)+pizda(2,2)
5917 vv(2)=pizda(2,1)-pizda(1,2)
5919 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5920 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5921 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5923 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5924 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5925 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5927 C Cartesian gradient
5931 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5933 vv(1)=pizda(1,1)+pizda(2,2)
5934 vv(2)=pizda(2,1)-pizda(1,2)
5935 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5936 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5937 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5946 C Parallel orientation
5947 C Contribution from graph III
5948 call transpose2(EUg(1,1,l),auxmat(1,1))
5949 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5950 vv(1)=pizda(1,1)-pizda(2,2)
5951 vv(2)=pizda(1,2)+pizda(2,1)
5952 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5953 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5955 C Explicit gradient in virtual-dihedral angles.
5956 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5957 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5958 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5959 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5960 vv(1)=pizda(1,1)-pizda(2,2)
5961 vv(2)=pizda(1,2)+pizda(2,1)
5962 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5963 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5964 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5965 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5966 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5967 vv(1)=pizda(1,1)-pizda(2,2)
5968 vv(2)=pizda(1,2)+pizda(2,1)
5969 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5970 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5971 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5972 C Cartesian gradient
5976 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5978 vv(1)=pizda(1,1)-pizda(2,2)
5979 vv(2)=pizda(1,2)+pizda(2,1)
5980 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5981 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5982 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5988 C Contribution from graph IV
5990 call transpose2(EE(1,1,itl),auxmat(1,1))
5991 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5992 vv(1)=pizda(1,1)+pizda(2,2)
5993 vv(2)=pizda(2,1)-pizda(1,2)
5994 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5995 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5997 C Explicit gradient in virtual-dihedral angles.
5998 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5999 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6000 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6001 vv(1)=pizda(1,1)+pizda(2,2)
6002 vv(2)=pizda(2,1)-pizda(1,2)
6003 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6004 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6005 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6006 C Cartesian gradient
6010 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6012 vv(1)=pizda(1,1)+pizda(2,2)
6013 vv(2)=pizda(2,1)-pizda(1,2)
6014 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6015 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6016 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6022 C Antiparallel orientation
6023 C Contribution from graph III
6025 call transpose2(EUg(1,1,j),auxmat(1,1))
6026 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6027 vv(1)=pizda(1,1)-pizda(2,2)
6028 vv(2)=pizda(1,2)+pizda(2,1)
6029 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6030 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6032 C Explicit gradient in virtual-dihedral angles.
6033 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6034 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6035 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6036 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6037 vv(1)=pizda(1,1)-pizda(2,2)
6038 vv(2)=pizda(1,2)+pizda(2,1)
6039 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6040 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6041 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6042 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6043 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6044 vv(1)=pizda(1,1)-pizda(2,2)
6045 vv(2)=pizda(1,2)+pizda(2,1)
6046 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6047 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6048 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6049 C Cartesian gradient
6053 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6055 vv(1)=pizda(1,1)-pizda(2,2)
6056 vv(2)=pizda(1,2)+pizda(2,1)
6057 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6058 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6059 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6065 C Contribution from graph IV
6067 call transpose2(EE(1,1,itj),auxmat(1,1))
6068 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6069 vv(1)=pizda(1,1)+pizda(2,2)
6070 vv(2)=pizda(2,1)-pizda(1,2)
6071 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6072 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6074 C Explicit gradient in virtual-dihedral angles.
6075 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6076 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6077 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6078 vv(1)=pizda(1,1)+pizda(2,2)
6079 vv(2)=pizda(2,1)-pizda(1,2)
6080 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6081 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6082 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6083 C Cartesian gradient
6087 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6089 vv(1)=pizda(1,1)+pizda(2,2)
6090 vv(2)=pizda(2,1)-pizda(1,2)
6091 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6092 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6093 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6100 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6101 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6102 cd write (2,*) 'ijkl',i,j,k,l
6103 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6104 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6106 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6107 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6108 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6109 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6111 if (j.lt.nres-1) then
6118 if (l.lt.nres-1) then
6128 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6130 ggg1(ll)=eel5*g_contij(ll,1)
6131 ggg2(ll)=eel5*g_contij(ll,2)
6132 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6133 ghalf=0.5d0*ggg1(ll)
6135 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6136 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6137 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6138 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6139 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6140 ghalf=0.5d0*ggg2(ll)
6142 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6143 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6144 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6145 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6150 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6151 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6156 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6157 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6163 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6168 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6172 cd write (2,*) iii,g_corr5_loc(iii)
6176 cd write (2,*) 'ekont',ekont
6177 cd write (iout,*) 'eello5',ekont*eel5
6180 c--------------------------------------------------------------------------
6181 double precision function eello6(i,j,k,l,jj,kk)
6182 implicit real*8 (a-h,o-z)
6183 include 'DIMENSIONS'
6184 include 'sizesclu.dat'
6185 include 'COMMON.IOUNITS'
6186 include 'COMMON.CHAIN'
6187 include 'COMMON.DERIV'
6188 include 'COMMON.INTERACT'
6189 include 'COMMON.CONTACTS'
6190 include 'COMMON.TORSION'
6191 include 'COMMON.VAR'
6192 include 'COMMON.GEO'
6193 include 'COMMON.FFIELD'
6194 double precision ggg1(3),ggg2(3)
6195 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6200 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6208 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6209 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6213 derx(lll,kkk,iii)=0.0d0
6217 cd eij=facont_hb(jj,i)
6218 cd ekl=facont_hb(kk,k)
6224 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6225 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6226 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6227 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6228 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6229 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6231 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6232 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6233 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6234 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6235 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6236 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6240 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6242 C If turn contributions are considered, they will be handled separately.
6243 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6244 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6245 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6246 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6247 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6248 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6249 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6252 if (j.lt.nres-1) then
6259 if (l.lt.nres-1) then
6267 ggg1(ll)=eel6*g_contij(ll,1)
6268 ggg2(ll)=eel6*g_contij(ll,2)
6269 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6270 ghalf=0.5d0*ggg1(ll)
6272 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6273 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6274 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6275 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6276 ghalf=0.5d0*ggg2(ll)
6277 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6279 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6280 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6281 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6282 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6287 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6288 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6293 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6294 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6300 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6305 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6309 cd write (2,*) iii,g_corr6_loc(iii)
6313 cd write (2,*) 'ekont',ekont
6314 cd write (iout,*) 'eello6',ekont*eel6
6317 c--------------------------------------------------------------------------
6318 double precision function eello6_graph1(i,j,k,l,imat,swap)
6319 implicit real*8 (a-h,o-z)
6320 include 'DIMENSIONS'
6321 include 'sizesclu.dat'
6322 include 'COMMON.IOUNITS'
6323 include 'COMMON.CHAIN'
6324 include 'COMMON.DERIV'
6325 include 'COMMON.INTERACT'
6326 include 'COMMON.CONTACTS'
6327 include 'COMMON.TORSION'
6328 include 'COMMON.VAR'
6329 include 'COMMON.GEO'
6330 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6334 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6336 C Parallel Antiparallel C
6342 C \ j|/k\| / \ |/k\|l / C
6347 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6348 itk=itortyp(itype(k))
6349 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6350 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6351 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6352 call transpose2(EUgC(1,1,k),auxmat(1,1))
6353 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6354 vv1(1)=pizda1(1,1)-pizda1(2,2)
6355 vv1(2)=pizda1(1,2)+pizda1(2,1)
6356 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6357 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6358 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6359 s5=scalar2(vv(1),Dtobr2(1,i))
6360 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6361 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6362 if (.not. calc_grad) return
6363 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6364 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6365 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6366 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6367 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6368 & +scalar2(vv(1),Dtobr2der(1,i)))
6369 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6370 vv1(1)=pizda1(1,1)-pizda1(2,2)
6371 vv1(2)=pizda1(1,2)+pizda1(2,1)
6372 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6373 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6375 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6376 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6377 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6378 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6379 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6381 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6382 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6383 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6384 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6385 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6387 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6388 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6389 vv1(1)=pizda1(1,1)-pizda1(2,2)
6390 vv1(2)=pizda1(1,2)+pizda1(2,1)
6391 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6392 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6393 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6394 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6403 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6404 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6405 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6406 call transpose2(EUgC(1,1,k),auxmat(1,1))
6407 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6409 vv1(1)=pizda1(1,1)-pizda1(2,2)
6410 vv1(2)=pizda1(1,2)+pizda1(2,1)
6411 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6412 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6413 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6414 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6415 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6416 s5=scalar2(vv(1),Dtobr2(1,i))
6417 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6423 c----------------------------------------------------------------------------
6424 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6425 implicit real*8 (a-h,o-z)
6426 include 'DIMENSIONS'
6427 include 'sizesclu.dat'
6428 include 'COMMON.IOUNITS'
6429 include 'COMMON.CHAIN'
6430 include 'COMMON.DERIV'
6431 include 'COMMON.INTERACT'
6432 include 'COMMON.CONTACTS'
6433 include 'COMMON.TORSION'
6434 include 'COMMON.VAR'
6435 include 'COMMON.GEO'
6437 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6438 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6443 C Parallel Antiparallel C
6449 C \ j|/k\| \ |/k\|l C
6454 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6455 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6456 C AL 7/4/01 s1 would occur in the sixth-order moment,
6457 C but not in a cluster cumulant
6459 s1=dip(1,jj,i)*dip(1,kk,k)
6461 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6462 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6463 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6464 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6465 call transpose2(EUg(1,1,k),auxmat(1,1))
6466 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6467 vv(1)=pizda(1,1)-pizda(2,2)
6468 vv(2)=pizda(1,2)+pizda(2,1)
6469 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6470 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6472 eello6_graph2=-(s1+s2+s3+s4)
6474 eello6_graph2=-(s2+s3+s4)
6477 if (.not. calc_grad) return
6478 C Derivatives in gamma(i-1)
6481 s1=dipderg(1,jj,i)*dip(1,kk,k)
6483 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6484 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6485 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6486 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6488 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6490 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6492 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6494 C Derivatives in gamma(k-1)
6496 s1=dip(1,jj,i)*dipderg(1,kk,k)
6498 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6499 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6500 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6501 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6502 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6503 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6504 vv(1)=pizda(1,1)-pizda(2,2)
6505 vv(2)=pizda(1,2)+pizda(2,1)
6506 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6508 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6510 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6512 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6513 C Derivatives in gamma(j-1) or gamma(l-1)
6516 s1=dipderg(3,jj,i)*dip(1,kk,k)
6518 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6519 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6520 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6521 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6522 vv(1)=pizda(1,1)-pizda(2,2)
6523 vv(2)=pizda(1,2)+pizda(2,1)
6524 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6527 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6529 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6532 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6533 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6535 C Derivatives in gamma(l-1) or gamma(j-1)
6538 s1=dip(1,jj,i)*dipderg(3,kk,k)
6540 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6541 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6542 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6543 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6544 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6545 vv(1)=pizda(1,1)-pizda(2,2)
6546 vv(2)=pizda(1,2)+pizda(2,1)
6547 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6552 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6555 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6556 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6558 C Cartesian derivatives.
6560 write (2,*) 'In eello6_graph2'
6562 write (2,*) 'iii=',iii
6564 write (2,*) 'kkk=',kkk
6566 write (2,'(3(2f10.5),5x)')
6567 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6577 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6579 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6582 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6584 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6585 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6587 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6588 call transpose2(EUg(1,1,k),auxmat(1,1))
6589 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6591 vv(1)=pizda(1,1)-pizda(2,2)
6592 vv(2)=pizda(1,2)+pizda(2,1)
6593 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6594 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6596 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6598 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6601 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6603 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6610 c----------------------------------------------------------------------------
6611 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6612 implicit real*8 (a-h,o-z)
6613 include 'DIMENSIONS'
6614 include 'sizesclu.dat'
6615 include 'COMMON.IOUNITS'
6616 include 'COMMON.CHAIN'
6617 include 'COMMON.DERIV'
6618 include 'COMMON.INTERACT'
6619 include 'COMMON.CONTACTS'
6620 include 'COMMON.TORSION'
6621 include 'COMMON.VAR'
6622 include 'COMMON.GEO'
6623 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6625 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6627 C Parallel Antiparallel C
6633 C j|/k\| / |/k\|l / C
6638 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6640 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6641 C energy moment and not to the cluster cumulant.
6642 iti=itortyp(itype(i))
6643 if (j.lt.nres-1) then
6644 itj1=itortyp(itype(j+1))
6648 itk=itortyp(itype(k))
6649 itk1=itortyp(itype(k+1))
6650 if (l.lt.nres-1) then
6651 itl1=itortyp(itype(l+1))
6656 s1=dip(4,jj,i)*dip(4,kk,k)
6658 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6659 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6660 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6661 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6662 call transpose2(EE(1,1,itk),auxmat(1,1))
6663 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6664 vv(1)=pizda(1,1)+pizda(2,2)
6665 vv(2)=pizda(2,1)-pizda(1,2)
6666 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6667 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6669 eello6_graph3=-(s1+s2+s3+s4)
6671 eello6_graph3=-(s2+s3+s4)
6674 if (.not. calc_grad) return
6675 C Derivatives in gamma(k-1)
6676 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6677 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6678 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6679 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6680 C Derivatives in gamma(l-1)
6681 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6682 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6683 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6684 vv(1)=pizda(1,1)+pizda(2,2)
6685 vv(2)=pizda(2,1)-pizda(1,2)
6686 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6687 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6688 C Cartesian derivatives.
6694 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6696 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6699 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6701 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6702 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6704 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6705 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6707 vv(1)=pizda(1,1)+pizda(2,2)
6708 vv(2)=pizda(2,1)-pizda(1,2)
6709 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6718 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6720 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6726 c----------------------------------------------------------------------------
6727 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6728 implicit real*8 (a-h,o-z)
6729 include 'DIMENSIONS'
6730 include 'sizesclu.dat'
6731 include 'COMMON.IOUNITS'
6732 include 'COMMON.CHAIN'
6733 include 'COMMON.DERIV'
6734 include 'COMMON.INTERACT'
6735 include 'COMMON.CONTACTS'
6736 include 'COMMON.TORSION'
6737 include 'COMMON.VAR'
6738 include 'COMMON.GEO'
6739 include 'COMMON.FFIELD'
6740 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6741 & auxvec1(2),auxmat1(2,2)
6743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6745 C Parallel Antiparallel C
6751 C \ j|/k\| \ |/k\|l C
6756 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6758 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6759 C energy moment and not to the cluster cumulant.
6760 cd write (2,*) 'eello_graph4: wturn6',wturn6
6761 iti=itortyp(itype(i))
6762 itj=itortyp(itype(j))
6763 if (j.lt.nres-1) then
6764 itj1=itortyp(itype(j+1))
6768 itk=itortyp(itype(k))
6769 if (k.lt.nres-1) then
6770 itk1=itortyp(itype(k+1))
6774 itl=itortyp(itype(l))
6775 if (l.lt.nres-1) then
6776 itl1=itortyp(itype(l+1))
6780 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6781 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6782 cd & ' itl',itl,' itl1',itl1
6785 s1=dip(3,jj,i)*dip(3,kk,k)
6787 s1=dip(2,jj,j)*dip(2,kk,l)
6790 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6791 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6793 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6794 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6796 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6797 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6799 call transpose2(EUg(1,1,k),auxmat(1,1))
6800 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6801 vv(1)=pizda(1,1)-pizda(2,2)
6802 vv(2)=pizda(2,1)+pizda(1,2)
6803 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6804 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6806 eello6_graph4=-(s1+s2+s3+s4)
6808 eello6_graph4=-(s2+s3+s4)
6810 if (.not. calc_grad) return
6811 C Derivatives in gamma(i-1)
6815 s1=dipderg(2,jj,i)*dip(3,kk,k)
6817 s1=dipderg(4,jj,j)*dip(2,kk,l)
6820 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6822 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6823 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6825 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6826 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6828 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6829 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6830 cd write (2,*) 'turn6 derivatives'
6832 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6834 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6838 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6840 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6844 C Derivatives in gamma(k-1)
6847 s1=dip(3,jj,i)*dipderg(2,kk,k)
6849 s1=dip(2,jj,j)*dipderg(4,kk,l)
6852 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6853 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6855 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6856 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6858 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6859 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6861 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6862 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6863 vv(1)=pizda(1,1)-pizda(2,2)
6864 vv(2)=pizda(2,1)+pizda(1,2)
6865 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6866 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6868 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6870 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6874 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6876 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6879 C Derivatives in gamma(j-1) or gamma(l-1)
6880 if (l.eq.j+1 .and. l.gt.1) then
6881 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6882 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6883 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6884 vv(1)=pizda(1,1)-pizda(2,2)
6885 vv(2)=pizda(2,1)+pizda(1,2)
6886 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6887 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6888 else if (j.gt.1) then
6889 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6890 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6891 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6892 vv(1)=pizda(1,1)-pizda(2,2)
6893 vv(2)=pizda(2,1)+pizda(1,2)
6894 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6895 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6896 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6898 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6901 C Cartesian derivatives.
6908 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6910 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6914 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6916 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6920 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6922 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6924 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6925 & b1(1,itj1),auxvec(1))
6926 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6928 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6929 & b1(1,itl1),auxvec(1))
6930 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6932 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6934 vv(1)=pizda(1,1)-pizda(2,2)
6935 vv(2)=pizda(2,1)+pizda(1,2)
6936 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6938 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6940 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6943 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6946 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6951 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6953 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6959 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6962 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6964 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6972 c----------------------------------------------------------------------------
6973 double precision function eello_turn6(i,jj,kk)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'sizesclu.dat'
6977 include 'COMMON.IOUNITS'
6978 include 'COMMON.CHAIN'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6985 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6986 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6988 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6989 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6990 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6991 C the respective energy moment and not to the cluster cumulant.
6996 iti=itortyp(itype(i))
6997 itk=itortyp(itype(k))
6998 itk1=itortyp(itype(k+1))
6999 itl=itortyp(itype(l))
7000 itj=itortyp(itype(j))
7001 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7002 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7003 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7008 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7010 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7014 derx_turn(lll,kkk,iii)=0.0d0
7021 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7023 cd write (2,*) 'eello6_5',eello6_5
7025 call transpose2(AEA(1,1,1),auxmat(1,1))
7026 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7027 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7028 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7032 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7033 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7034 s2 = scalar2(b1(1,itk),vtemp1(1))
7036 call transpose2(AEA(1,1,2),atemp(1,1))
7037 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7038 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7039 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7043 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7044 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7045 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7047 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7048 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7049 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7050 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7051 ss13 = scalar2(b1(1,itk),vtemp4(1))
7052 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7056 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7062 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7064 C Derivatives in gamma(i+2)
7066 call transpose2(AEA(1,1,1),auxmatd(1,1))
7067 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7068 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7069 call transpose2(AEAderg(1,1,2),atempd(1,1))
7070 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7071 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7075 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7076 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7077 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7083 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7084 C Derivatives in gamma(i+3)
7086 call transpose2(AEA(1,1,1),auxmatd(1,1))
7087 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7088 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7089 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7093 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7094 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7095 s2d = scalar2(b1(1,itk),vtemp1d(1))
7097 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7098 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7100 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7102 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7103 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7104 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7114 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7115 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7117 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7118 & -0.5d0*ekont*(s2d+s12d)
7120 C Derivatives in gamma(i+4)
7121 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7122 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7123 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7125 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7126 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7127 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7137 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7139 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7141 C Derivatives in gamma(i+5)
7143 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7144 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7145 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7149 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7150 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7151 s2d = scalar2(b1(1,itk),vtemp1d(1))
7153 call transpose2(AEA(1,1,2),atempd(1,1))
7154 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7155 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7159 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7160 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7162 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7163 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7164 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7174 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7175 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7177 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7178 & -0.5d0*ekont*(s2d+s12d)
7180 C Cartesian derivatives
7185 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7186 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7187 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7191 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7192 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7194 s2d = scalar2(b1(1,itk),vtemp1d(1))
7196 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7197 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7198 s8d = -(atempd(1,1)+atempd(2,2))*
7199 & scalar2(cc(1,1,itl),vtemp2(1))
7203 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7205 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7206 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7213 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7216 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7220 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7221 & - 0.5d0*(s8d+s12d)
7223 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7232 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7234 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7235 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7236 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7237 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7238 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7240 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7241 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7242 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7246 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7247 cd & 16*eel_turn6_num
7249 if (j.lt.nres-1) then
7256 if (l.lt.nres-1) then
7264 ggg1(ll)=eel_turn6*g_contij(ll,1)
7265 ggg2(ll)=eel_turn6*g_contij(ll,2)
7266 ghalf=0.5d0*ggg1(ll)
7268 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7269 & +ekont*derx_turn(ll,2,1)
7270 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7271 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7272 & +ekont*derx_turn(ll,4,1)
7273 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7274 ghalf=0.5d0*ggg2(ll)
7276 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7277 & +ekont*derx_turn(ll,2,2)
7278 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7279 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7280 & +ekont*derx_turn(ll,4,2)
7281 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7286 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7291 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7297 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7302 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7306 cd write (2,*) iii,g_corr6_loc(iii)
7309 eello_turn6=ekont*eel_turn6
7310 cd write (2,*) 'ekont',ekont
7311 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7314 crc-------------------------------------------------
7315 SUBROUTINE MATVEC2(A1,V1,V2)
7316 implicit real*8 (a-h,o-z)
7317 include 'DIMENSIONS'
7318 DIMENSION A1(2,2),V1(2),V2(2)
7322 c 3 VI=VI+A1(I,K)*V1(K)
7326 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7327 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7332 C---------------------------------------
7333 SUBROUTINE MATMAT2(A1,A2,A3)
7334 implicit real*8 (a-h,o-z)
7335 include 'DIMENSIONS'
7336 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7337 c DIMENSION AI3(2,2)
7341 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7347 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7348 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7349 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7350 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7358 c-------------------------------------------------------------------------
7359 double precision function scalar2(u,v)
7361 double precision u(2),v(2)
7364 scalar2=u(1)*v(1)+u(2)*v(2)
7368 C-----------------------------------------------------------------------------
7370 subroutine transpose2(a,at)
7372 double precision a(2,2),at(2,2)
7379 c--------------------------------------------------------------------------
7380 subroutine transpose(n,a,at)
7383 double precision a(n,n),at(n,n)
7391 C---------------------------------------------------------------------------
7392 subroutine prodmat3(a1,a2,kk,transp,prod)
7395 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7397 crc double precision auxmat(2,2),prod_(2,2)
7400 crc call transpose2(kk(1,1),auxmat(1,1))
7401 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7402 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7404 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7405 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7406 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7407 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7408 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7409 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7410 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7411 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7414 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7415 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7417 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7418 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7419 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7420 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7421 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7422 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7423 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7424 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7427 c call transpose2(a2(1,1),a2t(1,1))
7430 crc print *,((prod_(i,j),i=1,2),j=1,2)
7431 crc print *,((prod(i,j),i=1,2),j=1,2)
7435 C-----------------------------------------------------------------------------
7436 double precision function scalar(u,v)
7438 double precision u(3),v(3)