1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 & +wsccor*fact(1)*gsccor_loc(i)
236 C------------------------------------------------------------------------
237 subroutine enerprint(energia,fact)
238 implicit real*8 (a-h,o-z)
240 include 'DIMENSIONS.ZSCOPT'
241 include 'COMMON.IOUNITS'
242 include 'COMMON.FFIELD'
243 include 'COMMON.SBRIDGE'
244 double precision energia(0:max_ene),fact(6)
246 evdw=energia(1)+fact(6)*energia(21)
248 evdw2=energia(2)+energia(17)
260 eello_turn3=energia(8)
261 eello_turn4=energia(9)
262 eello_turn6=energia(10)
269 edihcnstr=energia(20)
272 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
274 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
275 & etors_d,wtor_d*fact(2),ehpb,wstrain,
276 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
277 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
278 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
279 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
280 10 format (/'Virtual-chain energies:'//
281 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
282 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
283 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
284 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
285 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
286 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
287 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
288 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
289 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
290 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
291 & ' (SS bridges & dist. cnstr.)'/
292 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
296 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
297 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
298 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
299 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
300 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
301 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
302 & 'ETOT= ',1pE16.6,' (total)')
304 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
305 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
306 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
307 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
308 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
309 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
310 & edihcnstr,ebr*nss,etot
311 10 format (/'Virtual-chain energies:'//
312 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
313 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
314 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
315 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
316 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
317 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
318 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
319 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
320 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
321 & ' (SS bridges & dist. cnstr.)'/
322 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
326 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
327 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
328 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
329 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
330 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
331 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
332 & 'ETOT= ',1pE16.6,' (total)')
336 C-----------------------------------------------------------------------
337 subroutine elj(evdw,evdw_t)
339 C This subroutine calculates the interaction energy of nonbonded side chains
340 C assuming the LJ potential of interaction.
342 implicit real*8 (a-h,o-z)
344 include 'DIMENSIONS.ZSCOPT'
345 include "DIMENSIONS.COMPAR"
346 parameter (accur=1.0d-10)
349 include 'COMMON.LOCAL'
350 include 'COMMON.CHAIN'
351 include 'COMMON.DERIV'
352 include 'COMMON.INTERACT'
353 include 'COMMON.TORSION'
354 include 'COMMON.ENEPS'
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
365 eneps_temp(j,i)=0.0d0
372 itypi1=iabs(itype(i+1))
379 C Calculate SC interaction energy.
382 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
383 cd & 'iend=',iend(i,iint)
384 do j=istart(i,iint),iend(i,iint)
389 C Change 12/1/95 to calculate four-body interactions
390 rij=xj*xj+yj*yj+zj*zj
392 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
393 eps0ij=eps(itypi,itypj)
395 e1=fac*fac*aa(itypi,itypj)
396 e2=fac*bb(itypi,itypj)
398 ij=icant(itypi,itypj)
399 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
400 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
401 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
402 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
403 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
404 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
405 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
406 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
407 if (bb(itypi,itypj).gt.0.0d0) then
414 C Calculate the components of the gradient in DC and X
416 fac=-rrij*(e1+evdwij)
421 gvdwx(k,i)=gvdwx(k,i)-gg(k)
422 gvdwx(k,j)=gvdwx(k,j)+gg(k)
426 gvdwc(l,k)=gvdwc(l,k)+gg(l)
431 C 12/1/95, revised on 5/20/97
433 C Calculate the contact function. The ith column of the array JCONT will
434 C contain the numbers of atoms that make contacts with the atom I (of numbers
435 C greater than I). The arrays FACONT and GACONT will contain the values of
436 C the contact function and its derivative.
438 C Uncomment next line, if the correlation interactions include EVDW explicitly.
439 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
440 C Uncomment next line, if the correlation interactions are contact function only
441 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
443 sigij=sigma(itypi,itypj)
444 r0ij=rs0(itypi,itypj)
446 C Check whether the SC's are not too far to make a contact.
449 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
450 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
452 if (fcont.gt.0.0D0) then
453 C If the SC-SC distance if close to sigma, apply spline.
454 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
455 cAdam & fcont1,fprimcont1)
456 cAdam fcont1=1.0d0-fcont1
457 cAdam if (fcont1.gt.0.0d0) then
458 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
459 cAdam fcont=fcont*fcont1
461 C Uncomment following 4 lines to have the geometric average of the epsilon0's
462 cga eps0ij=1.0d0/dsqrt(eps0ij)
464 cga gg(k)=gg(k)*eps0ij
466 cga eps0ij=-evdwij*eps0ij
467 C Uncomment for AL's type of SC correlation interactions.
469 num_conti=num_conti+1
471 facont(num_conti,i)=fcont*eps0ij
472 fprimcont=eps0ij*fprimcont/rij
474 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
475 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
476 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
477 C Uncomment following 3 lines for Skolnick's type of SC correlation.
478 gacont(1,num_conti,i)=-fprimcont*xj
479 gacont(2,num_conti,i)=-fprimcont*yj
480 gacont(3,num_conti,i)=-fprimcont*zj
481 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
482 cd write (iout,'(2i3,3f10.5)')
483 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
489 num_cont(i)=num_conti
494 gvdwc(j,i)=expon*gvdwc(j,i)
495 gvdwx(j,i)=expon*gvdwx(j,i)
499 C******************************************************************************
503 C To save time, the factor of EXPON has been extracted from ALL components
504 C of GVDWC and GRADX. Remember to multiply them by this factor before further
507 C******************************************************************************
510 C-----------------------------------------------------------------------------
511 subroutine eljk(evdw,evdw_t)
513 C This subroutine calculates the interaction energy of nonbonded side chains
514 C assuming the LJK potential of interaction.
516 implicit real*8 (a-h,o-z)
518 include 'DIMENSIONS.ZSCOPT'
519 include "DIMENSIONS.COMPAR"
522 include 'COMMON.LOCAL'
523 include 'COMMON.CHAIN'
524 include 'COMMON.DERIV'
525 include 'COMMON.INTERACT'
526 include 'COMMON.ENEPS'
527 include 'COMMON.IOUNITS'
528 include 'COMMON.NAMES'
533 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
536 eneps_temp(j,i)=0.0d0
543 itypi1=iabs(itype(i+1))
548 C Calculate SC interaction energy.
551 do j=istart(i,iint),iend(i,iint)
556 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
558 e_augm=augm(itypi,itypj)*fac_augm
561 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
562 fac=r_shift_inv**expon
563 e1=fac*fac*aa(itypi,itypj)
564 e2=fac*bb(itypi,itypj)
566 ij=icant(itypi,itypj)
567 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
568 & /dabs(eps(itypi,itypj))
569 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
570 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
571 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
572 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
573 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
574 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
575 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
576 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
577 if (bb(itypi,itypj).gt.0.0d0) then
584 C Calculate the components of the gradient in DC and X
586 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
591 gvdwx(k,i)=gvdwx(k,i)-gg(k)
592 gvdwx(k,j)=gvdwx(k,j)+gg(k)
596 gvdwc(l,k)=gvdwc(l,k)+gg(l)
606 gvdwc(j,i)=expon*gvdwc(j,i)
607 gvdwx(j,i)=expon*gvdwx(j,i)
613 C-----------------------------------------------------------------------------
614 subroutine ebp(evdw,evdw_t)
616 C This subroutine calculates the interaction energy of nonbonded side chains
617 C assuming the Berne-Pechukas potential of interaction.
619 implicit real*8 (a-h,o-z)
621 include 'DIMENSIONS.ZSCOPT'
622 include "DIMENSIONS.COMPAR"
625 include 'COMMON.LOCAL'
626 include 'COMMON.CHAIN'
627 include 'COMMON.DERIV'
628 include 'COMMON.NAMES'
629 include 'COMMON.INTERACT'
630 include 'COMMON.ENEPS'
631 include 'COMMON.IOUNITS'
632 include 'COMMON.CALC'
634 c double precision rrsave(maxdim)
640 eneps_temp(j,i)=0.0d0
645 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
646 c if (icall.eq.0) then
654 itypi1=iabs(itype(i+1))
658 dxi=dc_norm(1,nres+i)
659 dyi=dc_norm(2,nres+i)
660 dzi=dc_norm(3,nres+i)
661 dsci_inv=vbld_inv(i+nres)
663 C Calculate SC interaction energy.
666 do j=istart(i,iint),iend(i,iint)
669 dscj_inv=vbld_inv(j+nres)
670 chi1=chi(itypi,itypj)
671 chi2=chi(itypj,itypi)
678 alf12=0.5D0*(alf1+alf2)
679 C For diagnostics only!!!
692 dxj=dc_norm(1,nres+j)
693 dyj=dc_norm(2,nres+j)
694 dzj=dc_norm(3,nres+j)
695 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
696 cd if (icall.eq.0) then
702 C Calculate the angle-dependent terms of energy & contributions to derivatives.
704 C Calculate whole angle-dependent part of epsilon and contributions
706 fac=(rrij*sigsq)**expon2
707 e1=fac*fac*aa(itypi,itypj)
708 e2=fac*bb(itypi,itypj)
709 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
710 eps2der=evdwij*eps3rt
711 eps3der=evdwij*eps2rt
712 evdwij=evdwij*eps2rt*eps3rt
713 ij=icant(itypi,itypj)
714 aux=eps1*eps2rt**2*eps3rt**2
715 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
716 & /dabs(eps(itypi,itypj))
717 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
718 if (bb(itypi,itypj).gt.0.0d0) then
725 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
726 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
727 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
728 cd & restyp(itypi),i,restyp(itypj),j,
729 cd & epsi,sigm,chi1,chi2,chip1,chip2,
730 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
731 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
734 C Calculate gradient components.
735 e1=e1*eps1*eps2rt**2*eps3rt**2
736 fac=-expon*(e1+evdwij)
739 C Calculate radial part of the gradient
743 C Calculate the angular part of the gradient and sum add the contributions
744 C to the appropriate components of the Cartesian gradient.
753 C-----------------------------------------------------------------------------
754 subroutine egb(evdw,evdw_t)
756 C This subroutine calculates the interaction energy of nonbonded side chains
757 C assuming the Gay-Berne potential of interaction.
759 implicit real*8 (a-h,o-z)
761 include 'DIMENSIONS.ZSCOPT'
762 include "DIMENSIONS.COMPAR"
765 include 'COMMON.LOCAL'
766 include 'COMMON.CHAIN'
767 include 'COMMON.DERIV'
768 include 'COMMON.NAMES'
769 include 'COMMON.INTERACT'
770 include 'COMMON.ENEPS'
771 include 'COMMON.IOUNITS'
772 include 'COMMON.CALC'
779 eneps_temp(j,i)=0.0d0
782 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
786 c if (icall.gt.0) lprn=.true.
790 itypi1=iabs(itype(i+1))
794 dxi=dc_norm(1,nres+i)
795 dyi=dc_norm(2,nres+i)
796 dzi=dc_norm(3,nres+i)
797 dsci_inv=vbld_inv(i+nres)
799 C Calculate SC interaction energy.
802 do j=istart(i,iint),iend(i,iint)
805 dscj_inv=vbld_inv(j+nres)
806 sig0ij=sigma(itypi,itypj)
807 chi1=chi(itypi,itypj)
808 chi2=chi(itypj,itypi)
815 alf12=0.5D0*(alf1+alf2)
816 C For diagnostics only!!!
829 dxj=dc_norm(1,nres+j)
830 dyj=dc_norm(2,nres+j)
831 dzj=dc_norm(3,nres+j)
832 c write (iout,*) i,j,xj,yj,zj
833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
835 C Calculate angle-dependent terms of energy and contributions to their
839 sig=sig0ij*dsqrt(sigsq)
840 rij_shift=1.0D0/rij-sig+sig0ij
841 C I hate to put IF's in the loops, but here don't have another choice!!!!
842 if (rij_shift.le.0.0D0) then
847 c---------------------------------------------------------------
848 rij_shift=1.0D0/rij_shift
850 e1=fac*fac*aa(itypi,itypj)
851 e2=fac*bb(itypi,itypj)
852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
853 eps2der=evdwij*eps3rt
854 eps3der=evdwij*eps2rt
855 evdwij=evdwij*eps2rt*eps3rt
856 if (bb(itypi,itypj).gt.0) then
861 ij=icant(itypi,itypj)
862 aux=eps1*eps2rt**2*eps3rt**2
863 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
864 & /dabs(eps(itypi,itypj))
865 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
866 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
867 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
868 c & aux*e2/eps(itypi,itypj)
870 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
871 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
872 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
873 & restyp(itypi),i,restyp(itypj),j,
874 & epsi,sigm,chi1,chi2,chip1,chip2,
875 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
876 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
880 C Calculate gradient components.
881 e1=e1*eps1*eps2rt**2*eps3rt**2
882 fac=-expon*(e1+evdwij)*rij_shift
885 C Calculate the radial part of the gradient
889 C Calculate angular part of the gradient.
897 C-----------------------------------------------------------------------------
898 subroutine egbv(evdw,evdw_t)
900 C This subroutine calculates the interaction energy of nonbonded side chains
901 C assuming the Gay-Berne-Vorobjev potential of interaction.
903 implicit real*8 (a-h,o-z)
905 include 'DIMENSIONS.ZSCOPT'
906 include "DIMENSIONS.COMPAR"
909 include 'COMMON.LOCAL'
910 include 'COMMON.CHAIN'
911 include 'COMMON.DERIV'
912 include 'COMMON.NAMES'
913 include 'COMMON.INTERACT'
914 include 'COMMON.ENEPS'
915 include 'COMMON.IOUNITS'
916 include 'COMMON.CALC'
923 eneps_temp(j,i)=0.0d0
928 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
931 c if (icall.gt.0) lprn=.true.
935 itypi1=iabs(itype(i+1))
939 dxi=dc_norm(1,nres+i)
940 dyi=dc_norm(2,nres+i)
941 dzi=dc_norm(3,nres+i)
942 dsci_inv=vbld_inv(i+nres)
944 C Calculate SC interaction energy.
947 do j=istart(i,iint),iend(i,iint)
950 dscj_inv=vbld_inv(j+nres)
951 sig0ij=sigma(itypi,itypj)
953 chi1=chi(itypi,itypj)
954 chi2=chi(itypj,itypi)
961 alf12=0.5D0*(alf1+alf2)
962 C For diagnostics only!!!
975 dxj=dc_norm(1,nres+j)
976 dyj=dc_norm(2,nres+j)
977 dzj=dc_norm(3,nres+j)
978 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
980 C Calculate angle-dependent terms of energy and contributions to their
984 sig=sig0ij*dsqrt(sigsq)
985 rij_shift=1.0D0/rij-sig+r0ij
986 C I hate to put IF's in the loops, but here don't have another choice!!!!
987 if (rij_shift.le.0.0D0) then
992 c---------------------------------------------------------------
993 rij_shift=1.0D0/rij_shift
995 e1=fac*fac*aa(itypi,itypj)
996 e2=fac*bb(itypi,itypj)
997 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
998 eps2der=evdwij*eps3rt
999 eps3der=evdwij*eps2rt
1000 fac_augm=rrij**expon
1001 e_augm=augm(itypi,itypj)*fac_augm
1002 evdwij=evdwij*eps2rt*eps3rt
1003 if (bb(itypi,itypj).gt.0.0d0) then
1004 evdw=evdw+evdwij+e_augm
1006 evdw_t=evdw_t+evdwij+e_augm
1008 ij=icant(itypi,itypj)
1009 aux=eps1*eps2rt**2*eps3rt**2
1010 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1011 & /dabs(eps(itypi,itypj))
1012 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1013 c eneps_temp(ij)=eneps_temp(ij)
1014 c & +(evdwij+e_augm)/eps(itypi,itypj)
1016 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1017 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1018 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1019 c & restyp(itypi),i,restyp(itypj),j,
1020 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1021 c & chi1,chi2,chip1,chip2,
1022 c & eps1,eps2rt**2,eps3rt**2,
1023 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1027 C Calculate gradient components.
1028 e1=e1*eps1*eps2rt**2*eps3rt**2
1029 fac=-expon*(e1+evdwij)*rij_shift
1031 fac=rij*fac-2*expon*rrij*e_augm
1032 C Calculate the radial part of the gradient
1036 C Calculate angular part of the gradient.
1044 C-----------------------------------------------------------------------------
1045 subroutine sc_angular
1046 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1047 C om12. Called by ebp, egb, and egbv.
1049 include 'COMMON.CALC'
1053 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1054 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1055 om12=dxi*dxj+dyi*dyj+dzi*dzj
1057 C Calculate eps1(om12) and its derivative in om12
1058 faceps1=1.0D0-om12*chiom12
1059 faceps1_inv=1.0D0/faceps1
1060 eps1=dsqrt(faceps1_inv)
1061 C Following variable is eps1*deps1/dom12
1062 eps1_om12=faceps1_inv*chiom12
1063 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1068 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1069 sigsq=1.0D0-facsig*faceps1_inv
1070 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1071 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1072 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1073 C Calculate eps2 and its derivatives in om1, om2, and om12.
1076 chipom12=chip12*om12
1077 facp=1.0D0-om12*chipom12
1079 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1080 C Following variable is the square root of eps2
1081 eps2rt=1.0D0-facp1*facp_inv
1082 C Following three variables are the derivatives of the square root of eps
1083 C in om1, om2, and om12.
1084 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1085 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1086 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1087 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1088 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1089 C Calculate whole angle-dependent part of epsilon and contributions
1090 C to its derivatives
1093 C----------------------------------------------------------------------------
1095 implicit real*8 (a-h,o-z)
1096 include 'DIMENSIONS'
1097 include 'DIMENSIONS.ZSCOPT'
1098 include 'COMMON.CHAIN'
1099 include 'COMMON.DERIV'
1100 include 'COMMON.CALC'
1101 double precision dcosom1(3),dcosom2(3)
1102 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1103 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1104 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1105 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1107 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1108 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1111 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1114 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1115 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1116 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1117 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1118 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1119 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1122 C Calculate the components of the gradient in DC and X
1126 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1131 c------------------------------------------------------------------------------
1132 subroutine vec_and_deriv
1133 implicit real*8 (a-h,o-z)
1134 include 'DIMENSIONS'
1135 include 'DIMENSIONS.ZSCOPT'
1136 include 'COMMON.IOUNITS'
1137 include 'COMMON.GEO'
1138 include 'COMMON.VAR'
1139 include 'COMMON.LOCAL'
1140 include 'COMMON.CHAIN'
1141 include 'COMMON.VECTORS'
1142 include 'COMMON.DERIV'
1143 include 'COMMON.INTERACT'
1144 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1145 C Compute the local reference systems. For reference system (i), the
1146 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1147 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1149 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1150 if (i.eq.nres-1) then
1151 C Case of the last full residue
1152 C Compute the Z-axis
1153 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1154 costh=dcos(pi-theta(nres))
1155 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1160 C Compute the derivatives of uz
1162 uzder(2,1,1)=-dc_norm(3,i-1)
1163 uzder(3,1,1)= dc_norm(2,i-1)
1164 uzder(1,2,1)= dc_norm(3,i-1)
1166 uzder(3,2,1)=-dc_norm(1,i-1)
1167 uzder(1,3,1)=-dc_norm(2,i-1)
1168 uzder(2,3,1)= dc_norm(1,i-1)
1171 uzder(2,1,2)= dc_norm(3,i)
1172 uzder(3,1,2)=-dc_norm(2,i)
1173 uzder(1,2,2)=-dc_norm(3,i)
1175 uzder(3,2,2)= dc_norm(1,i)
1176 uzder(1,3,2)= dc_norm(2,i)
1177 uzder(2,3,2)=-dc_norm(1,i)
1180 C Compute the Y-axis
1183 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1186 C Compute the derivatives of uy
1189 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1190 & -dc_norm(k,i)*dc_norm(j,i-1)
1191 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1193 uyder(j,j,1)=uyder(j,j,1)-costh
1194 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1199 uygrad(l,k,j,i)=uyder(l,k,j)
1200 uzgrad(l,k,j,i)=uzder(l,k,j)
1204 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1205 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1206 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1207 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1211 C Compute the Z-axis
1212 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1213 costh=dcos(pi-theta(i+2))
1214 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1219 C Compute the derivatives of uz
1221 uzder(2,1,1)=-dc_norm(3,i+1)
1222 uzder(3,1,1)= dc_norm(2,i+1)
1223 uzder(1,2,1)= dc_norm(3,i+1)
1225 uzder(3,2,1)=-dc_norm(1,i+1)
1226 uzder(1,3,1)=-dc_norm(2,i+1)
1227 uzder(2,3,1)= dc_norm(1,i+1)
1230 uzder(2,1,2)= dc_norm(3,i)
1231 uzder(3,1,2)=-dc_norm(2,i)
1232 uzder(1,2,2)=-dc_norm(3,i)
1234 uzder(3,2,2)= dc_norm(1,i)
1235 uzder(1,3,2)= dc_norm(2,i)
1236 uzder(2,3,2)=-dc_norm(1,i)
1239 C Compute the Y-axis
1242 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1245 C Compute the derivatives of uy
1248 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1249 & -dc_norm(k,i)*dc_norm(j,i+1)
1250 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1252 uyder(j,j,1)=uyder(j,j,1)-costh
1253 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1258 uygrad(l,k,j,i)=uyder(l,k,j)
1259 uzgrad(l,k,j,i)=uzder(l,k,j)
1263 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1264 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1265 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1266 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1272 vbld_inv_temp(1)=vbld_inv(i+1)
1273 if (i.lt.nres-1) then
1274 vbld_inv_temp(2)=vbld_inv(i+2)
1276 vbld_inv_temp(2)=vbld_inv(i)
1281 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1282 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1290 C-----------------------------------------------------------------------------
1291 subroutine vec_and_deriv_test
1292 implicit real*8 (a-h,o-z)
1293 include 'DIMENSIONS'
1294 include 'DIMENSIONS.ZSCOPT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.GEO'
1297 include 'COMMON.VAR'
1298 include 'COMMON.LOCAL'
1299 include 'COMMON.CHAIN'
1300 include 'COMMON.VECTORS'
1301 dimension uyder(3,3,2),uzder(3,3,2)
1302 C Compute the local reference systems. For reference system (i), the
1303 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1304 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1306 if (i.eq.nres-1) then
1307 C Case of the last full residue
1308 C Compute the Z-axis
1309 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1310 costh=dcos(pi-theta(nres))
1311 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1312 c write (iout,*) 'fac',fac,
1313 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1314 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1318 C Compute the derivatives of uz
1320 uzder(2,1,1)=-dc_norm(3,i-1)
1321 uzder(3,1,1)= dc_norm(2,i-1)
1322 uzder(1,2,1)= dc_norm(3,i-1)
1324 uzder(3,2,1)=-dc_norm(1,i-1)
1325 uzder(1,3,1)=-dc_norm(2,i-1)
1326 uzder(2,3,1)= dc_norm(1,i-1)
1329 uzder(2,1,2)= dc_norm(3,i)
1330 uzder(3,1,2)=-dc_norm(2,i)
1331 uzder(1,2,2)=-dc_norm(3,i)
1333 uzder(3,2,2)= dc_norm(1,i)
1334 uzder(1,3,2)= dc_norm(2,i)
1335 uzder(2,3,2)=-dc_norm(1,i)
1337 C Compute the Y-axis
1339 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1342 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1343 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1344 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1346 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1349 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1350 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1353 c write (iout,*) 'facy',facy,
1354 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1355 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1357 uy(k,i)=facy*uy(k,i)
1359 C Compute the derivatives of uy
1362 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1363 & -dc_norm(k,i)*dc_norm(j,i-1)
1364 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1366 c uyder(j,j,1)=uyder(j,j,1)-costh
1367 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1368 uyder(j,j,1)=uyder(j,j,1)
1369 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1370 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1376 uygrad(l,k,j,i)=uyder(l,k,j)
1377 uzgrad(l,k,j,i)=uzder(l,k,j)
1381 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1382 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1383 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1384 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1387 C Compute the Z-axis
1388 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1389 costh=dcos(pi-theta(i+2))
1390 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1391 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1395 C Compute the derivatives of uz
1397 uzder(2,1,1)=-dc_norm(3,i+1)
1398 uzder(3,1,1)= dc_norm(2,i+1)
1399 uzder(1,2,1)= dc_norm(3,i+1)
1401 uzder(3,2,1)=-dc_norm(1,i+1)
1402 uzder(1,3,1)=-dc_norm(2,i+1)
1403 uzder(2,3,1)= dc_norm(1,i+1)
1406 uzder(2,1,2)= dc_norm(3,i)
1407 uzder(3,1,2)=-dc_norm(2,i)
1408 uzder(1,2,2)=-dc_norm(3,i)
1410 uzder(3,2,2)= dc_norm(1,i)
1411 uzder(1,3,2)= dc_norm(2,i)
1412 uzder(2,3,2)=-dc_norm(1,i)
1414 C Compute the Y-axis
1416 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1417 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1418 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1420 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1423 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1424 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1427 c write (iout,*) 'facy',facy,
1428 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1429 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1431 uy(k,i)=facy*uy(k,i)
1433 C Compute the derivatives of uy
1436 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1437 & -dc_norm(k,i)*dc_norm(j,i+1)
1438 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1440 c uyder(j,j,1)=uyder(j,j,1)-costh
1441 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1442 uyder(j,j,1)=uyder(j,j,1)
1443 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1444 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1450 uygrad(l,k,j,i)=uyder(l,k,j)
1451 uzgrad(l,k,j,i)=uzder(l,k,j)
1455 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1456 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1457 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1458 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1465 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1466 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1473 C-----------------------------------------------------------------------------
1474 subroutine check_vecgrad
1475 implicit real*8 (a-h,o-z)
1476 include 'DIMENSIONS'
1477 include 'DIMENSIONS.ZSCOPT'
1478 include 'COMMON.IOUNITS'
1479 include 'COMMON.GEO'
1480 include 'COMMON.VAR'
1481 include 'COMMON.LOCAL'
1482 include 'COMMON.CHAIN'
1483 include 'COMMON.VECTORS'
1484 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1485 dimension uyt(3,maxres),uzt(3,maxres)
1486 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1487 double precision delta /1.0d-7/
1490 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1491 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1492 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1493 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1494 cd & (dc_norm(if90,i),if90=1,3)
1495 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1496 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1497 cd write(iout,'(a)')
1503 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1504 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1517 cd write (iout,*) 'i=',i
1519 erij(k)=dc_norm(k,i)
1523 dc_norm(k,i)=erij(k)
1525 dc_norm(j,i)=dc_norm(j,i)+delta
1526 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1528 c dc_norm(k,i)=dc_norm(k,i)/fac
1530 c write (iout,*) (dc_norm(k,i),k=1,3)
1531 c write (iout,*) (erij(k),k=1,3)
1534 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1535 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1536 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1537 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1539 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1540 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1541 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1544 dc_norm(k,i)=erij(k)
1547 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1548 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1549 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1550 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1551 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1552 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1553 cd write (iout,'(a)')
1558 C--------------------------------------------------------------------------
1559 subroutine set_matrices
1560 implicit real*8 (a-h,o-z)
1561 include 'DIMENSIONS'
1562 include 'DIMENSIONS.ZSCOPT'
1563 include 'COMMON.IOUNITS'
1564 include 'COMMON.GEO'
1565 include 'COMMON.VAR'
1566 include 'COMMON.LOCAL'
1567 include 'COMMON.CHAIN'
1568 include 'COMMON.DERIV'
1569 include 'COMMON.INTERACT'
1570 include 'COMMON.CONTACTS'
1571 include 'COMMON.TORSION'
1572 include 'COMMON.VECTORS'
1573 include 'COMMON.FFIELD'
1574 double precision auxvec(2),auxmat(2,2)
1576 C Compute the virtual-bond-torsional-angle dependent quantities needed
1577 C to calculate the el-loc multibody terms of various order.
1580 if (i .lt. nres+1) then
1617 if (i .gt. 3 .and. i .lt. nres+1) then
1618 obrot_der(1,i-2)=-sin1
1619 obrot_der(2,i-2)= cos1
1620 Ugder(1,1,i-2)= sin1
1621 Ugder(1,2,i-2)=-cos1
1622 Ugder(2,1,i-2)=-cos1
1623 Ugder(2,2,i-2)=-sin1
1626 obrot2_der(1,i-2)=-dwasin2
1627 obrot2_der(2,i-2)= dwacos2
1628 Ug2der(1,1,i-2)= dwasin2
1629 Ug2der(1,2,i-2)=-dwacos2
1630 Ug2der(2,1,i-2)=-dwacos2
1631 Ug2der(2,2,i-2)=-dwasin2
1633 obrot_der(1,i-2)=0.0d0
1634 obrot_der(2,i-2)=0.0d0
1635 Ugder(1,1,i-2)=0.0d0
1636 Ugder(1,2,i-2)=0.0d0
1637 Ugder(2,1,i-2)=0.0d0
1638 Ugder(2,2,i-2)=0.0d0
1639 obrot2_der(1,i-2)=0.0d0
1640 obrot2_der(2,i-2)=0.0d0
1641 Ug2der(1,1,i-2)=0.0d0
1642 Ug2der(1,2,i-2)=0.0d0
1643 Ug2der(2,1,i-2)=0.0d0
1644 Ug2der(2,2,i-2)=0.0d0
1646 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1647 iti = itortyp(itype(i-2))
1651 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1652 iti1 = itortyp(itype(i-1))
1656 cd write (iout,*) '*******i',i,' iti1',iti
1657 cd write (iout,*) 'b1',b1(:,iti)
1658 cd write (iout,*) 'b2',b2(:,iti)
1659 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1660 if (i .gt. iatel_s+2) then
1661 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1662 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1663 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1664 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1665 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1666 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1667 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1677 DtUg2(l,k,i-2)=0.0d0
1681 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1682 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1683 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1684 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1685 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1686 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1687 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1689 muder(k,i-2)=Ub2der(k,i-2)
1691 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1692 iti1 = itortyp(itype(i-1))
1697 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1699 C Vectors and matrices dependent on a single virtual-bond dihedral.
1700 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1701 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1702 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1703 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1704 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1705 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1706 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1707 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1708 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1709 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1710 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1712 C Matrices dependent on two consecutive virtual-bond dihedrals.
1713 C The order of matrices is from left to right.
1715 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1716 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1717 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1718 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1719 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1720 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1721 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1722 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1725 cd iti = itortyp(itype(i))
1728 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1729 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1734 C--------------------------------------------------------------------------
1735 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1737 C This subroutine calculates the average interaction energy and its gradient
1738 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1739 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1740 C The potential depends both on the distance of peptide-group centers and on
1741 C the orientation of the CA-CA virtual bonds.
1743 implicit real*8 (a-h,o-z)
1744 include 'DIMENSIONS'
1745 include 'DIMENSIONS.ZSCOPT'
1746 include 'COMMON.CONTROL'
1747 include 'COMMON.IOUNITS'
1748 include 'COMMON.GEO'
1749 include 'COMMON.VAR'
1750 include 'COMMON.LOCAL'
1751 include 'COMMON.CHAIN'
1752 include 'COMMON.DERIV'
1753 include 'COMMON.INTERACT'
1754 include 'COMMON.CONTACTS'
1755 include 'COMMON.TORSION'
1756 include 'COMMON.VECTORS'
1757 include 'COMMON.FFIELD'
1758 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1759 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1760 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1761 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1762 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1763 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1764 double precision scal_el /0.5d0/
1766 C 13-go grudnia roku pamietnego...
1767 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1768 & 0.0d0,1.0d0,0.0d0,
1769 & 0.0d0,0.0d0,1.0d0/
1770 cd write(iout,*) 'In EELEC'
1772 cd write(iout,*) 'Type',i
1773 cd write(iout,*) 'B1',B1(:,i)
1774 cd write(iout,*) 'B2',B2(:,i)
1775 cd write(iout,*) 'CC',CC(:,:,i)
1776 cd write(iout,*) 'DD',DD(:,:,i)
1777 cd write(iout,*) 'EE',EE(:,:,i)
1779 cd call check_vecgrad
1781 if (icheckgrad.eq.1) then
1783 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1785 dc_norm(k,i)=dc(k,i)*fac
1787 c write (iout,*) 'i',i,' fac',fac
1790 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1792 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1793 cd if (wel_loc.gt.0.0d0) then
1794 if (icheckgrad.eq.1) then
1795 call vec_and_deriv_test
1802 cd write (iout,*) 'i=',i
1804 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1807 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1808 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1821 cd print '(a)','Enter EELEC'
1822 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1824 gel_loc_loc(i)=0.0d0
1827 do i=iatel_s,iatel_e
1828 if (itel(i).eq.0) goto 1215
1832 dx_normi=dc_norm(1,i)
1833 dy_normi=dc_norm(2,i)
1834 dz_normi=dc_norm(3,i)
1835 xmedi=c(1,i)+0.5d0*dxi
1836 ymedi=c(2,i)+0.5d0*dyi
1837 zmedi=c(3,i)+0.5d0*dzi
1839 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1840 do j=ielstart(i),ielend(i)
1841 if (itel(j).eq.0) goto 1216
1845 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1846 aaa=app(iteli,itelj)
1847 bbb=bpp(iteli,itelj)
1848 C Diagnostics only!!!
1854 ael6i=ael6(iteli,itelj)
1855 ael3i=ael3(iteli,itelj)
1859 dx_normj=dc_norm(1,j)
1860 dy_normj=dc_norm(2,j)
1861 dz_normj=dc_norm(3,j)
1862 xj=c(1,j)+0.5D0*dxj-xmedi
1863 yj=c(2,j)+0.5D0*dyj-ymedi
1864 zj=c(3,j)+0.5D0*dzj-zmedi
1865 rij=xj*xj+yj*yj+zj*zj
1871 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1872 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1873 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1874 fac=cosa-3.0D0*cosb*cosg
1876 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1877 if (j.eq.i+2) ev1=scal_el*ev1
1882 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1885 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1886 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1887 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1890 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1891 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1892 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1893 cd & xmedi,ymedi,zmedi,xj,yj,zj
1895 C Calculate contributions to the Cartesian gradient.
1898 facvdw=-6*rrmij*(ev1+evdwij)
1899 facel=-3*rrmij*(el1+eesij)
1906 * Radial derivatives. First process both termini of the fragment (i,j)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 gelc(k,j)=gelc(k,j)+ghalf
1917 * Loop over residues i+1 thru j-1.
1921 gelc(l,k)=gelc(l,k)+ggg(l)
1929 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1930 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1933 * Loop over residues i+1 thru j-1.
1937 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1944 fac=-3*rrmij*(facvdw+facvdw+facel)
1950 * Radial derivatives. First process both termini of the fragment (i,j)
1957 gelc(k,i)=gelc(k,i)+ghalf
1958 gelc(k,j)=gelc(k,j)+ghalf
1961 * Loop over residues i+1 thru j-1.
1965 gelc(l,k)=gelc(l,k)+ggg(l)
1972 ecosa=2.0D0*fac3*fac1+fac4
1975 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1976 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1978 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1979 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1981 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1982 cd & (dcosg(k),k=1,3)
1984 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1988 gelc(k,i)=gelc(k,i)+ghalf
1989 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1990 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1991 gelc(k,j)=gelc(k,j)+ghalf
1992 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1993 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1997 gelc(l,k)=gelc(l,k)+ggg(l)
2002 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2003 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2004 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2006 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2007 C energy of a peptide unit is assumed in the form of a second-order
2008 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2009 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2010 C are computed for EVERY pair of non-contiguous peptide groups.
2012 if (j.lt.nres-1) then
2023 muij(kkk)=mu(k,i)*mu(l,j)
2026 cd write (iout,*) 'EELEC: i',i,' j',j
2027 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2028 cd write(iout,*) 'muij',muij
2029 ury=scalar(uy(1,i),erij)
2030 urz=scalar(uz(1,i),erij)
2031 vry=scalar(uy(1,j),erij)
2032 vrz=scalar(uz(1,j),erij)
2033 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2034 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2035 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2036 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2037 C For diagnostics only
2042 fac=dsqrt(-ael6i)*r3ij
2043 cd write (2,*) 'fac=',fac
2044 C For diagnostics only
2050 cd write (iout,'(4i5,4f10.5)')
2051 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2052 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2053 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2054 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2055 cd write (iout,'(4f10.5)')
2056 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2057 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2058 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2059 cd write (iout,'(2i3,9f10.5/)') i,j,
2060 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2062 C Derivatives of the elements of A in virtual-bond vectors
2063 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2070 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2071 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2072 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2073 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2074 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2075 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2076 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2077 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2078 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2079 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2080 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2081 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2091 C Compute radial contributions to the gradient
2113 C Add the contributions coming from er
2116 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2117 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2118 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2119 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2122 C Derivatives in DC(i)
2123 ghalf1=0.5d0*agg(k,1)
2124 ghalf2=0.5d0*agg(k,2)
2125 ghalf3=0.5d0*agg(k,3)
2126 ghalf4=0.5d0*agg(k,4)
2127 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2128 & -3.0d0*uryg(k,2)*vry)+ghalf1
2129 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2130 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2131 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2132 & -3.0d0*urzg(k,2)*vry)+ghalf3
2133 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2134 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2135 C Derivatives in DC(i+1)
2136 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2137 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2138 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2139 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2140 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2141 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2142 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2143 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2144 C Derivatives in DC(j)
2145 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2146 & -3.0d0*vryg(k,2)*ury)+ghalf1
2147 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2148 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2149 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2150 & -3.0d0*vryg(k,2)*urz)+ghalf3
2151 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2152 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2153 C Derivatives in DC(j+1) or DC(nres-1)
2154 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2155 & -3.0d0*vryg(k,3)*ury)
2156 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2157 & -3.0d0*vrzg(k,3)*ury)
2158 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2159 & -3.0d0*vryg(k,3)*urz)
2160 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2161 & -3.0d0*vrzg(k,3)*urz)
2166 C Derivatives in DC(i+1)
2167 cd aggi1(k,1)=agg(k,1)
2168 cd aggi1(k,2)=agg(k,2)
2169 cd aggi1(k,3)=agg(k,3)
2170 cd aggi1(k,4)=agg(k,4)
2171 C Derivatives in DC(j)
2176 C Derivatives in DC(j+1)
2181 if (j.eq.nres-1 .and. i.lt.j-2) then
2183 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2184 cd aggj1(k,l)=agg(k,l)
2190 C Check the loc-el terms by numerical integration
2200 aggi(k,l)=-aggi(k,l)
2201 aggi1(k,l)=-aggi1(k,l)
2202 aggj(k,l)=-aggj(k,l)
2203 aggj1(k,l)=-aggj1(k,l)
2206 if (j.lt.nres-1) then
2212 aggi(k,l)=-aggi(k,l)
2213 aggi1(k,l)=-aggi1(k,l)
2214 aggj(k,l)=-aggj(k,l)
2215 aggj1(k,l)=-aggj1(k,l)
2226 aggi(k,l)=-aggi(k,l)
2227 aggi1(k,l)=-aggi1(k,l)
2228 aggj(k,l)=-aggj(k,l)
2229 aggj1(k,l)=-aggj1(k,l)
2235 IF (wel_loc.gt.0.0d0) THEN
2236 C Contribution to the local-electrostatic energy coming from the i-j pair
2237 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2239 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2240 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2241 eel_loc=eel_loc+eel_loc_ij
2242 C Partial derivatives in virtual-bond dihedral angles gamma
2245 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2246 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2247 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2248 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2249 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2250 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2251 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2252 cd write(iout,*) 'agg ',agg
2253 cd write(iout,*) 'aggi ',aggi
2254 cd write(iout,*) 'aggi1',aggi1
2255 cd write(iout,*) 'aggj ',aggj
2256 cd write(iout,*) 'aggj1',aggj1
2258 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2260 ggg(l)=agg(l,1)*muij(1)+
2261 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2265 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2268 C Remaining derivatives of eello
2270 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2271 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2272 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2273 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2274 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2275 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2276 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2277 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2281 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2282 C Contributions from turns
2287 call eturn34(i,j,eello_turn3,eello_turn4)
2289 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2290 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2292 C Calculate the contact function. The ith column of the array JCONT will
2293 C contain the numbers of atoms that make contacts with the atom I (of numbers
2294 C greater than I). The arrays FACONT and GACONT will contain the values of
2295 C the contact function and its derivative.
2296 c r0ij=1.02D0*rpp(iteli,itelj)
2297 c r0ij=1.11D0*rpp(iteli,itelj)
2298 r0ij=2.20D0*rpp(iteli,itelj)
2299 c r0ij=1.55D0*rpp(iteli,itelj)
2300 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2301 if (fcont.gt.0.0D0) then
2302 num_conti=num_conti+1
2303 if (num_conti.gt.maxconts) then
2304 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2305 & ' will skip next contacts for this conf.'
2307 jcont_hb(num_conti,i)=j
2308 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2309 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2310 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2312 d_cont(num_conti,i)=rij
2313 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2314 C --- Electrostatic-interaction matrix ---
2315 a_chuj(1,1,num_conti,i)=a22
2316 a_chuj(1,2,num_conti,i)=a23
2317 a_chuj(2,1,num_conti,i)=a32
2318 a_chuj(2,2,num_conti,i)=a33
2319 C --- Gradient of rij
2321 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2324 c a_chuj(1,1,num_conti,i)=-0.61d0
2325 c a_chuj(1,2,num_conti,i)= 0.4d0
2326 c a_chuj(2,1,num_conti,i)= 0.65d0
2327 c a_chuj(2,2,num_conti,i)= 0.50d0
2328 c else if (i.eq.2) then
2329 c a_chuj(1,1,num_conti,i)= 0.0d0
2330 c a_chuj(1,2,num_conti,i)= 0.0d0
2331 c a_chuj(2,1,num_conti,i)= 0.0d0
2332 c a_chuj(2,2,num_conti,i)= 0.0d0
2334 C --- and its gradients
2335 cd write (iout,*) 'i',i,' j',j
2337 cd write (iout,*) 'iii 1 kkk',kkk
2338 cd write (iout,*) agg(kkk,:)
2341 cd write (iout,*) 'iii 2 kkk',kkk
2342 cd write (iout,*) aggi(kkk,:)
2345 cd write (iout,*) 'iii 3 kkk',kkk
2346 cd write (iout,*) aggi1(kkk,:)
2349 cd write (iout,*) 'iii 4 kkk',kkk
2350 cd write (iout,*) aggj(kkk,:)
2353 cd write (iout,*) 'iii 5 kkk',kkk
2354 cd write (iout,*) aggj1(kkk,:)
2361 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2362 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2363 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2364 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2365 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2367 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2373 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2374 C Calculate contact energies
2376 wij=cosa-3.0D0*cosb*cosg
2379 c fac3=dsqrt(-ael6i)/r0ij**3
2380 fac3=dsqrt(-ael6i)*r3ij
2381 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2382 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2384 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2385 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2386 C Diagnostics. Comment out or remove after debugging!
2387 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2388 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2389 c ees0m(num_conti,i)=0.0D0
2391 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2392 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2393 facont_hb(num_conti,i)=fcont
2395 C Angular derivatives of the contact function
2396 ees0pij1=fac3/ees0pij
2397 ees0mij1=fac3/ees0mij
2398 fac3p=-3.0D0*fac3*rrmij
2399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2408 ecosap=ecosa1+ecosa2
2409 ecosbp=ecosb1+ecosb2
2410 ecosgp=ecosg1+ecosg2
2411 ecosam=ecosa1-ecosa2
2412 ecosbm=ecosb1-ecosb2
2413 ecosgm=ecosg1-ecosg2
2422 fprimcont=fprimcont/rij
2423 cd facont_hb(num_conti,i)=1.0D0
2424 C Following line is for diagnostics.
2427 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2428 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2431 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2432 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2434 gggp(1)=gggp(1)+ees0pijp*xj
2435 gggp(2)=gggp(2)+ees0pijp*yj
2436 gggp(3)=gggp(3)+ees0pijp*zj
2437 gggm(1)=gggm(1)+ees0mijp*xj
2438 gggm(2)=gggm(2)+ees0mijp*yj
2439 gggm(3)=gggm(3)+ees0mijp*zj
2440 C Derivatives due to the contact function
2441 gacont_hbr(1,num_conti,i)=fprimcont*xj
2442 gacont_hbr(2,num_conti,i)=fprimcont*yj
2443 gacont_hbr(3,num_conti,i)=fprimcont*zj
2445 ghalfp=0.5D0*gggp(k)
2446 ghalfm=0.5D0*gggm(k)
2447 gacontp_hb1(k,num_conti,i)=ghalfp
2448 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2449 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2450 gacontp_hb2(k,num_conti,i)=ghalfp
2451 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2452 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2453 gacontp_hb3(k,num_conti,i)=gggp(k)
2454 gacontm_hb1(k,num_conti,i)=ghalfm
2455 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2456 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2457 gacontm_hb2(k,num_conti,i)=ghalfm
2458 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2459 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2460 gacontm_hb3(k,num_conti,i)=gggm(k)
2463 C Diagnostics. Comment out or remove after debugging!
2465 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2466 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2467 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2468 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2469 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2470 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2473 endif ! num_conti.le.maxconts
2478 num_cont_hb(i)=num_conti
2482 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2483 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2485 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2486 ccc eel_loc=eel_loc+eello_turn3
2489 C-----------------------------------------------------------------------------
2490 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2491 C Third- and fourth-order contributions from turns
2492 implicit real*8 (a-h,o-z)
2493 include 'DIMENSIONS'
2494 include 'DIMENSIONS.ZSCOPT'
2495 include 'COMMON.IOUNITS'
2496 include 'COMMON.GEO'
2497 include 'COMMON.VAR'
2498 include 'COMMON.LOCAL'
2499 include 'COMMON.CHAIN'
2500 include 'COMMON.DERIV'
2501 include 'COMMON.INTERACT'
2502 include 'COMMON.CONTACTS'
2503 include 'COMMON.TORSION'
2504 include 'COMMON.VECTORS'
2505 include 'COMMON.FFIELD'
2507 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2508 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2509 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2510 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2511 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2512 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2516 C Third-order contributions
2523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2524 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2525 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2526 call transpose2(auxmat(1,1),auxmat1(1,1))
2527 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2528 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2529 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2530 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2531 cd & ' eello_turn3_num',4*eello_turn3_num
2533 C Derivatives in gamma(i)
2534 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2535 call transpose2(auxmat2(1,1),pizda(1,1))
2536 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2537 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2538 C Derivatives in gamma(i+1)
2539 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2540 call transpose2(auxmat2(1,1),pizda(1,1))
2541 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2542 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2543 & +0.5d0*(pizda(1,1)+pizda(2,2))
2544 C Cartesian derivatives
2546 a_temp(1,1)=aggi(l,1)
2547 a_temp(1,2)=aggi(l,2)
2548 a_temp(2,1)=aggi(l,3)
2549 a_temp(2,2)=aggi(l,4)
2550 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2551 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2552 & +0.5d0*(pizda(1,1)+pizda(2,2))
2553 a_temp(1,1)=aggi1(l,1)
2554 a_temp(1,2)=aggi1(l,2)
2555 a_temp(2,1)=aggi1(l,3)
2556 a_temp(2,2)=aggi1(l,4)
2557 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2558 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2559 & +0.5d0*(pizda(1,1)+pizda(2,2))
2560 a_temp(1,1)=aggj(l,1)
2561 a_temp(1,2)=aggj(l,2)
2562 a_temp(2,1)=aggj(l,3)
2563 a_temp(2,2)=aggj(l,4)
2564 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2565 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2566 & +0.5d0*(pizda(1,1)+pizda(2,2))
2567 a_temp(1,1)=aggj1(l,1)
2568 a_temp(1,2)=aggj1(l,2)
2569 a_temp(2,1)=aggj1(l,3)
2570 a_temp(2,2)=aggj1(l,4)
2571 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2572 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2573 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 else if (j.eq.i+3) then
2577 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2579 C Fourth-order contributions
2587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2588 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2589 iti1=itortyp(itype(i+1))
2590 iti2=itortyp(itype(i+2))
2591 iti3=itortyp(itype(i+3))
2592 call transpose2(EUg(1,1,i+1),e1t(1,1))
2593 call transpose2(Eug(1,1,i+2),e2t(1,1))
2594 call transpose2(Eug(1,1,i+3),e3t(1,1))
2595 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2596 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2597 s1=scalar2(b1(1,iti2),auxvec(1))
2598 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2599 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2600 s2=scalar2(b1(1,iti1),auxvec(1))
2601 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2602 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2603 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2604 eello_turn4=eello_turn4-(s1+s2+s3)
2605 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2606 cd & ' eello_turn4_num',8*eello_turn4_num
2607 C Derivatives in gamma(i)
2609 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2610 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2611 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2612 s1=scalar2(b1(1,iti2),auxvec(1))
2613 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2614 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2615 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2616 C Derivatives in gamma(i+1)
2617 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2618 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2619 s2=scalar2(b1(1,iti1),auxvec(1))
2620 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2621 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2622 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2623 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2624 C Derivatives in gamma(i+2)
2625 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2626 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2627 s1=scalar2(b1(1,iti2),auxvec(1))
2628 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2629 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2630 s2=scalar2(b1(1,iti1),auxvec(1))
2631 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2632 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2635 C Cartesian derivatives
2636 C Derivatives of this turn contributions in DC(i+2)
2637 if (j.lt.nres-1) then
2639 a_temp(1,1)=agg(l,1)
2640 a_temp(1,2)=agg(l,2)
2641 a_temp(2,1)=agg(l,3)
2642 a_temp(2,2)=agg(l,4)
2643 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2644 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2645 s1=scalar2(b1(1,iti2),auxvec(1))
2646 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2647 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2648 s2=scalar2(b1(1,iti1),auxvec(1))
2649 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2650 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2653 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2656 C Remaining derivatives of this turn contribution
2658 a_temp(1,1)=aggi(l,1)
2659 a_temp(1,2)=aggi(l,2)
2660 a_temp(2,1)=aggi(l,3)
2661 a_temp(2,2)=aggi(l,4)
2662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2664 s1=scalar2(b1(1,iti2),auxvec(1))
2665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2667 s2=scalar2(b1(1,iti1),auxvec(1))
2668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2671 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2672 a_temp(1,1)=aggi1(l,1)
2673 a_temp(1,2)=aggi1(l,2)
2674 a_temp(2,1)=aggi1(l,3)
2675 a_temp(2,2)=aggi1(l,4)
2676 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2677 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2678 s1=scalar2(b1(1,iti2),auxvec(1))
2679 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2680 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2681 s2=scalar2(b1(1,iti1),auxvec(1))
2682 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2683 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2684 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2685 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2686 a_temp(1,1)=aggj(l,1)
2687 a_temp(1,2)=aggj(l,2)
2688 a_temp(2,1)=aggj(l,3)
2689 a_temp(2,2)=aggj(l,4)
2690 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2691 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2692 s1=scalar2(b1(1,iti2),auxvec(1))
2693 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2694 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2695 s2=scalar2(b1(1,iti1),auxvec(1))
2696 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2697 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2698 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2699 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2700 a_temp(1,1)=aggj1(l,1)
2701 a_temp(1,2)=aggj1(l,2)
2702 a_temp(2,1)=aggj1(l,3)
2703 a_temp(2,2)=aggj1(l,4)
2704 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2705 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2706 s1=scalar2(b1(1,iti2),auxvec(1))
2707 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2708 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2709 s2=scalar2(b1(1,iti1),auxvec(1))
2710 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2711 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2713 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2719 C-----------------------------------------------------------------------------
2720 subroutine vecpr(u,v,w)
2721 implicit real*8(a-h,o-z)
2722 dimension u(3),v(3),w(3)
2723 w(1)=u(2)*v(3)-u(3)*v(2)
2724 w(2)=-u(1)*v(3)+u(3)*v(1)
2725 w(3)=u(1)*v(2)-u(2)*v(1)
2728 C-----------------------------------------------------------------------------
2729 subroutine unormderiv(u,ugrad,unorm,ungrad)
2730 C This subroutine computes the derivatives of a normalized vector u, given
2731 C the derivatives computed without normalization conditions, ugrad. Returns
2734 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2735 double precision vec(3)
2736 double precision scalar
2738 c write (2,*) 'ugrad',ugrad
2741 vec(i)=scalar(ugrad(1,i),u(1))
2743 c write (2,*) 'vec',vec
2746 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2749 c write (2,*) 'ungrad',ungrad
2752 C-----------------------------------------------------------------------------
2753 subroutine escp(evdw2,evdw2_14)
2755 C This subroutine calculates the excluded-volume interaction energy between
2756 C peptide-group centers and side chains and its gradient in virtual-bond and
2757 C side-chain vectors.
2759 implicit real*8 (a-h,o-z)
2760 include 'DIMENSIONS'
2761 include 'DIMENSIONS.ZSCOPT'
2762 include 'COMMON.GEO'
2763 include 'COMMON.VAR'
2764 include 'COMMON.LOCAL'
2765 include 'COMMON.CHAIN'
2766 include 'COMMON.DERIV'
2767 include 'COMMON.INTERACT'
2768 include 'COMMON.FFIELD'
2769 include 'COMMON.IOUNITS'
2773 cd print '(a)','Enter ESCP'
2774 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2775 c & ' scal14',scal14
2776 do i=iatscp_s,iatscp_e
2778 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2779 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2780 if (iteli.eq.0) goto 1225
2781 xi=0.5D0*(c(1,i)+c(1,i+1))
2782 yi=0.5D0*(c(2,i)+c(2,i+1))
2783 zi=0.5D0*(c(3,i)+c(3,i+1))
2785 do iint=1,nscp_gr(i)
2787 do j=iscpstart(i,iint),iscpend(i,iint)
2788 itypj=iabs(itype(j))
2789 C Uncomment following three lines for SC-p interactions
2793 C Uncomment following three lines for Ca-p interactions
2797 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2799 e1=fac*fac*aad(itypj,iteli)
2800 e2=fac*bad(itypj,iteli)
2801 if (iabs(j-i) .le. 2) then
2804 evdw2_14=evdw2_14+e1+e2
2807 c write (iout,*) i,j,evdwij
2811 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2813 fac=-(evdwij+e1)*rrij
2818 cd write (iout,*) 'j<i'
2819 C Uncomment following three lines for SC-p interactions
2821 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2824 cd write (iout,*) 'j>i'
2827 C Uncomment following line for SC-p interactions
2828 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2832 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2836 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2837 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2840 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2850 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2851 gradx_scp(j,i)=expon*gradx_scp(j,i)
2854 C******************************************************************************
2858 C To save time the factor EXPON has been extracted from ALL components
2859 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2862 C******************************************************************************
2865 C--------------------------------------------------------------------------
2866 subroutine edis(ehpb)
2868 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2870 implicit real*8 (a-h,o-z)
2871 include 'DIMENSIONS'
2872 include 'COMMON.SBRIDGE'
2873 include 'COMMON.CHAIN'
2874 include 'COMMON.DERIV'
2875 include 'COMMON.VAR'
2876 include 'COMMON.INTERACT'
2877 include 'COMMON.IOUNITS'
2880 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2881 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2882 if (link_end.eq.0) return
2883 do i=link_start,link_end
2884 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2885 C CA-CA distance used in regularization of structure.
2888 C iii and jjj point to the residues for which the distance is assigned.
2889 if (ii.gt.nres) then
2896 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2897 c & dhpb(i),dhpb1(i),forcon(i)
2898 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2899 C distance and angle dependent SS bond potential.
2900 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2901 & iabs(itype(jjj)).eq.1) then
2902 call ssbond_ene(iii,jjj,eij)
2904 cd write (iout,*) "eij",eij
2905 else if (ii.gt.nres .and. jj.gt.nres) then
2906 c Restraints from contact prediction
2908 if (dhpb1(i).gt.0.0d0) then
2909 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2910 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2911 c write (iout,*) "beta nmr",
2912 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2916 C Get the force constant corresponding to this distance.
2918 C Calculate the contribution to energy.
2919 ehpb=ehpb+waga*rdis*rdis
2920 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2922 C Evaluate gradient.
2927 ggg(j)=fac*(c(j,jj)-c(j,ii))
2930 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2931 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2934 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2935 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2938 C Calculate the distance between the two points and its difference from the
2941 if (dhpb1(i).gt.0.0d0) then
2942 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2943 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2944 c write (iout,*) "alph nmr",
2945 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2948 C Get the force constant corresponding to this distance.
2950 C Calculate the contribution to energy.
2951 ehpb=ehpb+waga*rdis*rdis
2952 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2954 C Evaluate gradient.
2958 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2959 cd & ' waga=',waga,' fac=',fac
2961 ggg(j)=fac*(c(j,jj)-c(j,ii))
2963 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2964 C If this is a SC-SC distance, we need to calculate the contributions to the
2965 C Cartesian gradient in the SC vectors (ghpbx).
2968 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2969 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2973 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2974 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2981 C--------------------------------------------------------------------------
2982 subroutine ssbond_ene(i,j,eij)
2984 C Calculate the distance and angle dependent SS-bond potential energy
2985 C using a free-energy function derived based on RHF/6-31G** ab initio
2986 C calculations of diethyl disulfide.
2988 C A. Liwo and U. Kozlowska, 11/24/03
2990 implicit real*8 (a-h,o-z)
2991 include 'DIMENSIONS'
2992 include 'DIMENSIONS.ZSCOPT'
2993 include 'COMMON.SBRIDGE'
2994 include 'COMMON.CHAIN'
2995 include 'COMMON.DERIV'
2996 include 'COMMON.LOCAL'
2997 include 'COMMON.INTERACT'
2998 include 'COMMON.VAR'
2999 include 'COMMON.IOUNITS'
3000 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3001 itypi=iabs(itype(i))
3005 dxi=dc_norm(1,nres+i)
3006 dyi=dc_norm(2,nres+i)
3007 dzi=dc_norm(3,nres+i)
3008 dsci_inv=dsc_inv(itypi)
3009 itypj=iabs(itype(j))
3010 dscj_inv=dsc_inv(itypj)
3014 dxj=dc_norm(1,nres+j)
3015 dyj=dc_norm(2,nres+j)
3016 dzj=dc_norm(3,nres+j)
3017 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3022 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3023 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3024 om12=dxi*dxj+dyi*dyj+dzi*dzj
3026 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3027 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3033 deltat12=om2-om1+2.0d0
3035 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3036 & +akct*deltad*deltat12
3037 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3038 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3039 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3040 c & " deltat12",deltat12," eij",eij
3041 ed=2*akcm*deltad+akct*deltat12
3043 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3044 eom1=-2*akth*deltat1-pom1-om2*pom2
3045 eom2= 2*akth*deltat2+pom1-om1*pom2
3048 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3051 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3052 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3053 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3054 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3057 C Calculate the components of the gradient in DC and X
3061 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3066 C--------------------------------------------------------------------------
3067 subroutine ebond(estr)
3069 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3071 implicit real*8 (a-h,o-z)
3072 include 'DIMENSIONS'
3073 include 'DIMENSIONS.ZSCOPT'
3074 include 'COMMON.LOCAL'
3075 include 'COMMON.GEO'
3076 include 'COMMON.INTERACT'
3077 include 'COMMON.DERIV'
3078 include 'COMMON.VAR'
3079 include 'COMMON.CHAIN'
3080 include 'COMMON.IOUNITS'
3081 include 'COMMON.NAMES'
3082 include 'COMMON.FFIELD'
3083 include 'COMMON.CONTROL'
3084 double precision u(3),ud(3)
3087 diff = vbld(i)-vbldp0
3088 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3091 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3096 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3103 diff=vbld(i+nres)-vbldsc0(1,iti)
3104 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3105 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3106 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3108 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3112 diff=vbld(i+nres)-vbldsc0(j,iti)
3113 ud(j)=aksc(j,iti)*diff
3114 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3128 uprod2=uprod2*u(k)*u(k)
3132 usumsqder=usumsqder+ud(j)*uprod2
3134 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3135 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3136 estr=estr+uprod/usum
3138 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3146 C--------------------------------------------------------------------------
3147 subroutine ebend(etheta)
3149 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3150 C angles gamma and its derivatives in consecutive thetas and gammas.
3152 implicit real*8 (a-h,o-z)
3153 include 'DIMENSIONS'
3154 include 'DIMENSIONS.ZSCOPT'
3155 include 'COMMON.LOCAL'
3156 include 'COMMON.GEO'
3157 include 'COMMON.INTERACT'
3158 include 'COMMON.DERIV'
3159 include 'COMMON.VAR'
3160 include 'COMMON.CHAIN'
3161 include 'COMMON.IOUNITS'
3162 include 'COMMON.NAMES'
3163 include 'COMMON.FFIELD'
3164 common /calcthet/ term1,term2,termm,diffak,ratak,
3165 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3166 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3167 double precision y(2),z(2)
3169 time11=dexp(-2*time)
3172 c write (iout,*) "nres",nres
3173 c write (*,'(a,i2)') 'EBEND ICG=',icg
3174 c write (iout,*) ithet_start,ithet_end
3175 do i=ithet_start,ithet_end
3176 C Zero the energy function and its derivative at 0 or pi.
3177 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3179 ichir1=isign(1,itype(i-2))
3180 ichir2=isign(1,itype(i))
3181 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3182 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3183 if (itype(i-1).eq.10) then
3184 itype1=isign(10,itype(i-2))
3185 ichir11=isign(1,itype(i-2))
3186 ichir12=isign(1,itype(i-2))
3187 itype2=isign(10,itype(i))
3188 ichir21=isign(1,itype(i))
3189 ichir22=isign(1,itype(i))
3191 c if (i.gt.ithet_start .and.
3192 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3193 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3201 c if (i.lt.nres .and. itel(i).ne.0) then
3213 call proc_proc(phii,icrc)
3214 if (icrc.eq.1) phii=150.0
3228 call proc_proc(phii1,icrc)
3229 if (icrc.eq.1) phii1=150.0
3241 C Calculate the "mean" value of theta from the part of the distribution
3242 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3243 C In following comments this theta will be referred to as t_c.
3244 thet_pred_mean=0.0d0
3246 athetk=athet(k,it,ichir1,ichir2)
3247 bthetk=bthet(k,it,ichir1,ichir2)
3249 athetk=athet(k,itype1,ichir11,ichir12)
3250 bthetk=bthet(k,itype2,ichir21,ichir22)
3252 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3254 c write (iout,*) "thet_pred_mean",thet_pred_mean
3255 dthett=thet_pred_mean*ssd
3256 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3257 c write (iout,*) "thet_pred_mean",thet_pred_mean
3258 C Derivatives of the "mean" values in gamma1 and gamma2.
3259 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3260 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3261 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3262 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3264 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3265 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3266 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3267 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3269 if (theta(i).gt.pi-delta) then
3270 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3272 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3273 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3274 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3276 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3278 else if (theta(i).lt.delta) then
3279 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3280 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3281 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3283 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3284 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3287 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3290 etheta=etheta+ethetai
3291 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3292 c & rad2deg*phii,rad2deg*phii1,ethetai
3293 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3294 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3295 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3298 C Ufff.... We've done all this!!!
3301 C---------------------------------------------------------------------------
3302 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3304 implicit real*8 (a-h,o-z)
3305 include 'DIMENSIONS'
3306 include 'COMMON.LOCAL'
3307 include 'COMMON.IOUNITS'
3308 common /calcthet/ term1,term2,termm,diffak,ratak,
3309 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3310 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3311 C Calculate the contributions to both Gaussian lobes.
3312 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3313 C The "polynomial part" of the "standard deviation" of this part of
3317 sig=sig*thet_pred_mean+polthet(j,it)
3319 C Derivative of the "interior part" of the "standard deviation of the"
3320 C gamma-dependent Gaussian lobe in t_c.
3321 sigtc=3*polthet(3,it)
3323 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3326 C Set the parameters of both Gaussian lobes of the distribution.
3327 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3328 fac=sig*sig+sigc0(it)
3331 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3332 sigsqtc=-4.0D0*sigcsq*sigtc
3333 c print *,i,sig,sigtc,sigsqtc
3334 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3335 sigtc=-sigtc/(fac*fac)
3336 C Following variable is sigma(t_c)**(-2)
3337 sigcsq=sigcsq*sigcsq
3339 sig0inv=1.0D0/sig0i**2
3340 delthec=thetai-thet_pred_mean
3341 delthe0=thetai-theta0i
3342 term1=-0.5D0*sigcsq*delthec*delthec
3343 term2=-0.5D0*sig0inv*delthe0*delthe0
3344 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3345 C NaNs in taking the logarithm. We extract the largest exponent which is added
3346 C to the energy (this being the log of the distribution) at the end of energy
3347 C term evaluation for this virtual-bond angle.
3348 if (term1.gt.term2) then
3350 term2=dexp(term2-termm)
3354 term1=dexp(term1-termm)
3357 C The ratio between the gamma-independent and gamma-dependent lobes of
3358 C the distribution is a Gaussian function of thet_pred_mean too.
3359 diffak=gthet(2,it)-thet_pred_mean
3360 ratak=diffak/gthet(3,it)**2
3361 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3362 C Let's differentiate it in thet_pred_mean NOW.
3364 C Now put together the distribution terms to make complete distribution.
3365 termexp=term1+ak*term2
3366 termpre=sigc+ak*sig0i
3367 C Contribution of the bending energy from this theta is just the -log of
3368 C the sum of the contributions from the two lobes and the pre-exponential
3369 C factor. Simple enough, isn't it?
3370 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3371 C NOW the derivatives!!!
3372 C 6/6/97 Take into account the deformation.
3373 E_theta=(delthec*sigcsq*term1
3374 & +ak*delthe0*sig0inv*term2)/termexp
3375 E_tc=((sigtc+aktc*sig0i)/termpre
3376 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3377 & aktc*term2)/termexp)
3380 c-----------------------------------------------------------------------------
3381 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3382 implicit real*8 (a-h,o-z)
3383 include 'DIMENSIONS'
3384 include 'COMMON.LOCAL'
3385 include 'COMMON.IOUNITS'
3386 common /calcthet/ term1,term2,termm,diffak,ratak,
3387 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3388 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3389 delthec=thetai-thet_pred_mean
3390 delthe0=thetai-theta0i
3391 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3392 t3 = thetai-thet_pred_mean
3396 t14 = t12+t6*sigsqtc
3398 t21 = thetai-theta0i
3404 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3405 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3406 & *(-t12*t9-ak*sig0inv*t27)
3410 C--------------------------------------------------------------------------
3411 subroutine ebend(etheta)
3413 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3414 C angles gamma and its derivatives in consecutive thetas and gammas.
3415 C ab initio-derived potentials from
3416 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3418 implicit real*8 (a-h,o-z)
3419 include 'DIMENSIONS'
3420 include 'DIMENSIONS.ZSCOPT'
3421 include 'COMMON.LOCAL'
3422 include 'COMMON.GEO'
3423 include 'COMMON.INTERACT'
3424 include 'COMMON.DERIV'
3425 include 'COMMON.VAR'
3426 include 'COMMON.CHAIN'
3427 include 'COMMON.IOUNITS'
3428 include 'COMMON.NAMES'
3429 include 'COMMON.FFIELD'
3430 include 'COMMON.CONTROL'
3431 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3432 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3433 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3434 & sinph1ph2(maxdouble,maxdouble)
3435 logical lprn /.false./, lprn1 /.false./
3437 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3438 do i=ithet_start,ithet_end
3442 theti2=0.5d0*theta(i)
3443 ityp2=ithetyp(iabs(itype(i-1)))
3445 coskt(k)=dcos(k*theti2)
3446 sinkt(k)=dsin(k*theti2)
3451 if (phii.ne.phii) phii=150.0
3455 ityp1=ithetyp(iabs(itype(i-2)))
3457 cosph1(k)=dcos(k*phii)
3458 sinph1(k)=dsin(k*phii)
3471 if (phii1.ne.phii1) phii1=150.0
3476 ityp3=ithetyp(iabs(itype(i)))
3478 cosph2(k)=dcos(k*phii1)
3479 sinph2(k)=dsin(k*phii1)
3489 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3490 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3492 ethetai=aa0thet(ityp1,ityp2,ityp3)
3495 ccl=cosph1(l)*cosph2(k-l)
3496 ssl=sinph1(l)*sinph2(k-l)
3497 scl=sinph1(l)*cosph2(k-l)
3498 csl=cosph1(l)*sinph2(k-l)
3499 cosph1ph2(l,k)=ccl-ssl
3500 cosph1ph2(k,l)=ccl+ssl
3501 sinph1ph2(l,k)=scl+csl
3502 sinph1ph2(k,l)=scl-csl
3506 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3507 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3508 write (iout,*) "coskt and sinkt"
3510 write (iout,*) k,coskt(k),sinkt(k)
3514 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3515 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3518 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3519 & " ethetai",ethetai
3522 write (iout,*) "cosph and sinph"
3524 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3526 write (iout,*) "cosph1ph2 and sinph2ph2"
3529 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3530 & sinph1ph2(l,k),sinph1ph2(k,l)
3533 write(iout,*) "ethetai",ethetai
3537 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3538 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3539 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3540 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3541 ethetai=ethetai+sinkt(m)*aux
3542 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3543 dephii=dephii+k*sinkt(m)*(
3544 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3545 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3546 dephii1=dephii1+k*sinkt(m)*(
3547 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3548 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3550 & write (iout,*) "m",m," k",k," bbthet",
3551 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3552 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3553 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3554 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3558 & write(iout,*) "ethetai",ethetai
3562 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3563 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3564 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3565 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3566 ethetai=ethetai+sinkt(m)*aux
3567 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3568 dephii=dephii+l*sinkt(m)*(
3569 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3570 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3571 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3572 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3573 dephii1=dephii1+(k-l)*sinkt(m)*(
3574 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3575 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3576 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3577 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3579 write (iout,*) "m",m," k",k," l",l," ffthet",
3580 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3581 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3582 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3583 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3584 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3585 & cosph1ph2(k,l)*sinkt(m),
3586 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3592 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3593 & i,theta(i)*rad2deg,phii*rad2deg,
3594 & phii1*rad2deg,ethetai
3595 etheta=etheta+ethetai
3596 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3597 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3598 gloc(nphi+i-2,icg)=wang*dethetai
3604 c-----------------------------------------------------------------------------
3605 subroutine esc(escloc)
3606 C Calculate the local energy of a side chain and its derivatives in the
3607 C corresponding virtual-bond valence angles THETA and the spherical angles
3609 implicit real*8 (a-h,o-z)
3610 include 'DIMENSIONS'
3611 include 'DIMENSIONS.ZSCOPT'
3612 include 'COMMON.GEO'
3613 include 'COMMON.LOCAL'
3614 include 'COMMON.VAR'
3615 include 'COMMON.INTERACT'
3616 include 'COMMON.DERIV'
3617 include 'COMMON.CHAIN'
3618 include 'COMMON.IOUNITS'
3619 include 'COMMON.NAMES'
3620 include 'COMMON.FFIELD'
3621 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3622 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3623 common /sccalc/ time11,time12,time112,theti,it,nlobit
3626 c write (iout,'(a)') 'ESC'
3627 do i=loc_start,loc_end
3629 if (it.eq.10) goto 1
3630 nlobit=nlob(iabs(it))
3631 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3632 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3633 theti=theta(i+1)-pipol
3637 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3639 if (x(2).gt.pi-delta) then
3643 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3645 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3646 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3648 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3649 & ddersc0(1),dersc(1))
3650 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3651 & ddersc0(3),dersc(3))
3653 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3655 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3656 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3657 & dersc0(2),esclocbi,dersc02)
3658 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3660 call splinthet(x(2),0.5d0*delta,ss,ssd)
3665 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3667 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3668 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3670 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3672 c write (iout,*) escloci
3673 else if (x(2).lt.delta) then
3677 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3679 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3680 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3682 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3683 & ddersc0(1),dersc(1))
3684 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3685 & ddersc0(3),dersc(3))
3687 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3689 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3690 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3691 & dersc0(2),esclocbi,dersc02)
3692 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3697 call splinthet(x(2),0.5d0*delta,ss,ssd)
3699 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3701 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3702 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3704 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3705 c write (iout,*) escloci
3707 call enesc(x,escloci,dersc,ddummy,.false.)
3710 escloc=escloc+escloci
3711 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3713 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3715 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3716 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3721 C---------------------------------------------------------------------------
3722 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3723 implicit real*8 (a-h,o-z)
3724 include 'DIMENSIONS'
3725 include 'COMMON.GEO'
3726 include 'COMMON.LOCAL'
3727 include 'COMMON.IOUNITS'
3728 common /sccalc/ time11,time12,time112,theti,it,nlobit
3729 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3730 double precision contr(maxlob,-1:1)
3732 c write (iout,*) 'it=',it,' nlobit=',nlobit
3736 if (mixed) ddersc(j)=0.0d0
3740 C Because of periodicity of the dependence of the SC energy in omega we have
3741 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3742 C To avoid underflows, first compute & store the exponents.
3750 z(k)=x(k)-censc(k,j,it)
3755 Axk=Axk+gaussc(l,k,j,it)*z(l)
3761 expfac=expfac+Ax(k,j,iii)*z(k)
3769 C As in the case of ebend, we want to avoid underflows in exponentiation and
3770 C subsequent NaNs and INFs in energy calculation.
3771 C Find the largest exponent
3775 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3779 cd print *,'it=',it,' emin=',emin
3781 C Compute the contribution to SC energy and derivatives
3785 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3786 cd print *,'j=',j,' expfac=',expfac
3787 escloc_i=escloc_i+expfac
3789 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3793 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3794 & +gaussc(k,2,j,it))*expfac
3801 dersc(1)=dersc(1)/cos(theti)**2
3802 ddersc(1)=ddersc(1)/cos(theti)**2
3805 escloci=-(dlog(escloc_i)-emin)
3807 dersc(j)=dersc(j)/escloc_i
3811 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3816 C------------------------------------------------------------------------------
3817 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3818 implicit real*8 (a-h,o-z)
3819 include 'DIMENSIONS'
3820 include 'COMMON.GEO'
3821 include 'COMMON.LOCAL'
3822 include 'COMMON.IOUNITS'
3823 common /sccalc/ time11,time12,time112,theti,it,nlobit
3824 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3825 double precision contr(maxlob)
3836 z(k)=x(k)-censc(k,j,it)
3842 Axk=Axk+gaussc(l,k,j,it)*z(l)
3848 expfac=expfac+Ax(k,j)*z(k)
3853 C As in the case of ebend, we want to avoid underflows in exponentiation and
3854 C subsequent NaNs and INFs in energy calculation.
3855 C Find the largest exponent
3858 if (emin.gt.contr(j)) emin=contr(j)
3862 C Compute the contribution to SC energy and derivatives
3866 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3867 escloc_i=escloc_i+expfac
3869 dersc(k)=dersc(k)+Ax(k,j)*expfac
3871 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3872 & +gaussc(1,2,j,it))*expfac
3876 dersc(1)=dersc(1)/cos(theti)**2
3877 dersc12=dersc12/cos(theti)**2
3878 escloci=-(dlog(escloc_i)-emin)
3880 dersc(j)=dersc(j)/escloc_i
3882 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3886 c----------------------------------------------------------------------------------
3887 subroutine esc(escloc)
3888 C Calculate the local energy of a side chain and its derivatives in the
3889 C corresponding virtual-bond valence angles THETA and the spherical angles
3890 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3891 C added by Urszula Kozlowska. 07/11/2007
3893 implicit real*8 (a-h,o-z)
3894 include 'DIMENSIONS'
3895 include 'DIMENSIONS.ZSCOPT'
3896 include 'COMMON.GEO'
3897 include 'COMMON.LOCAL'
3898 include 'COMMON.VAR'
3899 include 'COMMON.SCROT'
3900 include 'COMMON.INTERACT'
3901 include 'COMMON.DERIV'
3902 include 'COMMON.CHAIN'
3903 include 'COMMON.IOUNITS'
3904 include 'COMMON.NAMES'
3905 include 'COMMON.FFIELD'
3906 include 'COMMON.CONTROL'
3907 include 'COMMON.VECTORS'
3908 double precision x_prime(3),y_prime(3),z_prime(3)
3909 & , sumene,dsc_i,dp2_i,x(65),
3910 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3911 & de_dxx,de_dyy,de_dzz,de_dt
3912 double precision s1_t,s1_6_t,s2_t,s2_6_t
3914 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3915 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3916 & dt_dCi(3),dt_dCi1(3)
3917 common /sccalc/ time11,time12,time112,theti,it,nlobit
3920 do i=loc_start,loc_end
3921 costtab(i+1) =dcos(theta(i+1))
3922 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3923 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3924 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3925 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3926 cosfac=dsqrt(cosfac2)
3927 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3928 sinfac=dsqrt(sinfac2)
3930 if (it.eq.10) goto 1
3932 C Compute the axes of tghe local cartesian coordinates system; store in
3933 c x_prime, y_prime and z_prime
3940 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3941 C & dc_norm(3,i+nres)
3943 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3944 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3947 z_prime(j) = -uz(j,i-1)
3950 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3951 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3952 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3953 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3954 c & " xy",scalar(x_prime(1),y_prime(1)),
3955 c & " xz",scalar(x_prime(1),z_prime(1)),
3956 c & " yy",scalar(y_prime(1),y_prime(1)),
3957 c & " yz",scalar(y_prime(1),z_prime(1)),
3958 c & " zz",scalar(z_prime(1),z_prime(1))
3960 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3961 C to local coordinate system. Store in xx, yy, zz.
3967 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3968 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3969 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
3976 C Compute the energy of the ith side cbain
3978 c write (2,*) "xx",xx," yy",yy," zz",zz
3981 x(j) = sc_parmin(j,it)
3984 Cc diagnostics - remove later
3986 yy1 = dsin(alph(2))*dcos(omeg(2))
3987 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3988 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3989 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3991 C," --- ", xx_w,yy_w,zz_w
3994 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3995 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3997 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3998 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4000 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4001 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4002 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4003 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4004 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4006 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4007 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4008 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4009 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4010 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4012 dsc_i = 0.743d0+x(61)
4014 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4015 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4016 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4017 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4018 s1=(1+x(63))/(0.1d0 + dscp1)
4019 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4020 s2=(1+x(65))/(0.1d0 + dscp2)
4021 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4022 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4023 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4024 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4026 c & dscp1,dscp2,sumene
4027 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4028 escloc = escloc + sumene
4029 c write (2,*) "escloc",escloc
4030 if (.not. calc_grad) goto 1
4033 C This section to check the numerical derivatives of the energy of ith side
4034 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4035 C #define DEBUG in the code to turn it on.
4037 write (2,*) "sumene =",sumene
4041 write (2,*) xx,yy,zz
4042 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4043 de_dxx_num=(sumenep-sumene)/aincr
4045 write (2,*) "xx+ sumene from enesc=",sumenep
4048 write (2,*) xx,yy,zz
4049 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4050 de_dyy_num=(sumenep-sumene)/aincr
4052 write (2,*) "yy+ sumene from enesc=",sumenep
4055 write (2,*) xx,yy,zz
4056 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4057 de_dzz_num=(sumenep-sumene)/aincr
4059 write (2,*) "zz+ sumene from enesc=",sumenep
4060 costsave=cost2tab(i+1)
4061 sintsave=sint2tab(i+1)
4062 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4063 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4064 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4065 de_dt_num=(sumenep-sumene)/aincr
4066 write (2,*) " t+ sumene from enesc=",sumenep
4067 cost2tab(i+1)=costsave
4068 sint2tab(i+1)=sintsave
4069 C End of diagnostics section.
4072 C Compute the gradient of esc
4074 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4075 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4076 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4077 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4078 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4079 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4080 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4081 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4082 pom1=(sumene3*sint2tab(i+1)+sumene1)
4083 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4084 pom2=(sumene4*cost2tab(i+1)+sumene2)
4085 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4086 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4087 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4088 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4090 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4091 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4092 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4094 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4095 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4096 & +(pom1+pom2)*pom_dx
4098 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4101 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4102 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4103 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4105 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4106 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4107 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4108 & +x(59)*zz**2 +x(60)*xx*zz
4109 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4110 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4111 & +(pom1-pom2)*pom_dy
4113 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4116 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4117 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4118 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4119 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4120 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4121 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4122 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4123 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4125 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4128 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4129 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4130 & +pom1*pom_dt1+pom2*pom_dt2
4132 write(2,*), "de_dt = ", de_dt,de_dt_num
4136 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4137 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4138 cosfac2xx=cosfac2*xx
4139 sinfac2yy=sinfac2*yy
4141 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4143 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4145 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4146 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4147 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4148 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4149 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4150 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4151 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4152 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4153 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4154 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4158 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4159 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4162 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4163 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4164 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4166 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4167 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4171 dXX_Ctab(k,i)=dXX_Ci(k)
4172 dXX_C1tab(k,i)=dXX_Ci1(k)
4173 dYY_Ctab(k,i)=dYY_Ci(k)
4174 dYY_C1tab(k,i)=dYY_Ci1(k)
4175 dZZ_Ctab(k,i)=dZZ_Ci(k)
4176 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4177 dXX_XYZtab(k,i)=dXX_XYZ(k)
4178 dYY_XYZtab(k,i)=dYY_XYZ(k)
4179 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4183 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4184 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4185 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4186 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4187 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4189 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4190 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4191 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4192 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4193 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4194 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4195 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4196 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4198 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4199 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4201 C to check gradient call subroutine check_grad
4208 c------------------------------------------------------------------------------
4209 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4211 C This procedure calculates two-body contact function g(rij) and its derivative:
4214 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4217 C where x=(rij-r0ij)/delta
4219 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4222 double precision rij,r0ij,eps0ij,fcont,fprimcont
4223 double precision x,x2,x4,delta
4227 if (x.lt.-1.0D0) then
4230 else if (x.le.1.0D0) then
4233 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4234 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4241 c------------------------------------------------------------------------------
4242 subroutine splinthet(theti,delta,ss,ssder)
4243 implicit real*8 (a-h,o-z)
4244 include 'DIMENSIONS'
4245 include 'DIMENSIONS.ZSCOPT'
4246 include 'COMMON.VAR'
4247 include 'COMMON.GEO'
4250 if (theti.gt.pipol) then
4251 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4253 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4258 c------------------------------------------------------------------------------
4259 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4261 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4262 double precision ksi,ksi2,ksi3,a1,a2,a3
4263 a1=fprim0*delta/(f1-f0)
4269 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4270 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4273 c------------------------------------------------------------------------------
4274 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4276 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4277 double precision ksi,ksi2,ksi3,a1,a2,a3
4282 a2=3*(f1x-f0x)-2*fprim0x*delta
4283 a3=fprim0x*delta-2*(f1x-f0x)
4284 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4287 C-----------------------------------------------------------------------------
4289 C-----------------------------------------------------------------------------
4290 subroutine etor(etors,edihcnstr,fact)
4291 implicit real*8 (a-h,o-z)
4292 include 'DIMENSIONS'
4293 include 'DIMENSIONS.ZSCOPT'
4294 include 'COMMON.VAR'
4295 include 'COMMON.GEO'
4296 include 'COMMON.LOCAL'
4297 include 'COMMON.TORSION'
4298 include 'COMMON.INTERACT'
4299 include 'COMMON.DERIV'
4300 include 'COMMON.CHAIN'
4301 include 'COMMON.NAMES'
4302 include 'COMMON.IOUNITS'
4303 include 'COMMON.FFIELD'
4304 include 'COMMON.TORCNSTR'
4306 C Set lprn=.true. for debugging
4310 do i=iphi_start,iphi_end
4311 itori=itortyp(itype(i-2))
4312 itori1=itortyp(itype(i-1))
4315 C Proline-Proline pair is a special case...
4316 if (itori.eq.3 .and. itori1.eq.3) then
4317 if (phii.gt.-dwapi3) then
4319 fac=1.0D0/(1.0D0-cosphi)
4320 etorsi=v1(1,3,3)*fac
4321 etorsi=etorsi+etorsi
4322 etors=etors+etorsi-v1(1,3,3)
4323 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4326 v1ij=v1(j+1,itori,itori1)
4327 v2ij=v2(j+1,itori,itori1)
4330 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4331 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4335 v1ij=v1(j,itori,itori1)
4336 v2ij=v2(j,itori,itori1)
4339 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4340 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4344 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4345 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4346 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4347 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4348 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4350 ! 6/20/98 - dihedral angle constraints
4353 itori=idih_constr(i)
4356 if (difi.gt.drange(i)) then
4358 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4359 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4360 else if (difi.lt.-drange(i)) then
4362 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4363 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4365 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4366 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4368 ! write (iout,*) 'edihcnstr',edihcnstr
4371 c------------------------------------------------------------------------------
4373 subroutine etor(etors,edihcnstr,fact)
4374 implicit real*8 (a-h,o-z)
4375 include 'DIMENSIONS'
4376 include 'DIMENSIONS.ZSCOPT'
4377 include 'COMMON.VAR'
4378 include 'COMMON.GEO'
4379 include 'COMMON.LOCAL'
4380 include 'COMMON.TORSION'
4381 include 'COMMON.INTERACT'
4382 include 'COMMON.DERIV'
4383 include 'COMMON.CHAIN'
4384 include 'COMMON.NAMES'
4385 include 'COMMON.IOUNITS'
4386 include 'COMMON.FFIELD'
4387 include 'COMMON.TORCNSTR'
4389 C Set lprn=.true. for debugging
4393 do i=iphi_start,iphi_end
4394 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4395 if (iabs(itype(i)).eq.20) then
4400 itori=itortyp(itype(i-2))
4401 itori1=itortyp(itype(i-1))
4404 C Regular cosine and sine terms
4405 do j=1,nterm(itori,itori1,iblock)
4406 v1ij=v1(j,itori,itori1,iblock)
4407 v2ij=v2(j,itori,itori1,iblock)
4410 etors=etors+v1ij*cosphi+v2ij*sinphi
4411 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4415 C E = SUM ----------------------------------- - v1
4416 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4418 cosphi=dcos(0.5d0*phii)
4419 sinphi=dsin(0.5d0*phii)
4420 do j=1,nlor(itori,itori1,iblock)
4421 vl1ij=vlor1(j,itori,itori1)
4422 vl2ij=vlor2(j,itori,itori1)
4423 vl3ij=vlor3(j,itori,itori1)
4424 pom=vl2ij*cosphi+vl3ij*sinphi
4425 pom1=1.0d0/(pom*pom+1.0d0)
4426 etors=etors+vl1ij*pom1
4428 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4430 C Subtract the constant term
4431 etors=etors-v0(itori,itori1,iblock)
4433 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4434 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4435 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4436 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4437 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4440 ! 6/20/98 - dihedral angle constraints
4443 itori=idih_constr(i)
4445 difi=pinorm(phii-phi0(i))
4447 if (difi.gt.drange(i)) then
4449 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4450 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4451 edihi=0.25d0*ftors*difi**4
4452 else if (difi.lt.-drange(i)) then
4454 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4455 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4456 edihi=0.25d0*ftors*difi**4
4460 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4462 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4463 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4465 ! write (iout,*) 'edihcnstr',edihcnstr
4468 c----------------------------------------------------------------------------
4469 subroutine etor_d(etors_d,fact2)
4470 C 6/23/01 Compute double torsional energy
4471 implicit real*8 (a-h,o-z)
4472 include 'DIMENSIONS'
4473 include 'DIMENSIONS.ZSCOPT'
4474 include 'COMMON.VAR'
4475 include 'COMMON.GEO'
4476 include 'COMMON.LOCAL'
4477 include 'COMMON.TORSION'
4478 include 'COMMON.INTERACT'
4479 include 'COMMON.DERIV'
4480 include 'COMMON.CHAIN'
4481 include 'COMMON.NAMES'
4482 include 'COMMON.IOUNITS'
4483 include 'COMMON.FFIELD'
4484 include 'COMMON.TORCNSTR'
4486 C Set lprn=.true. for debugging
4490 do i=iphi_start,iphi_end-1
4491 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4493 itori=itortyp(itype(i-2))
4494 itori1=itortyp(itype(i-1))
4495 itori2=itortyp(itype(i))
4497 c if (iabs(itype(i+1)).eq.20) iblock=2
4503 if (iabs(itype(i+1)).eq.20) iblock=2
4504 C Regular cosine and sine terms
4505 c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
4506 c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4507 c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4508 c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4509 c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4510 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4511 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4512 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4513 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4514 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4516 cosphi1=dcos(j*phii)
4517 sinphi1=dsin(j*phii)
4518 cosphi2=dcos(j*phii1)
4519 sinphi2=dsin(j*phii1)
4520 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4521 & v2cij*cosphi2+v2sij*sinphi2
4522 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4523 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4525 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4527 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4528 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4529 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4530 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4531 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4532 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4533 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4534 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4535 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4536 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4537 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4538 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4539 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4540 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4543 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4544 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4550 c------------------------------------------------------------------------------
4551 subroutine eback_sc_corr(esccor)
4552 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4553 c conformational states; temporarily implemented as differences
4554 c between UNRES torsional potentials (dependent on three types of
4555 c residues) and the torsional potentials dependent on all 20 types
4556 c of residues computed from AM1 energy surfaces of terminally-blocked
4557 c amino-acid residues.
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'DIMENSIONS.ZSCOPT'
4561 include 'COMMON.VAR'
4562 include 'COMMON.GEO'
4563 include 'COMMON.LOCAL'
4564 include 'COMMON.TORSION'
4565 include 'COMMON.SCCOR'
4566 include 'COMMON.INTERACT'
4567 include 'COMMON.DERIV'
4568 include 'COMMON.CHAIN'
4569 include 'COMMON.NAMES'
4570 include 'COMMON.IOUNITS'
4571 include 'COMMON.FFIELD'
4572 include 'COMMON.CONTROL'
4574 C Set lprn=.true. for debugging
4577 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4579 do i=itau_start,itau_end
4581 CC TU NIE MOZE BYC IABS DO ZMIANY JAK BEDA GOTOWE POTENCJALY AM1
4582 isccori=isccortyp(iabs(itype(i-2)))
4583 isccori1=isccortyp(iabs(itype(i-1)))
4585 cccc Added 9 May 2012
4586 cc Tauangle is torsional engle depending on the value of first digit
4587 c(see comment below)
4588 cc Omicron is flat angle depending on the value of first digit
4589 c(see comment below)
4592 do intertyp=1,3 !intertyp
4593 cc Added 09 May 2012 (Adasko)
4594 cc Intertyp means interaction type of backbone mainchain correlation:
4595 c 1 = SC...Ca...Ca...Ca
4596 c 2 = Ca...Ca...Ca...SC
4597 c 3 = SC...Ca...Ca...SCi
4599 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4600 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4601 & (itype(i-1).eq.ntyp1)))
4602 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4603 & .or.(itype(i-2).eq.ntyp1)))
4604 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4605 & (itype(i-1).eq.ntyp1)))) cycle
4606 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4607 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4609 do j=1,nterm_sccor(isccori,isccori1)
4610 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4611 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4612 cosphi=dcos(j*tauangle(intertyp,i))
4613 sinphi=dsin(j*tauangle(intertyp,i))
4614 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4615 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4617 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4618 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4619 c &gloc_sc(intertyp,i-3,icg)
4621 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4622 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4623 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4624 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4625 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4629 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4633 c------------------------------------------------------------------------------
4634 subroutine multibody(ecorr)
4635 C This subroutine calculates multi-body contributions to energy following
4636 C the idea of Skolnick et al. If side chains I and J make a contact and
4637 C at the same time side chains I+1 and J+1 make a contact, an extra
4638 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4639 implicit real*8 (a-h,o-z)
4640 include 'DIMENSIONS'
4641 include 'COMMON.IOUNITS'
4642 include 'COMMON.DERIV'
4643 include 'COMMON.INTERACT'
4644 include 'COMMON.CONTACTS'
4645 double precision gx(3),gx1(3)
4648 C Set lprn=.true. for debugging
4652 write (iout,'(a)') 'Contact function values:'
4654 write (iout,'(i2,20(1x,i2,f10.5))')
4655 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4670 num_conti=num_cont(i)
4671 num_conti1=num_cont(i1)
4676 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4677 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4678 cd & ' ishift=',ishift
4679 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4680 C The system gains extra energy.
4681 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4682 endif ! j1==j+-ishift
4691 c------------------------------------------------------------------------------
4692 double precision function esccorr(i,j,k,l,jj,kk)
4693 implicit real*8 (a-h,o-z)
4694 include 'DIMENSIONS'
4695 include 'COMMON.IOUNITS'
4696 include 'COMMON.DERIV'
4697 include 'COMMON.INTERACT'
4698 include 'COMMON.CONTACTS'
4699 double precision gx(3),gx1(3)
4704 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4705 C Calculate the multi-body contribution to energy.
4706 C Calculate multi-body contributions to the gradient.
4707 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4708 cd & k,l,(gacont(m,kk,k),m=1,3)
4710 gx(m) =ekl*gacont(m,jj,i)
4711 gx1(m)=eij*gacont(m,kk,k)
4712 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4713 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4714 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4715 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4719 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4724 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4730 c------------------------------------------------------------------------------
4732 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4733 implicit real*8 (a-h,o-z)
4734 include 'DIMENSIONS'
4735 integer dimen1,dimen2,atom,indx
4736 double precision buffer(dimen1,dimen2)
4737 double precision zapas
4738 common /contacts_hb/ zapas(3,20,maxres,7),
4739 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4740 & num_cont_hb(maxres),jcont_hb(20,maxres)
4741 num_kont=num_cont_hb(atom)
4745 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4748 buffer(i,indx+22)=facont_hb(i,atom)
4749 buffer(i,indx+23)=ees0p(i,atom)
4750 buffer(i,indx+24)=ees0m(i,atom)
4751 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4753 buffer(1,indx+26)=dfloat(num_kont)
4756 c------------------------------------------------------------------------------
4757 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4758 implicit real*8 (a-h,o-z)
4759 include 'DIMENSIONS'
4760 integer dimen1,dimen2,atom,indx
4761 double precision buffer(dimen1,dimen2)
4762 double precision zapas
4763 common /contacts_hb/ zapas(3,20,maxres,7),
4764 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4765 & num_cont_hb(maxres),jcont_hb(20,maxres)
4766 num_kont=buffer(1,indx+26)
4767 num_kont_old=num_cont_hb(atom)
4768 num_cont_hb(atom)=num_kont+num_kont_old
4773 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4776 facont_hb(ii,atom)=buffer(i,indx+22)
4777 ees0p(ii,atom)=buffer(i,indx+23)
4778 ees0m(ii,atom)=buffer(i,indx+24)
4779 jcont_hb(ii,atom)=buffer(i,indx+25)
4783 c------------------------------------------------------------------------------
4785 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4786 C This subroutine calculates multi-body contributions to hydrogen-bonding
4787 implicit real*8 (a-h,o-z)
4788 include 'DIMENSIONS'
4789 include 'DIMENSIONS.ZSCOPT'
4790 include 'COMMON.IOUNITS'
4792 include 'COMMON.INFO'
4794 include 'COMMON.FFIELD'
4795 include 'COMMON.DERIV'
4796 include 'COMMON.INTERACT'
4797 include 'COMMON.CONTACTS'
4799 parameter (max_cont=maxconts)
4800 parameter (max_dim=2*(8*3+2))
4801 parameter (msglen1=max_cont*max_dim*4)
4802 parameter (msglen2=2*msglen1)
4803 integer source,CorrelType,CorrelID,Error
4804 double precision buffer(max_cont,max_dim)
4806 double precision gx(3),gx1(3)
4809 C Set lprn=.true. for debugging
4814 if (fgProcs.le.1) goto 30
4816 write (iout,'(a)') 'Contact function values:'
4818 write (iout,'(2i3,50(1x,i2,f5.2))')
4819 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4820 & j=1,num_cont_hb(i))
4823 C Caution! Following code assumes that electrostatic interactions concerning
4824 C a given atom are split among at most two processors!
4834 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4837 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4838 if (MyRank.gt.0) then
4839 C Send correlation contributions to the preceding processor
4841 nn=num_cont_hb(iatel_s)
4842 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4843 cd write (iout,*) 'The BUFFER array:'
4845 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4847 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4849 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4850 C Clear the contacts of the atom passed to the neighboring processor
4851 nn=num_cont_hb(iatel_s+1)
4853 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4855 num_cont_hb(iatel_s)=0
4857 cd write (iout,*) 'Processor ',MyID,MyRank,
4858 cd & ' is sending correlation contribution to processor',MyID-1,
4859 cd & ' msglen=',msglen
4860 cd write (*,*) 'Processor ',MyID,MyRank,
4861 cd & ' is sending correlation contribution to processor',MyID-1,
4862 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4863 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4864 cd write (iout,*) 'Processor ',MyID,
4865 cd & ' has sent correlation contribution to processor',MyID-1,
4866 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4867 cd write (*,*) 'Processor ',MyID,
4868 cd & ' has sent correlation contribution to processor',MyID-1,
4869 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4871 endif ! (MyRank.gt.0)
4875 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4876 if (MyRank.lt.fgProcs-1) then
4877 C Receive correlation contributions from the next processor
4879 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4880 cd write (iout,*) 'Processor',MyID,
4881 cd & ' is receiving correlation contribution from processor',MyID+1,
4882 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4883 cd write (*,*) 'Processor',MyID,
4884 cd & ' is receiving correlation contribution from processor',MyID+1,
4885 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4887 do while (nbytes.le.0)
4888 call mp_probe(MyID+1,CorrelType,nbytes)
4890 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4891 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4892 cd write (iout,*) 'Processor',MyID,
4893 cd & ' has received correlation contribution from processor',MyID+1,
4894 cd & ' msglen=',msglen,' nbytes=',nbytes
4895 cd write (iout,*) 'The received BUFFER array:'
4897 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4899 if (msglen.eq.msglen1) then
4900 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4901 else if (msglen.eq.msglen2) then
4902 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4903 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4906 & 'ERROR!!!! message length changed while processing correlations.'
4908 & 'ERROR!!!! message length changed while processing correlations.'
4909 call mp_stopall(Error)
4910 endif ! msglen.eq.msglen1
4911 endif ! MyRank.lt.fgProcs-1
4918 write (iout,'(a)') 'Contact function values:'
4920 write (iout,'(2i3,50(1x,i2,f5.2))')
4921 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4922 & j=1,num_cont_hb(i))
4926 C Remove the loop below after debugging !!!
4933 C Calculate the local-electrostatic correlation terms
4934 do i=iatel_s,iatel_e+1
4936 num_conti=num_cont_hb(i)
4937 num_conti1=num_cont_hb(i+1)
4942 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4943 c & ' jj=',jj,' kk=',kk
4944 if (j1.eq.j+1 .or. j1.eq.j-1) then
4945 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4946 C The system gains extra energy.
4947 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4949 else if (j1.eq.j) then
4950 C Contacts I-J and I-(J+1) occur simultaneously.
4951 C The system loses extra energy.
4952 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4957 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4958 c & ' jj=',jj,' kk=',kk
4960 C Contacts I-J and (I+1)-J occur simultaneously.
4961 C The system loses extra energy.
4962 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4969 c------------------------------------------------------------------------------
4970 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4972 C This subroutine calculates multi-body contributions to hydrogen-bonding
4973 implicit real*8 (a-h,o-z)
4974 include 'DIMENSIONS'
4975 include 'DIMENSIONS.ZSCOPT'
4976 include 'COMMON.IOUNITS'
4978 include 'COMMON.INFO'
4980 include 'COMMON.FFIELD'
4981 include 'COMMON.DERIV'
4982 include 'COMMON.INTERACT'
4983 include 'COMMON.CONTACTS'
4985 parameter (max_cont=maxconts)
4986 parameter (max_dim=2*(8*3+2))
4987 parameter (msglen1=max_cont*max_dim*4)
4988 parameter (msglen2=2*msglen1)
4989 integer source,CorrelType,CorrelID,Error
4990 double precision buffer(max_cont,max_dim)
4992 double precision gx(3),gx1(3)
4995 C Set lprn=.true. for debugging
5001 if (fgProcs.le.1) goto 30
5003 write (iout,'(a)') 'Contact function values:'
5005 write (iout,'(2i3,50(1x,i2,f5.2))')
5006 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5007 & j=1,num_cont_hb(i))
5010 C Caution! Following code assumes that electrostatic interactions concerning
5011 C a given atom are split among at most two processors!
5021 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5024 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5025 if (MyRank.gt.0) then
5026 C Send correlation contributions to the preceding processor
5028 nn=num_cont_hb(iatel_s)
5029 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5030 cd write (iout,*) 'The BUFFER array:'
5032 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5034 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5036 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5037 C Clear the contacts of the atom passed to the neighboring processor
5038 nn=num_cont_hb(iatel_s+1)
5040 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5042 num_cont_hb(iatel_s)=0
5044 cd write (iout,*) 'Processor ',MyID,MyRank,
5045 cd & ' is sending correlation contribution to processor',MyID-1,
5046 cd & ' msglen=',msglen
5047 cd write (*,*) 'Processor ',MyID,MyRank,
5048 cd & ' is sending correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5050 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5051 cd write (iout,*) 'Processor ',MyID,
5052 cd & ' has sent correlation contribution to processor',MyID-1,
5053 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5054 cd write (*,*) 'Processor ',MyID,
5055 cd & ' has sent correlation contribution to processor',MyID-1,
5056 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5058 endif ! (MyRank.gt.0)
5062 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5063 if (MyRank.lt.fgProcs-1) then
5064 C Receive correlation contributions from the next processor
5066 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5067 cd write (iout,*) 'Processor',MyID,
5068 cd & ' is receiving correlation contribution from processor',MyID+1,
5069 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5070 cd write (*,*) 'Processor',MyID,
5071 cd & ' is receiving correlation contribution from processor',MyID+1,
5072 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5074 do while (nbytes.le.0)
5075 call mp_probe(MyID+1,CorrelType,nbytes)
5077 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5078 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5079 cd write (iout,*) 'Processor',MyID,
5080 cd & ' has received correlation contribution from processor',MyID+1,
5081 cd & ' msglen=',msglen,' nbytes=',nbytes
5082 cd write (iout,*) 'The received BUFFER array:'
5084 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5086 if (msglen.eq.msglen1) then
5087 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5088 else if (msglen.eq.msglen2) then
5089 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5090 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5093 & 'ERROR!!!! message length changed while processing correlations.'
5095 & 'ERROR!!!! message length changed while processing correlations.'
5096 call mp_stopall(Error)
5097 endif ! msglen.eq.msglen1
5098 endif ! MyRank.lt.fgProcs-1
5105 write (iout,'(a)') 'Contact function values:'
5107 write (iout,'(2i3,50(1x,i2,f5.2))')
5108 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5109 & j=1,num_cont_hb(i))
5115 C Remove the loop below after debugging !!!
5122 C Calculate the dipole-dipole interaction energies
5123 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5124 do i=iatel_s,iatel_e+1
5125 num_conti=num_cont_hb(i)
5132 C Calculate the local-electrostatic correlation terms
5133 do i=iatel_s,iatel_e+1
5135 num_conti=num_cont_hb(i)
5136 num_conti1=num_cont_hb(i+1)
5141 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5142 c & ' jj=',jj,' kk=',kk
5143 if (j1.eq.j+1 .or. j1.eq.j-1) then
5144 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5145 C The system gains extra energy.
5147 sqd1=dsqrt(d_cont(jj,i))
5148 sqd2=dsqrt(d_cont(kk,i1))
5149 sred_geom = sqd1*sqd2
5150 IF (sred_geom.lt.cutoff_corr) THEN
5151 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5153 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5154 c & ' jj=',jj,' kk=',kk
5155 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5156 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5158 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5159 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5162 cd write (iout,*) 'sred_geom=',sred_geom,
5163 cd & ' ekont=',ekont,' fprim=',fprimcont
5164 call calc_eello(i,j,i+1,j1,jj,kk)
5165 if (wcorr4.gt.0.0d0)
5166 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5167 if (wcorr5.gt.0.0d0)
5168 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5169 c print *,"wcorr5",ecorr5
5170 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5171 cd write(2,*)'ijkl',i,j,i+1,j1
5172 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5173 & .or. wturn6.eq.0.0d0))then
5174 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5175 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5176 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5177 cd & 'ecorr6=',ecorr6
5178 cd write (iout,'(4e15.5)') sred_geom,
5179 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5180 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5181 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5182 else if (wturn6.gt.0.0d0
5183 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5184 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5185 eturn6=eturn6+eello_turn6(i,jj,kk)
5186 cd write (2,*) 'multibody_eello:eturn6',eturn6
5190 else if (j1.eq.j) then
5191 C Contacts I-J and I-(J+1) occur simultaneously.
5192 C The system loses extra energy.
5193 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5198 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5199 c & ' jj=',jj,' kk=',kk
5201 C Contacts I-J and (I+1)-J occur simultaneously.
5202 C The system loses extra energy.
5203 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5210 c------------------------------------------------------------------------------
5211 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5212 implicit real*8 (a-h,o-z)
5213 include 'DIMENSIONS'
5214 include 'COMMON.IOUNITS'
5215 include 'COMMON.DERIV'
5216 include 'COMMON.INTERACT'
5217 include 'COMMON.CONTACTS'
5218 double precision gx(3),gx1(3)
5228 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5229 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5230 C Following 4 lines for diagnostics.
5235 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5237 c write (iout,*)'Contacts have occurred for peptide groups',
5238 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5239 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5240 C Calculate the multi-body contribution to energy.
5241 ecorr=ecorr+ekont*ees
5243 C Calculate multi-body contributions to the gradient.
5245 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5246 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5247 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5248 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5249 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5250 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5251 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5252 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5253 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5254 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5255 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5256 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5257 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5258 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5262 gradcorr(ll,m)=gradcorr(ll,m)+
5263 & ees*ekl*gacont_hbr(ll,jj,i)-
5264 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5265 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5270 gradcorr(ll,m)=gradcorr(ll,m)+
5271 & ees*eij*gacont_hbr(ll,kk,k)-
5272 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5273 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5280 C---------------------------------------------------------------------------
5281 subroutine dipole(i,j,jj)
5282 implicit real*8 (a-h,o-z)
5283 include 'DIMENSIONS'
5284 include 'DIMENSIONS.ZSCOPT'
5285 include 'COMMON.IOUNITS'
5286 include 'COMMON.CHAIN'
5287 include 'COMMON.FFIELD'
5288 include 'COMMON.DERIV'
5289 include 'COMMON.INTERACT'
5290 include 'COMMON.CONTACTS'
5291 include 'COMMON.TORSION'
5292 include 'COMMON.VAR'
5293 include 'COMMON.GEO'
5294 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5296 iti1 = itortyp(itype(i+1))
5297 if (j.lt.nres-1) then
5298 itj1 = itortyp(itype(j+1))
5303 dipi(iii,1)=Ub2(iii,i)
5304 dipderi(iii)=Ub2der(iii,i)
5305 dipi(iii,2)=b1(iii,iti1)
5306 dipj(iii,1)=Ub2(iii,j)
5307 dipderj(iii)=Ub2der(iii,j)
5308 dipj(iii,2)=b1(iii,itj1)
5312 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5315 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5318 if (.not.calc_grad) return
5323 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5327 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5332 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5333 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5335 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5337 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5339 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5343 C---------------------------------------------------------------------------
5344 subroutine calc_eello(i,j,k,l,jj,kk)
5346 C This subroutine computes matrices and vectors needed to calculate
5347 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5349 implicit real*8 (a-h,o-z)
5350 include 'DIMENSIONS'
5351 include 'DIMENSIONS.ZSCOPT'
5352 include 'COMMON.IOUNITS'
5353 include 'COMMON.CHAIN'
5354 include 'COMMON.DERIV'
5355 include 'COMMON.INTERACT'
5356 include 'COMMON.CONTACTS'
5357 include 'COMMON.TORSION'
5358 include 'COMMON.VAR'
5359 include 'COMMON.GEO'
5360 include 'COMMON.FFIELD'
5361 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5362 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5365 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5366 cd & ' jj=',jj,' kk=',kk
5367 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5370 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5371 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5374 call transpose2(aa1(1,1),aa1t(1,1))
5375 call transpose2(aa2(1,1),aa2t(1,1))
5378 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5379 & aa1tder(1,1,lll,kkk))
5380 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5381 & aa2tder(1,1,lll,kkk))
5385 C parallel orientation of the two CA-CA-CA frames.
5387 iti=itortyp(itype(i))
5391 itk1=itortyp(itype(k+1))
5392 itj=itortyp(itype(j))
5393 if (l.lt.nres-1) then
5394 itl1=itortyp(itype(l+1))
5398 C A1 kernel(j+1) A2T
5400 cd write (iout,'(3f10.5,5x,3f10.5)')
5401 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5403 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5404 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5405 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5406 C Following matrices are needed only for 6-th order cumulants
5407 IF (wcorr6.gt.0.0d0) THEN
5408 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5409 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5410 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5411 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5412 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5413 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5414 & ADtEAderx(1,1,1,1,1,1))
5416 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5417 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5418 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5419 & ADtEA1derx(1,1,1,1,1,1))
5421 C End 6-th order cumulants
5424 cd write (2,*) 'In calc_eello6'
5426 cd write (2,*) 'iii=',iii
5428 cd write (2,*) 'kkk=',kkk
5430 cd write (2,'(3(2f10.5),5x)')
5431 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5436 call transpose2(EUgder(1,1,k),auxmat(1,1))
5437 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5438 call transpose2(EUg(1,1,k),auxmat(1,1))
5439 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5440 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5444 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5445 & EAEAderx(1,1,lll,kkk,iii,1))
5449 C A1T kernel(i+1) A2
5450 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5451 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5452 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5453 C Following matrices are needed only for 6-th order cumulants
5454 IF (wcorr6.gt.0.0d0) THEN
5455 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5456 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5457 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5458 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5459 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5460 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5461 & ADtEAderx(1,1,1,1,1,2))
5462 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5463 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5464 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5465 & ADtEA1derx(1,1,1,1,1,2))
5467 C End 6-th order cumulants
5468 call transpose2(EUgder(1,1,l),auxmat(1,1))
5469 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5470 call transpose2(EUg(1,1,l),auxmat(1,1))
5471 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5472 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5476 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5477 & EAEAderx(1,1,lll,kkk,iii,2))
5482 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5483 C They are needed only when the fifth- or the sixth-order cumulants are
5485 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5486 call transpose2(AEA(1,1,1),auxmat(1,1))
5487 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5488 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5489 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5490 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5491 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5492 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5493 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5494 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5495 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5496 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5497 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5498 call transpose2(AEA(1,1,2),auxmat(1,1))
5499 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5500 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5501 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5502 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5503 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5504 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5505 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5506 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5507 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5508 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5509 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5510 C Calculate the Cartesian derivatives of the vectors.
5514 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5515 call matvec2(auxmat(1,1),b1(1,iti),
5516 & AEAb1derx(1,lll,kkk,iii,1,1))
5517 call matvec2(auxmat(1,1),Ub2(1,i),
5518 & AEAb2derx(1,lll,kkk,iii,1,1))
5519 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5520 & AEAb1derx(1,lll,kkk,iii,2,1))
5521 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5522 & AEAb2derx(1,lll,kkk,iii,2,1))
5523 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5524 call matvec2(auxmat(1,1),b1(1,itj),
5525 & AEAb1derx(1,lll,kkk,iii,1,2))
5526 call matvec2(auxmat(1,1),Ub2(1,j),
5527 & AEAb2derx(1,lll,kkk,iii,1,2))
5528 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5529 & AEAb1derx(1,lll,kkk,iii,2,2))
5530 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5531 & AEAb2derx(1,lll,kkk,iii,2,2))
5538 C Antiparallel orientation of the two CA-CA-CA frames.
5540 iti=itortyp(itype(i))
5544 itk1=itortyp(itype(k+1))
5545 itl=itortyp(itype(l))
5546 itj=itortyp(itype(j))
5547 if (j.lt.nres-1) then
5548 itj1=itortyp(itype(j+1))
5552 C A2 kernel(j-1)T A1T
5553 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5554 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5555 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5556 C Following matrices are needed only for 6-th order cumulants
5557 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5558 & j.eq.i+4 .and. l.eq.i+3)) THEN
5559 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5560 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5561 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5562 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5563 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5564 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5565 & ADtEAderx(1,1,1,1,1,1))
5566 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5567 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5568 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5569 & ADtEA1derx(1,1,1,1,1,1))
5571 C End 6-th order cumulants
5572 call transpose2(EUgder(1,1,k),auxmat(1,1))
5573 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5574 call transpose2(EUg(1,1,k),auxmat(1,1))
5575 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5576 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5580 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5581 & EAEAderx(1,1,lll,kkk,iii,1))
5585 C A2T kernel(i+1)T A1
5586 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5587 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5588 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5589 C Following matrices are needed only for 6-th order cumulants
5590 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5591 & j.eq.i+4 .and. l.eq.i+3)) THEN
5592 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5593 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5594 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5595 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5597 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5598 & ADtEAderx(1,1,1,1,1,2))
5599 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5600 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5601 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5602 & ADtEA1derx(1,1,1,1,1,2))
5604 C End 6-th order cumulants
5605 call transpose2(EUgder(1,1,j),auxmat(1,1))
5606 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5607 call transpose2(EUg(1,1,j),auxmat(1,1))
5608 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5609 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5613 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5614 & EAEAderx(1,1,lll,kkk,iii,2))
5619 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5620 C They are needed only when the fifth- or the sixth-order cumulants are
5622 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5623 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5624 call transpose2(AEA(1,1,1),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5627 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5628 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5629 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5630 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5631 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5632 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5633 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5634 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5635 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5636 call transpose2(AEA(1,1,2),auxmat(1,1))
5637 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5639 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5640 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5641 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5642 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5643 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5644 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5645 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5646 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5647 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5648 C Calculate the Cartesian derivatives of the vectors.
5652 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5653 call matvec2(auxmat(1,1),b1(1,iti),
5654 & AEAb1derx(1,lll,kkk,iii,1,1))
5655 call matvec2(auxmat(1,1),Ub2(1,i),
5656 & AEAb2derx(1,lll,kkk,iii,1,1))
5657 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5658 & AEAb1derx(1,lll,kkk,iii,2,1))
5659 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5660 & AEAb2derx(1,lll,kkk,iii,2,1))
5661 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5662 call matvec2(auxmat(1,1),b1(1,itl),
5663 & AEAb1derx(1,lll,kkk,iii,1,2))
5664 call matvec2(auxmat(1,1),Ub2(1,l),
5665 & AEAb2derx(1,lll,kkk,iii,1,2))
5666 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5667 & AEAb1derx(1,lll,kkk,iii,2,2))
5668 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5669 & AEAb2derx(1,lll,kkk,iii,2,2))
5678 C---------------------------------------------------------------------------
5679 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5680 & KK,KKderg,AKA,AKAderg,AKAderx)
5684 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5685 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5686 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5691 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5693 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5696 cd if (lprn) write (2,*) 'In kernel'
5698 cd if (lprn) write (2,*) 'kkk=',kkk
5700 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5701 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5703 cd write (2,*) 'lll=',lll
5704 cd write (2,*) 'iii=1'
5706 cd write (2,'(3(2f10.5),5x)')
5707 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5710 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5711 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5713 cd write (2,*) 'lll=',lll
5714 cd write (2,*) 'iii=2'
5716 cd write (2,'(3(2f10.5),5x)')
5717 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5724 C---------------------------------------------------------------------------
5725 double precision function eello4(i,j,k,l,jj,kk)
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'DIMENSIONS.ZSCOPT'
5729 include 'COMMON.IOUNITS'
5730 include 'COMMON.CHAIN'
5731 include 'COMMON.DERIV'
5732 include 'COMMON.INTERACT'
5733 include 'COMMON.CONTACTS'
5734 include 'COMMON.TORSION'
5735 include 'COMMON.VAR'
5736 include 'COMMON.GEO'
5737 double precision pizda(2,2),ggg1(3),ggg2(3)
5738 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5742 cd print *,'eello4:',i,j,k,l,jj,kk
5743 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5744 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5745 cold eij=facont_hb(jj,i)
5746 cold ekl=facont_hb(kk,k)
5748 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5750 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5751 gcorr_loc(k-1)=gcorr_loc(k-1)
5752 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5754 gcorr_loc(l-1)=gcorr_loc(l-1)
5755 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5757 gcorr_loc(j-1)=gcorr_loc(j-1)
5758 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5763 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5764 & -EAEAderx(2,2,lll,kkk,iii,1)
5765 cd derx(lll,kkk,iii)=0.0d0
5769 cd gcorr_loc(l-1)=0.0d0
5770 cd gcorr_loc(j-1)=0.0d0
5771 cd gcorr_loc(k-1)=0.0d0
5773 cd write (iout,*)'Contacts have occurred for peptide groups',
5774 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5775 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5776 if (j.lt.nres-1) then
5783 if (l.lt.nres-1) then
5791 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5792 ggg1(ll)=eel4*g_contij(ll,1)
5793 ggg2(ll)=eel4*g_contij(ll,2)
5794 ghalf=0.5d0*ggg1(ll)
5796 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5797 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5798 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5799 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5800 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5801 ghalf=0.5d0*ggg2(ll)
5803 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5804 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5805 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5806 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5811 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5812 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5817 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5818 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5824 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5829 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5833 cd write (2,*) iii,gcorr_loc(iii)
5837 cd write (2,*) 'ekont',ekont
5838 cd write (iout,*) 'eello4',ekont*eel4
5841 C---------------------------------------------------------------------------
5842 double precision function eello5(i,j,k,l,jj,kk)
5843 implicit real*8 (a-h,o-z)
5844 include 'DIMENSIONS'
5845 include 'DIMENSIONS.ZSCOPT'
5846 include 'COMMON.IOUNITS'
5847 include 'COMMON.CHAIN'
5848 include 'COMMON.DERIV'
5849 include 'COMMON.INTERACT'
5850 include 'COMMON.CONTACTS'
5851 include 'COMMON.TORSION'
5852 include 'COMMON.VAR'
5853 include 'COMMON.GEO'
5854 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5855 double precision ggg1(3),ggg2(3)
5856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5861 C /l\ / \ \ / \ / \ / C
5862 C / \ / \ \ / \ / \ / C
5863 C j| o |l1 | o | o| o | | o |o C
5864 C \ |/k\| |/ \| / |/ \| |/ \| C
5865 C \i/ \ / \ / / \ / \ C
5867 C (I) (II) (III) (IV) C
5869 C eello5_1 eello5_2 eello5_3 eello5_4 C
5871 C Antiparallel chains C
5874 C /j\ / \ \ / \ / \ / C
5875 C / \ / \ \ / \ / \ / C
5876 C j1| o |l | o | o| o | | o |o C
5877 C \ |/k\| |/ \| / |/ \| |/ \| C
5878 C \i/ \ / \ / / \ / \ C
5880 C (I) (II) (III) (IV) C
5882 C eello5_1 eello5_2 eello5_3 eello5_4 C
5884 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5886 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5887 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5892 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5894 itk=itortyp(itype(k))
5895 itl=itortyp(itype(l))
5896 itj=itortyp(itype(j))
5901 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5902 cd & eel5_3_num,eel5_4_num)
5906 derx(lll,kkk,iii)=0.0d0
5910 cd eij=facont_hb(jj,i)
5911 cd ekl=facont_hb(kk,k)
5913 cd write (iout,*)'Contacts have occurred for peptide groups',
5914 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5916 C Contribution from the graph I.
5917 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5918 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5919 call transpose2(EUg(1,1,k),auxmat(1,1))
5920 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5921 vv(1)=pizda(1,1)-pizda(2,2)
5922 vv(2)=pizda(1,2)+pizda(2,1)
5923 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5926 C Explicit gradient in virtual-dihedral angles.
5927 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5928 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5929 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5930 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5931 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5932 vv(1)=pizda(1,1)-pizda(2,2)
5933 vv(2)=pizda(1,2)+pizda(2,1)
5934 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5935 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5936 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5937 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5938 vv(1)=pizda(1,1)-pizda(2,2)
5939 vv(2)=pizda(1,2)+pizda(2,1)
5941 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5942 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5945 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5946 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5947 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5949 C Cartesian gradient
5953 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5955 vv(1)=pizda(1,1)-pizda(2,2)
5956 vv(2)=pizda(1,2)+pizda(2,1)
5957 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5958 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5959 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5966 C Contribution from graph II
5967 call transpose2(EE(1,1,itk),auxmat(1,1))
5968 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5969 vv(1)=pizda(1,1)+pizda(2,2)
5970 vv(2)=pizda(2,1)-pizda(1,2)
5971 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5972 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5974 C Explicit gradient in virtual-dihedral angles.
5975 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5976 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5977 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5978 vv(1)=pizda(1,1)+pizda(2,2)
5979 vv(2)=pizda(2,1)-pizda(1,2)
5981 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5982 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5983 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5985 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5986 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5987 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5989 C Cartesian gradient
5993 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5995 vv(1)=pizda(1,1)+pizda(2,2)
5996 vv(2)=pizda(2,1)-pizda(1,2)
5997 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5998 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5999 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6008 C Parallel orientation
6009 C Contribution from graph III
6010 call transpose2(EUg(1,1,l),auxmat(1,1))
6011 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6012 vv(1)=pizda(1,1)-pizda(2,2)
6013 vv(2)=pizda(1,2)+pizda(2,1)
6014 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6015 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6017 C Explicit gradient in virtual-dihedral angles.
6018 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6019 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6020 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6021 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6022 vv(1)=pizda(1,1)-pizda(2,2)
6023 vv(2)=pizda(1,2)+pizda(2,1)
6024 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6025 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6026 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6027 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6028 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6029 vv(1)=pizda(1,1)-pizda(2,2)
6030 vv(2)=pizda(1,2)+pizda(2,1)
6031 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6032 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6033 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6034 C Cartesian gradient
6038 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6040 vv(1)=pizda(1,1)-pizda(2,2)
6041 vv(2)=pizda(1,2)+pizda(2,1)
6042 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6043 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6044 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6050 C Contribution from graph IV
6052 call transpose2(EE(1,1,itl),auxmat(1,1))
6053 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6054 vv(1)=pizda(1,1)+pizda(2,2)
6055 vv(2)=pizda(2,1)-pizda(1,2)
6056 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6057 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6059 C Explicit gradient in virtual-dihedral angles.
6060 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6061 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6062 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6063 vv(1)=pizda(1,1)+pizda(2,2)
6064 vv(2)=pizda(2,1)-pizda(1,2)
6065 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6066 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6067 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6068 C Cartesian gradient
6072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6074 vv(1)=pizda(1,1)+pizda(2,2)
6075 vv(2)=pizda(2,1)-pizda(1,2)
6076 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6077 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6078 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6084 C Antiparallel orientation
6085 C Contribution from graph III
6087 call transpose2(EUg(1,1,j),auxmat(1,1))
6088 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6089 vv(1)=pizda(1,1)-pizda(2,2)
6090 vv(2)=pizda(1,2)+pizda(2,1)
6091 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6092 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6094 C Explicit gradient in virtual-dihedral angles.
6095 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6096 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6097 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6098 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6099 vv(1)=pizda(1,1)-pizda(2,2)
6100 vv(2)=pizda(1,2)+pizda(2,1)
6101 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6102 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6103 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6104 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6105 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6106 vv(1)=pizda(1,1)-pizda(2,2)
6107 vv(2)=pizda(1,2)+pizda(2,1)
6108 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6109 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6110 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6111 C Cartesian gradient
6115 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6117 vv(1)=pizda(1,1)-pizda(2,2)
6118 vv(2)=pizda(1,2)+pizda(2,1)
6119 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6120 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6121 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6127 C Contribution from graph IV
6129 call transpose2(EE(1,1,itj),auxmat(1,1))
6130 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6131 vv(1)=pizda(1,1)+pizda(2,2)
6132 vv(2)=pizda(2,1)-pizda(1,2)
6133 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6134 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6136 C Explicit gradient in virtual-dihedral angles.
6137 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6138 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6139 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6140 vv(1)=pizda(1,1)+pizda(2,2)
6141 vv(2)=pizda(2,1)-pizda(1,2)
6142 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6143 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6144 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6145 C Cartesian gradient
6149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6151 vv(1)=pizda(1,1)+pizda(2,2)
6152 vv(2)=pizda(2,1)-pizda(1,2)
6153 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6154 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6155 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6162 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6163 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6164 cd write (2,*) 'ijkl',i,j,k,l
6165 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6166 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6168 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6169 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6170 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6171 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6173 if (j.lt.nres-1) then
6180 if (l.lt.nres-1) then
6190 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6192 ggg1(ll)=eel5*g_contij(ll,1)
6193 ggg2(ll)=eel5*g_contij(ll,2)
6194 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6195 ghalf=0.5d0*ggg1(ll)
6197 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6198 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6199 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6200 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6201 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6202 ghalf=0.5d0*ggg2(ll)
6204 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6205 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6206 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6207 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6212 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6213 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6218 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6219 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6225 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6230 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6234 cd write (2,*) iii,g_corr5_loc(iii)
6238 cd write (2,*) 'ekont',ekont
6239 cd write (iout,*) 'eello5',ekont*eel5
6242 c--------------------------------------------------------------------------
6243 double precision function eello6(i,j,k,l,jj,kk)
6244 implicit real*8 (a-h,o-z)
6245 include 'DIMENSIONS'
6246 include 'DIMENSIONS.ZSCOPT'
6247 include 'COMMON.IOUNITS'
6248 include 'COMMON.CHAIN'
6249 include 'COMMON.DERIV'
6250 include 'COMMON.INTERACT'
6251 include 'COMMON.CONTACTS'
6252 include 'COMMON.TORSION'
6253 include 'COMMON.VAR'
6254 include 'COMMON.GEO'
6255 include 'COMMON.FFIELD'
6256 double precision ggg1(3),ggg2(3)
6257 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6262 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6270 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6271 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6275 derx(lll,kkk,iii)=0.0d0
6279 cd eij=facont_hb(jj,i)
6280 cd ekl=facont_hb(kk,k)
6286 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6287 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6288 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6289 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6290 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6291 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6293 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6294 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6295 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6296 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6297 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6298 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6302 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6304 C If turn contributions are considered, they will be handled separately.
6305 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6306 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6307 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6308 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6309 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6310 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6311 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6314 if (j.lt.nres-1) then
6321 if (l.lt.nres-1) then
6329 ggg1(ll)=eel6*g_contij(ll,1)
6330 ggg2(ll)=eel6*g_contij(ll,2)
6331 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6332 ghalf=0.5d0*ggg1(ll)
6334 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6335 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6336 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6337 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6338 ghalf=0.5d0*ggg2(ll)
6339 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6341 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6342 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6343 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6344 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6349 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6350 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6355 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6356 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6362 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6367 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6371 cd write (2,*) iii,g_corr6_loc(iii)
6375 cd write (2,*) 'ekont',ekont
6376 cd write (iout,*) 'eello6',ekont*eel6
6379 c--------------------------------------------------------------------------
6380 double precision function eello6_graph1(i,j,k,l,imat,swap)
6381 implicit real*8 (a-h,o-z)
6382 include 'DIMENSIONS'
6383 include 'DIMENSIONS.ZSCOPT'
6384 include 'COMMON.IOUNITS'
6385 include 'COMMON.CHAIN'
6386 include 'COMMON.DERIV'
6387 include 'COMMON.INTERACT'
6388 include 'COMMON.CONTACTS'
6389 include 'COMMON.TORSION'
6390 include 'COMMON.VAR'
6391 include 'COMMON.GEO'
6392 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6396 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6398 C Parallel Antiparallel C
6404 C \ j|/k\| / \ |/k\|l / C
6409 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6410 itk=itortyp(itype(k))
6411 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6412 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6413 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6414 call transpose2(EUgC(1,1,k),auxmat(1,1))
6415 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6416 vv1(1)=pizda1(1,1)-pizda1(2,2)
6417 vv1(2)=pizda1(1,2)+pizda1(2,1)
6418 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6419 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6420 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6421 s5=scalar2(vv(1),Dtobr2(1,i))
6422 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6423 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6424 if (.not. calc_grad) return
6425 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6426 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6427 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6428 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6429 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6430 & +scalar2(vv(1),Dtobr2der(1,i)))
6431 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6432 vv1(1)=pizda1(1,1)-pizda1(2,2)
6433 vv1(2)=pizda1(1,2)+pizda1(2,1)
6434 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6435 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6437 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6438 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6439 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6440 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6441 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6443 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6444 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6445 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6446 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6447 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6449 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6450 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6451 vv1(1)=pizda1(1,1)-pizda1(2,2)
6452 vv1(2)=pizda1(1,2)+pizda1(2,1)
6453 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6454 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6455 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6456 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6465 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6466 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6467 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6468 call transpose2(EUgC(1,1,k),auxmat(1,1))
6469 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6471 vv1(1)=pizda1(1,1)-pizda1(2,2)
6472 vv1(2)=pizda1(1,2)+pizda1(2,1)
6473 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6474 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6475 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6476 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6477 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6478 s5=scalar2(vv(1),Dtobr2(1,i))
6479 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6485 c----------------------------------------------------------------------------
6486 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6487 implicit real*8 (a-h,o-z)
6488 include 'DIMENSIONS'
6489 include 'DIMENSIONS.ZSCOPT'
6490 include 'COMMON.IOUNITS'
6491 include 'COMMON.CHAIN'
6492 include 'COMMON.DERIV'
6493 include 'COMMON.INTERACT'
6494 include 'COMMON.CONTACTS'
6495 include 'COMMON.TORSION'
6496 include 'COMMON.VAR'
6497 include 'COMMON.GEO'
6499 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6500 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6503 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6505 C Parallel Antiparallel C
6511 C \ j|/k\| \ |/k\|l C
6516 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6517 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6518 C AL 7/4/01 s1 would occur in the sixth-order moment,
6519 C but not in a cluster cumulant
6521 s1=dip(1,jj,i)*dip(1,kk,k)
6523 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6524 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6525 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6526 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6527 call transpose2(EUg(1,1,k),auxmat(1,1))
6528 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6529 vv(1)=pizda(1,1)-pizda(2,2)
6530 vv(2)=pizda(1,2)+pizda(2,1)
6531 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6532 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6534 eello6_graph2=-(s1+s2+s3+s4)
6536 eello6_graph2=-(s2+s3+s4)
6539 if (.not. calc_grad) return
6540 C Derivatives in gamma(i-1)
6543 s1=dipderg(1,jj,i)*dip(1,kk,k)
6545 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6546 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6547 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6548 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6550 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6552 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6554 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6556 C Derivatives in gamma(k-1)
6558 s1=dip(1,jj,i)*dipderg(1,kk,k)
6560 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6561 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6562 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6563 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6564 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6565 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6566 vv(1)=pizda(1,1)-pizda(2,2)
6567 vv(2)=pizda(1,2)+pizda(2,1)
6568 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6570 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6572 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6574 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6575 C Derivatives in gamma(j-1) or gamma(l-1)
6578 s1=dipderg(3,jj,i)*dip(1,kk,k)
6580 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6581 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6582 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6583 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6584 vv(1)=pizda(1,1)-pizda(2,2)
6585 vv(2)=pizda(1,2)+pizda(2,1)
6586 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6589 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6591 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6594 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6595 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6597 C Derivatives in gamma(l-1) or gamma(j-1)
6600 s1=dip(1,jj,i)*dipderg(3,kk,k)
6602 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6603 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6604 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6605 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6606 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6607 vv(1)=pizda(1,1)-pizda(2,2)
6608 vv(2)=pizda(1,2)+pizda(2,1)
6609 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6612 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6614 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6617 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6618 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6620 C Cartesian derivatives.
6622 write (2,*) 'In eello6_graph2'
6624 write (2,*) 'iii=',iii
6626 write (2,*) 'kkk=',kkk
6628 write (2,'(3(2f10.5),5x)')
6629 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6639 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6641 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6644 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6646 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6647 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6649 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6650 call transpose2(EUg(1,1,k),auxmat(1,1))
6651 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6653 vv(1)=pizda(1,1)-pizda(2,2)
6654 vv(2)=pizda(1,2)+pizda(2,1)
6655 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6656 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6658 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6660 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6663 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6665 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6672 c----------------------------------------------------------------------------
6673 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6674 implicit real*8 (a-h,o-z)
6675 include 'DIMENSIONS'
6676 include 'DIMENSIONS.ZSCOPT'
6677 include 'COMMON.IOUNITS'
6678 include 'COMMON.CHAIN'
6679 include 'COMMON.DERIV'
6680 include 'COMMON.INTERACT'
6681 include 'COMMON.CONTACTS'
6682 include 'COMMON.TORSION'
6683 include 'COMMON.VAR'
6684 include 'COMMON.GEO'
6685 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6687 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6689 C Parallel Antiparallel C
6695 C j|/k\| / |/k\|l / C
6700 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6702 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6703 C energy moment and not to the cluster cumulant.
6704 iti=itortyp(itype(i))
6705 if (j.lt.nres-1) then
6706 itj1=itortyp(itype(j+1))
6710 itk=itortyp(itype(k))
6711 itk1=itortyp(itype(k+1))
6712 if (l.lt.nres-1) then
6713 itl1=itortyp(itype(l+1))
6718 s1=dip(4,jj,i)*dip(4,kk,k)
6720 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6721 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6722 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6723 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6724 call transpose2(EE(1,1,itk),auxmat(1,1))
6725 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6726 vv(1)=pizda(1,1)+pizda(2,2)
6727 vv(2)=pizda(2,1)-pizda(1,2)
6728 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6729 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6731 eello6_graph3=-(s1+s2+s3+s4)
6733 eello6_graph3=-(s2+s3+s4)
6736 if (.not. calc_grad) return
6737 C Derivatives in gamma(k-1)
6738 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6739 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6740 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6741 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6742 C Derivatives in gamma(l-1)
6743 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6744 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6745 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6746 vv(1)=pizda(1,1)+pizda(2,2)
6747 vv(2)=pizda(2,1)-pizda(1,2)
6748 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6749 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6750 C Cartesian derivatives.
6756 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6758 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6761 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6763 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6764 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6766 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6767 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6769 vv(1)=pizda(1,1)+pizda(2,2)
6770 vv(2)=pizda(2,1)-pizda(1,2)
6771 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6773 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6775 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6778 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6780 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6782 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6788 c----------------------------------------------------------------------------
6789 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6790 implicit real*8 (a-h,o-z)
6791 include 'DIMENSIONS'
6792 include 'DIMENSIONS.ZSCOPT'
6793 include 'COMMON.IOUNITS'
6794 include 'COMMON.CHAIN'
6795 include 'COMMON.DERIV'
6796 include 'COMMON.INTERACT'
6797 include 'COMMON.CONTACTS'
6798 include 'COMMON.TORSION'
6799 include 'COMMON.VAR'
6800 include 'COMMON.GEO'
6801 include 'COMMON.FFIELD'
6802 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6803 & auxvec1(2),auxmat1(2,2)
6805 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6807 C Parallel Antiparallel C
6813 C \ j|/k\| \ |/k\|l C
6818 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6820 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6821 C energy moment and not to the cluster cumulant.
6822 cd write (2,*) 'eello_graph4: wturn6',wturn6
6823 iti=itortyp(itype(i))
6824 itj=itortyp(itype(j))
6825 if (j.lt.nres-1) then
6826 itj1=itortyp(itype(j+1))
6830 itk=itortyp(itype(k))
6831 if (k.lt.nres-1) then
6832 itk1=itortyp(itype(k+1))
6836 itl=itortyp(itype(l))
6837 if (l.lt.nres-1) then
6838 itl1=itortyp(itype(l+1))
6842 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6843 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6844 cd & ' itl',itl,' itl1',itl1
6847 s1=dip(3,jj,i)*dip(3,kk,k)
6849 s1=dip(2,jj,j)*dip(2,kk,l)
6852 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6853 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6855 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6856 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6858 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6859 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6861 call transpose2(EUg(1,1,k),auxmat(1,1))
6862 call matmat2(AECA(1,1,imat),auxmat(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 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6868 eello6_graph4=-(s1+s2+s3+s4)
6870 eello6_graph4=-(s2+s3+s4)
6872 if (.not. calc_grad) return
6873 C Derivatives in gamma(i-1)
6877 s1=dipderg(2,jj,i)*dip(3,kk,k)
6879 s1=dipderg(4,jj,j)*dip(2,kk,l)
6882 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6884 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6885 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6887 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6888 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6890 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6891 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6892 cd write (2,*) 'turn6 derivatives'
6894 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6896 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6900 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6902 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6906 C Derivatives in gamma(k-1)
6909 s1=dip(3,jj,i)*dipderg(2,kk,k)
6911 s1=dip(2,jj,j)*dipderg(4,kk,l)
6914 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6915 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6917 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6918 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6920 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6921 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6923 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6924 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6925 vv(1)=pizda(1,1)-pizda(2,2)
6926 vv(2)=pizda(2,1)+pizda(1,2)
6927 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6928 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6930 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6932 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6936 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6938 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6941 C Derivatives in gamma(j-1) or gamma(l-1)
6942 if (l.eq.j+1 .and. l.gt.1) then
6943 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6944 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6945 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6946 vv(1)=pizda(1,1)-pizda(2,2)
6947 vv(2)=pizda(2,1)+pizda(1,2)
6948 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6949 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6950 else if (j.gt.1) then
6951 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6952 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6953 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6954 vv(1)=pizda(1,1)-pizda(2,2)
6955 vv(2)=pizda(2,1)+pizda(1,2)
6956 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6957 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6958 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6960 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6963 C Cartesian derivatives.
6970 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6972 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6976 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6978 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6982 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6984 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6986 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6987 & b1(1,itj1),auxvec(1))
6988 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6990 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6991 & b1(1,itl1),auxvec(1))
6992 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6994 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6996 vv(1)=pizda(1,1)-pizda(2,2)
6997 vv(2)=pizda(2,1)+pizda(1,2)
6998 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7000 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7002 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7005 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7008 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7011 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7013 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7015 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7019 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7021 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7024 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7026 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7034 c----------------------------------------------------------------------------
7035 double precision function eello_turn6(i,jj,kk)
7036 implicit real*8 (a-h,o-z)
7037 include 'DIMENSIONS'
7038 include 'DIMENSIONS.ZSCOPT'
7039 include 'COMMON.IOUNITS'
7040 include 'COMMON.CHAIN'
7041 include 'COMMON.DERIV'
7042 include 'COMMON.INTERACT'
7043 include 'COMMON.CONTACTS'
7044 include 'COMMON.TORSION'
7045 include 'COMMON.VAR'
7046 include 'COMMON.GEO'
7047 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7048 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7050 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7051 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7052 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7053 C the respective energy moment and not to the cluster cumulant.
7058 iti=itortyp(itype(i))
7059 itk=itortyp(itype(k))
7060 itk1=itortyp(itype(k+1))
7061 itl=itortyp(itype(l))
7062 itj=itortyp(itype(j))
7063 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7064 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7065 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7070 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7072 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7076 derx_turn(lll,kkk,iii)=0.0d0
7083 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7085 cd write (2,*) 'eello6_5',eello6_5
7087 call transpose2(AEA(1,1,1),auxmat(1,1))
7088 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7089 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7090 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7094 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7095 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7096 s2 = scalar2(b1(1,itk),vtemp1(1))
7098 call transpose2(AEA(1,1,2),atemp(1,1))
7099 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7100 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7101 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7105 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7106 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7107 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7109 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7110 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7111 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7112 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7113 ss13 = scalar2(b1(1,itk),vtemp4(1))
7114 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7118 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7124 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7126 C Derivatives in gamma(i+2)
7128 call transpose2(AEA(1,1,1),auxmatd(1,1))
7129 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7130 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7131 call transpose2(AEAderg(1,1,2),atempd(1,1))
7132 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7133 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7137 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7138 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7139 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7145 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7146 C Derivatives in gamma(i+3)
7148 call transpose2(AEA(1,1,1),auxmatd(1,1))
7149 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7150 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7151 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7155 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7156 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7157 s2d = scalar2(b1(1,itk),vtemp1d(1))
7159 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7160 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7162 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7164 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7165 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7166 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7176 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7177 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7179 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7180 & -0.5d0*ekont*(s2d+s12d)
7182 C Derivatives in gamma(i+4)
7183 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7184 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7185 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7187 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7188 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7189 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7199 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7201 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7203 C Derivatives in gamma(i+5)
7205 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7206 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7207 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7211 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7212 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7213 s2d = scalar2(b1(1,itk),vtemp1d(1))
7215 call transpose2(AEA(1,1,2),atempd(1,1))
7216 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7217 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7221 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7222 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7224 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7225 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7226 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7236 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7237 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7239 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7240 & -0.5d0*ekont*(s2d+s12d)
7242 C Cartesian derivatives
7247 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7248 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7249 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7253 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7254 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7256 s2d = scalar2(b1(1,itk),vtemp1d(1))
7258 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7259 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7260 s8d = -(atempd(1,1)+atempd(2,2))*
7261 & scalar2(cc(1,1,itl),vtemp2(1))
7265 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7267 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7268 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7275 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7278 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7282 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7283 & - 0.5d0*(s8d+s12d)
7285 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7294 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7296 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7297 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7298 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7299 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7300 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7302 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7303 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7304 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7308 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7309 cd & 16*eel_turn6_num
7311 if (j.lt.nres-1) then
7318 if (l.lt.nres-1) then
7326 ggg1(ll)=eel_turn6*g_contij(ll,1)
7327 ggg2(ll)=eel_turn6*g_contij(ll,2)
7328 ghalf=0.5d0*ggg1(ll)
7330 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7331 & +ekont*derx_turn(ll,2,1)
7332 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7333 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7334 & +ekont*derx_turn(ll,4,1)
7335 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7336 ghalf=0.5d0*ggg2(ll)
7338 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7339 & +ekont*derx_turn(ll,2,2)
7340 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7341 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7342 & +ekont*derx_turn(ll,4,2)
7343 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7348 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7353 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7359 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7364 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7368 cd write (2,*) iii,g_corr6_loc(iii)
7371 eello_turn6=ekont*eel_turn6
7372 cd write (2,*) 'ekont',ekont
7373 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7376 crc-------------------------------------------------
7377 SUBROUTINE MATVEC2(A1,V1,V2)
7378 implicit real*8 (a-h,o-z)
7379 include 'DIMENSIONS'
7380 DIMENSION A1(2,2),V1(2),V2(2)
7384 c 3 VI=VI+A1(I,K)*V1(K)
7388 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7389 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7394 C---------------------------------------
7395 SUBROUTINE MATMAT2(A1,A2,A3)
7396 implicit real*8 (a-h,o-z)
7397 include 'DIMENSIONS'
7398 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7399 c DIMENSION AI3(2,2)
7403 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7409 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7410 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7411 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7412 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7420 c-------------------------------------------------------------------------
7421 double precision function scalar2(u,v)
7423 double precision u(2),v(2)
7426 scalar2=u(1)*v(1)+u(2)*v(2)
7430 C-----------------------------------------------------------------------------
7432 subroutine transpose2(a,at)
7434 double precision a(2,2),at(2,2)
7441 c--------------------------------------------------------------------------
7442 subroutine transpose(n,a,at)
7445 double precision a(n,n),at(n,n)
7453 C---------------------------------------------------------------------------
7454 subroutine prodmat3(a1,a2,kk,transp,prod)
7457 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7459 crc double precision auxmat(2,2),prod_(2,2)
7462 crc call transpose2(kk(1,1),auxmat(1,1))
7463 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7464 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7466 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7467 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7468 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7469 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7470 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7471 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7472 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7473 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7476 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7477 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7479 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7480 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7481 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7482 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7483 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7484 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7485 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7486 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7489 c call transpose2(a2(1,1),a2t(1,1))
7492 crc print *,((prod_(i,j),i=1,2),j=1,2)
7493 crc print *,((prod(i,j),i=1,2),j=1,2)
7497 C-----------------------------------------------------------------------------
7498 double precision function scalar(u,v)
7500 double precision u(3),v(3)