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
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
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
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.
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.
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)
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. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2901 call ssbond_ene(iii,jjj,eij)
2903 cd write (iout,*) "eij",eij
2904 else if (ii.gt.nres .and. jj.gt.nres) then
2905 c Restraints from contact prediction
2907 if (dhpb1(i).gt.0.0d0) then
2908 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2909 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2910 c write (iout,*) "beta nmr",
2911 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2915 C Get the force constant corresponding to this distance.
2917 C Calculate the contribution to energy.
2918 ehpb=ehpb+waga*rdis*rdis
2919 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2921 C Evaluate gradient.
2926 ggg(j)=fac*(c(j,jj)-c(j,ii))
2929 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2930 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2933 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2934 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2937 C Calculate the distance between the two points and its difference from the
2940 if (dhpb1(i).gt.0.0d0) then
2941 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2942 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2943 c write (iout,*) "alph nmr",
2944 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2947 C Get the force constant corresponding to this distance.
2949 C Calculate the contribution to energy.
2950 ehpb=ehpb+waga*rdis*rdis
2951 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2953 C Evaluate gradient.
2957 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2958 cd & ' waga=',waga,' fac=',fac
2960 ggg(j)=fac*(c(j,jj)-c(j,ii))
2962 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2963 C If this is a SC-SC distance, we need to calculate the contributions to the
2964 C Cartesian gradient in the SC vectors (ghpbx).
2967 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2968 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2972 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2973 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2980 C--------------------------------------------------------------------------
2981 subroutine ssbond_ene(i,j,eij)
2983 C Calculate the distance and angle dependent SS-bond potential energy
2984 C using a free-energy function derived based on RHF/6-31G** ab initio
2985 C calculations of diethyl disulfide.
2987 C A. Liwo and U. Kozlowska, 11/24/03
2989 implicit real*8 (a-h,o-z)
2990 include 'DIMENSIONS'
2991 include 'DIMENSIONS.ZSCOPT'
2992 include 'COMMON.SBRIDGE'
2993 include 'COMMON.CHAIN'
2994 include 'COMMON.DERIV'
2995 include 'COMMON.LOCAL'
2996 include 'COMMON.INTERACT'
2997 include 'COMMON.VAR'
2998 include 'COMMON.IOUNITS'
2999 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3004 dxi=dc_norm(1,nres+i)
3005 dyi=dc_norm(2,nres+i)
3006 dzi=dc_norm(3,nres+i)
3007 dsci_inv=dsc_inv(itypi)
3009 dscj_inv=dsc_inv(itypj)
3013 dxj=dc_norm(1,nres+j)
3014 dyj=dc_norm(2,nres+j)
3015 dzj=dc_norm(3,nres+j)
3016 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3021 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3022 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3023 om12=dxi*dxj+dyi*dyj+dzi*dzj
3025 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3026 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3032 deltat12=om2-om1+2.0d0
3034 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3035 & +akct*deltad*deltat12
3036 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3037 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3038 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3039 c & " deltat12",deltat12," eij",eij
3040 ed=2*akcm*deltad+akct*deltat12
3042 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3043 eom1=-2*akth*deltat1-pom1-om2*pom2
3044 eom2= 2*akth*deltat2+pom1-om1*pom2
3047 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3050 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3051 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3052 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3053 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3056 C Calculate the components of the gradient in DC and X
3060 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3065 C--------------------------------------------------------------------------
3066 subroutine ebond(estr)
3068 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3070 implicit real*8 (a-h,o-z)
3071 include 'DIMENSIONS'
3072 include 'DIMENSIONS.ZSCOPT'
3073 include 'COMMON.LOCAL'
3074 include 'COMMON.GEO'
3075 include 'COMMON.INTERACT'
3076 include 'COMMON.DERIV'
3077 include 'COMMON.VAR'
3078 include 'COMMON.CHAIN'
3079 include 'COMMON.IOUNITS'
3080 include 'COMMON.NAMES'
3081 include 'COMMON.FFIELD'
3082 include 'COMMON.CONTROL'
3083 double precision u(3),ud(3)
3086 diff = vbld(i)-vbldp0
3087 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3090 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3095 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3102 diff=vbld(i+nres)-vbldsc0(1,iti)
3103 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3104 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3105 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3107 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3111 diff=vbld(i+nres)-vbldsc0(j,iti)
3112 ud(j)=aksc(j,iti)*diff
3113 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3127 uprod2=uprod2*u(k)*u(k)
3131 usumsqder=usumsqder+ud(j)*uprod2
3133 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3134 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3135 estr=estr+uprod/usum
3137 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3145 C--------------------------------------------------------------------------
3146 subroutine ebend(etheta)
3148 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3149 C angles gamma and its derivatives in consecutive thetas and gammas.
3151 implicit real*8 (a-h,o-z)
3152 include 'DIMENSIONS'
3153 include 'DIMENSIONS.ZSCOPT'
3154 include 'COMMON.LOCAL'
3155 include 'COMMON.GEO'
3156 include 'COMMON.INTERACT'
3157 include 'COMMON.DERIV'
3158 include 'COMMON.VAR'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.IOUNITS'
3161 include 'COMMON.NAMES'
3162 include 'COMMON.FFIELD'
3163 common /calcthet/ term1,term2,termm,diffak,ratak,
3164 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3165 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3166 double precision y(2),z(2)
3168 time11=dexp(-2*time)
3171 c write (iout,*) "nres",nres
3172 c write (*,'(a,i2)') 'EBEND ICG=',icg
3173 c write (iout,*) ithet_start,ithet_end
3174 do i=ithet_start,ithet_end
3175 C Zero the energy function and its derivative at 0 or pi.
3176 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3178 c if (i.gt.ithet_start .and.
3179 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3180 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3188 c if (i.lt.nres .and. itel(i).ne.0) then
3200 call proc_proc(phii,icrc)
3201 if (icrc.eq.1) phii=150.0
3215 call proc_proc(phii1,icrc)
3216 if (icrc.eq.1) phii1=150.0
3228 C Calculate the "mean" value of theta from the part of the distribution
3229 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3230 C In following comments this theta will be referred to as t_c.
3231 thet_pred_mean=0.0d0
3235 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3237 c write (iout,*) "thet_pred_mean",thet_pred_mean
3238 dthett=thet_pred_mean*ssd
3239 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3240 c write (iout,*) "thet_pred_mean",thet_pred_mean
3241 C Derivatives of the "mean" values in gamma1 and gamma2.
3242 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3243 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3244 if (theta(i).gt.pi-delta) then
3245 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3247 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3248 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3249 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3251 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3253 else if (theta(i).lt.delta) then
3254 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3255 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3256 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3258 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3259 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3262 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3265 etheta=etheta+ethetai
3266 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3267 c & rad2deg*phii,rad2deg*phii1,ethetai
3268 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3269 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3270 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3273 C Ufff.... We've done all this!!!
3276 C---------------------------------------------------------------------------
3277 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3279 implicit real*8 (a-h,o-z)
3280 include 'DIMENSIONS'
3281 include 'COMMON.LOCAL'
3282 include 'COMMON.IOUNITS'
3283 common /calcthet/ term1,term2,termm,diffak,ratak,
3284 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3285 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3286 C Calculate the contributions to both Gaussian lobes.
3287 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3288 C The "polynomial part" of the "standard deviation" of this part of
3292 sig=sig*thet_pred_mean+polthet(j,it)
3294 C Derivative of the "interior part" of the "standard deviation of the"
3295 C gamma-dependent Gaussian lobe in t_c.
3296 sigtc=3*polthet(3,it)
3298 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3301 C Set the parameters of both Gaussian lobes of the distribution.
3302 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3303 fac=sig*sig+sigc0(it)
3306 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3307 sigsqtc=-4.0D0*sigcsq*sigtc
3308 c print *,i,sig,sigtc,sigsqtc
3309 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3310 sigtc=-sigtc/(fac*fac)
3311 C Following variable is sigma(t_c)**(-2)
3312 sigcsq=sigcsq*sigcsq
3314 sig0inv=1.0D0/sig0i**2
3315 delthec=thetai-thet_pred_mean
3316 delthe0=thetai-theta0i
3317 term1=-0.5D0*sigcsq*delthec*delthec
3318 term2=-0.5D0*sig0inv*delthe0*delthe0
3319 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3320 C NaNs in taking the logarithm. We extract the largest exponent which is added
3321 C to the energy (this being the log of the distribution) at the end of energy
3322 C term evaluation for this virtual-bond angle.
3323 if (term1.gt.term2) then
3325 term2=dexp(term2-termm)
3329 term1=dexp(term1-termm)
3332 C The ratio between the gamma-independent and gamma-dependent lobes of
3333 C the distribution is a Gaussian function of thet_pred_mean too.
3334 diffak=gthet(2,it)-thet_pred_mean
3335 ratak=diffak/gthet(3,it)**2
3336 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3337 C Let's differentiate it in thet_pred_mean NOW.
3339 C Now put together the distribution terms to make complete distribution.
3340 termexp=term1+ak*term2
3341 termpre=sigc+ak*sig0i
3342 C Contribution of the bending energy from this theta is just the -log of
3343 C the sum of the contributions from the two lobes and the pre-exponential
3344 C factor. Simple enough, isn't it?
3345 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3346 C NOW the derivatives!!!
3347 C 6/6/97 Take into account the deformation.
3348 E_theta=(delthec*sigcsq*term1
3349 & +ak*delthe0*sig0inv*term2)/termexp
3350 E_tc=((sigtc+aktc*sig0i)/termpre
3351 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3352 & aktc*term2)/termexp)
3355 c-----------------------------------------------------------------------------
3356 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3357 implicit real*8 (a-h,o-z)
3358 include 'DIMENSIONS'
3359 include 'COMMON.LOCAL'
3360 include 'COMMON.IOUNITS'
3361 common /calcthet/ term1,term2,termm,diffak,ratak,
3362 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3363 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3364 delthec=thetai-thet_pred_mean
3365 delthe0=thetai-theta0i
3366 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3367 t3 = thetai-thet_pred_mean
3371 t14 = t12+t6*sigsqtc
3373 t21 = thetai-theta0i
3379 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3380 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3381 & *(-t12*t9-ak*sig0inv*t27)
3385 C--------------------------------------------------------------------------
3386 subroutine ebend(etheta)
3388 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3389 C angles gamma and its derivatives in consecutive thetas and gammas.
3390 C ab initio-derived potentials from
3391 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3393 implicit real*8 (a-h,o-z)
3394 include 'DIMENSIONS'
3395 include 'DIMENSIONS.ZSCOPT'
3396 include 'COMMON.LOCAL'
3397 include 'COMMON.GEO'
3398 include 'COMMON.INTERACT'
3399 include 'COMMON.DERIV'
3400 include 'COMMON.VAR'
3401 include 'COMMON.CHAIN'
3402 include 'COMMON.IOUNITS'
3403 include 'COMMON.NAMES'
3404 include 'COMMON.FFIELD'
3405 include 'COMMON.CONTROL'
3406 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3407 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3408 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3409 & sinph1ph2(maxdouble,maxdouble)
3410 logical lprn /.false./, lprn1 /.false./
3412 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3413 do i=ithet_start,ithet_end
3417 theti2=0.5d0*theta(i)
3418 ityp2=ithetyp(itype(i-1))
3420 coskt(k)=dcos(k*theti2)
3421 sinkt(k)=dsin(k*theti2)
3426 if (phii.ne.phii) phii=150.0
3430 ityp1=ithetyp(itype(i-2))
3432 cosph1(k)=dcos(k*phii)
3433 sinph1(k)=dsin(k*phii)
3446 if (phii1.ne.phii1) phii1=150.0
3451 ityp3=ithetyp(itype(i))
3453 cosph2(k)=dcos(k*phii1)
3454 sinph2(k)=dsin(k*phii1)
3464 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3465 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3467 ethetai=aa0thet(ityp1,ityp2,ityp3)
3470 ccl=cosph1(l)*cosph2(k-l)
3471 ssl=sinph1(l)*sinph2(k-l)
3472 scl=sinph1(l)*cosph2(k-l)
3473 csl=cosph1(l)*sinph2(k-l)
3474 cosph1ph2(l,k)=ccl-ssl
3475 cosph1ph2(k,l)=ccl+ssl
3476 sinph1ph2(l,k)=scl+csl
3477 sinph1ph2(k,l)=scl-csl
3481 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3482 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3483 write (iout,*) "coskt and sinkt"
3485 write (iout,*) k,coskt(k),sinkt(k)
3489 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3490 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3493 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3494 & " ethetai",ethetai
3497 write (iout,*) "cosph and sinph"
3499 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3501 write (iout,*) "cosph1ph2 and sinph2ph2"
3504 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3505 & sinph1ph2(l,k),sinph1ph2(k,l)
3508 write(iout,*) "ethetai",ethetai
3512 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3513 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3514 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3515 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3516 ethetai=ethetai+sinkt(m)*aux
3517 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3518 dephii=dephii+k*sinkt(m)*(
3519 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3520 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3521 dephii1=dephii1+k*sinkt(m)*(
3522 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3523 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3525 & write (iout,*) "m",m," k",k," bbthet",
3526 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3527 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3528 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3529 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3533 & write(iout,*) "ethetai",ethetai
3537 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3538 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3539 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3540 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3541 ethetai=ethetai+sinkt(m)*aux
3542 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3543 dephii=dephii+l*sinkt(m)*(
3544 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3545 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3546 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3547 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3548 dephii1=dephii1+(k-l)*sinkt(m)*(
3549 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3550 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3551 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3552 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3554 write (iout,*) "m",m," k",k," l",l," ffthet",
3555 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3556 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3557 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3558 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3559 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3560 & cosph1ph2(k,l)*sinkt(m),
3561 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3567 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3568 & i,theta(i)*rad2deg,phii*rad2deg,
3569 & phii1*rad2deg,ethetai
3570 etheta=etheta+ethetai
3571 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3572 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3573 gloc(nphi+i-2,icg)=wang*dethetai
3579 c-----------------------------------------------------------------------------
3580 subroutine esc(escloc)
3581 C Calculate the local energy of a side chain and its derivatives in the
3582 C corresponding virtual-bond valence angles THETA and the spherical angles
3584 implicit real*8 (a-h,o-z)
3585 include 'DIMENSIONS'
3586 include 'DIMENSIONS.ZSCOPT'
3587 include 'COMMON.GEO'
3588 include 'COMMON.LOCAL'
3589 include 'COMMON.VAR'
3590 include 'COMMON.INTERACT'
3591 include 'COMMON.DERIV'
3592 include 'COMMON.CHAIN'
3593 include 'COMMON.IOUNITS'
3594 include 'COMMON.NAMES'
3595 include 'COMMON.FFIELD'
3596 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3597 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3598 common /sccalc/ time11,time12,time112,theti,it,nlobit
3601 c write (iout,'(a)') 'ESC'
3602 do i=loc_start,loc_end
3604 if (it.eq.10) goto 1
3606 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3607 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3608 theti=theta(i+1)-pipol
3612 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3614 if (x(2).gt.pi-delta) then
3618 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3620 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3621 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3623 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3624 & ddersc0(1),dersc(1))
3625 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3626 & ddersc0(3),dersc(3))
3628 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3630 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3631 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3632 & dersc0(2),esclocbi,dersc02)
3633 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3635 call splinthet(x(2),0.5d0*delta,ss,ssd)
3640 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3642 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3643 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3645 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3647 c write (iout,*) escloci
3648 else if (x(2).lt.delta) then
3652 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3654 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3655 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3657 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3658 & ddersc0(1),dersc(1))
3659 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3660 & ddersc0(3),dersc(3))
3662 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3664 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3665 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3666 & dersc0(2),esclocbi,dersc02)
3667 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3672 call splinthet(x(2),0.5d0*delta,ss,ssd)
3674 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3676 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3677 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3679 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3680 c write (iout,*) escloci
3682 call enesc(x,escloci,dersc,ddummy,.false.)
3685 escloc=escloc+escloci
3686 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3688 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3690 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3691 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3696 C---------------------------------------------------------------------------
3697 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3698 implicit real*8 (a-h,o-z)
3699 include 'DIMENSIONS'
3700 include 'COMMON.GEO'
3701 include 'COMMON.LOCAL'
3702 include 'COMMON.IOUNITS'
3703 common /sccalc/ time11,time12,time112,theti,it,nlobit
3704 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3705 double precision contr(maxlob,-1:1)
3707 c write (iout,*) 'it=',it,' nlobit=',nlobit
3711 if (mixed) ddersc(j)=0.0d0
3715 C Because of periodicity of the dependence of the SC energy in omega we have
3716 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3717 C To avoid underflows, first compute & store the exponents.
3725 z(k)=x(k)-censc(k,j,it)
3730 Axk=Axk+gaussc(l,k,j,it)*z(l)
3736 expfac=expfac+Ax(k,j,iii)*z(k)
3744 C As in the case of ebend, we want to avoid underflows in exponentiation and
3745 C subsequent NaNs and INFs in energy calculation.
3746 C Find the largest exponent
3750 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3754 cd print *,'it=',it,' emin=',emin
3756 C Compute the contribution to SC energy and derivatives
3760 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3761 cd print *,'j=',j,' expfac=',expfac
3762 escloc_i=escloc_i+expfac
3764 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3768 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3769 & +gaussc(k,2,j,it))*expfac
3776 dersc(1)=dersc(1)/cos(theti)**2
3777 ddersc(1)=ddersc(1)/cos(theti)**2
3780 escloci=-(dlog(escloc_i)-emin)
3782 dersc(j)=dersc(j)/escloc_i
3786 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3791 C------------------------------------------------------------------------------
3792 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3793 implicit real*8 (a-h,o-z)
3794 include 'DIMENSIONS'
3795 include 'COMMON.GEO'
3796 include 'COMMON.LOCAL'
3797 include 'COMMON.IOUNITS'
3798 common /sccalc/ time11,time12,time112,theti,it,nlobit
3799 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3800 double precision contr(maxlob)
3811 z(k)=x(k)-censc(k,j,it)
3817 Axk=Axk+gaussc(l,k,j,it)*z(l)
3823 expfac=expfac+Ax(k,j)*z(k)
3828 C As in the case of ebend, we want to avoid underflows in exponentiation and
3829 C subsequent NaNs and INFs in energy calculation.
3830 C Find the largest exponent
3833 if (emin.gt.contr(j)) emin=contr(j)
3837 C Compute the contribution to SC energy and derivatives
3841 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3842 escloc_i=escloc_i+expfac
3844 dersc(k)=dersc(k)+Ax(k,j)*expfac
3846 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3847 & +gaussc(1,2,j,it))*expfac
3851 dersc(1)=dersc(1)/cos(theti)**2
3852 dersc12=dersc12/cos(theti)**2
3853 escloci=-(dlog(escloc_i)-emin)
3855 dersc(j)=dersc(j)/escloc_i
3857 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3861 c----------------------------------------------------------------------------------
3862 subroutine esc(escloc)
3863 C Calculate the local energy of a side chain and its derivatives in the
3864 C corresponding virtual-bond valence angles THETA and the spherical angles
3865 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3866 C added by Urszula Kozlowska. 07/11/2007
3868 implicit real*8 (a-h,o-z)
3869 include 'DIMENSIONS'
3870 include 'DIMENSIONS.ZSCOPT'
3871 include 'COMMON.GEO'
3872 include 'COMMON.LOCAL'
3873 include 'COMMON.VAR'
3874 include 'COMMON.SCROT'
3875 include 'COMMON.INTERACT'
3876 include 'COMMON.DERIV'
3877 include 'COMMON.CHAIN'
3878 include 'COMMON.IOUNITS'
3879 include 'COMMON.NAMES'
3880 include 'COMMON.FFIELD'
3881 include 'COMMON.CONTROL'
3882 include 'COMMON.VECTORS'
3883 double precision x_prime(3),y_prime(3),z_prime(3)
3884 & , sumene,dsc_i,dp2_i,x(65),
3885 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3886 & de_dxx,de_dyy,de_dzz,de_dt
3887 double precision s1_t,s1_6_t,s2_t,s2_6_t
3889 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3890 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3891 & dt_dCi(3),dt_dCi1(3)
3892 common /sccalc/ time11,time12,time112,theti,it,nlobit
3895 do i=loc_start,loc_end
3896 costtab(i+1) =dcos(theta(i+1))
3897 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3898 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3899 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3900 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3901 cosfac=dsqrt(cosfac2)
3902 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3903 sinfac=dsqrt(sinfac2)
3905 if (it.eq.10) goto 1
3907 C Compute the axes of tghe local cartesian coordinates system; store in
3908 c x_prime, y_prime and z_prime
3915 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3916 C & dc_norm(3,i+nres)
3918 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3919 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3922 z_prime(j) = -uz(j,i-1)
3925 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3926 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3927 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3928 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3929 c & " xy",scalar(x_prime(1),y_prime(1)),
3930 c & " xz",scalar(x_prime(1),z_prime(1)),
3931 c & " yy",scalar(y_prime(1),y_prime(1)),
3932 c & " yz",scalar(y_prime(1),z_prime(1)),
3933 c & " zz",scalar(z_prime(1),z_prime(1))
3935 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3936 C to local coordinate system. Store in xx, yy, zz.
3942 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3943 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3944 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3951 C Compute the energy of the ith side cbain
3953 c write (2,*) "xx",xx," yy",yy," zz",zz
3956 x(j) = sc_parmin(j,it)
3959 Cc diagnostics - remove later
3961 yy1 = dsin(alph(2))*dcos(omeg(2))
3962 zz1 = -dsin(alph(2))*dsin(omeg(2))
3963 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3964 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3966 C," --- ", xx_w,yy_w,zz_w
3969 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3970 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3972 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3973 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3975 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3976 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3977 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3978 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3979 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3981 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3982 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3983 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3984 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3985 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3987 dsc_i = 0.743d0+x(61)
3989 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3990 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3991 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3992 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3993 s1=(1+x(63))/(0.1d0 + dscp1)
3994 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3995 s2=(1+x(65))/(0.1d0 + dscp2)
3996 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3997 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3998 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3999 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4001 c & dscp1,dscp2,sumene
4002 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4003 escloc = escloc + sumene
4004 c write (2,*) "escloc",escloc
4005 if (.not. calc_grad) goto 1
4008 C This section to check the numerical derivatives of the energy of ith side
4009 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4010 C #define DEBUG in the code to turn it on.
4012 write (2,*) "sumene =",sumene
4016 write (2,*) xx,yy,zz
4017 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4018 de_dxx_num=(sumenep-sumene)/aincr
4020 write (2,*) "xx+ sumene from enesc=",sumenep
4023 write (2,*) xx,yy,zz
4024 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4025 de_dyy_num=(sumenep-sumene)/aincr
4027 write (2,*) "yy+ sumene from enesc=",sumenep
4030 write (2,*) xx,yy,zz
4031 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4032 de_dzz_num=(sumenep-sumene)/aincr
4034 write (2,*) "zz+ sumene from enesc=",sumenep
4035 costsave=cost2tab(i+1)
4036 sintsave=sint2tab(i+1)
4037 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4038 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4039 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4040 de_dt_num=(sumenep-sumene)/aincr
4041 write (2,*) " t+ sumene from enesc=",sumenep
4042 cost2tab(i+1)=costsave
4043 sint2tab(i+1)=sintsave
4044 C End of diagnostics section.
4047 C Compute the gradient of esc
4049 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4050 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4051 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4052 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4053 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4054 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4055 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4056 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4057 pom1=(sumene3*sint2tab(i+1)+sumene1)
4058 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4059 pom2=(sumene4*cost2tab(i+1)+sumene2)
4060 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4061 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4062 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4063 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4065 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4066 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4067 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4069 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4070 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4071 & +(pom1+pom2)*pom_dx
4073 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4076 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4077 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4078 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4080 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4081 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4082 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4083 & +x(59)*zz**2 +x(60)*xx*zz
4084 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4085 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4086 & +(pom1-pom2)*pom_dy
4088 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4091 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4092 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4093 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4094 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4095 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4096 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4097 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4098 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4100 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4103 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4104 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4105 & +pom1*pom_dt1+pom2*pom_dt2
4107 write(2,*), "de_dt = ", de_dt,de_dt_num
4111 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4112 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4113 cosfac2xx=cosfac2*xx
4114 sinfac2yy=sinfac2*yy
4116 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4118 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4120 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4121 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4122 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4123 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4124 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4125 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4126 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4127 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4128 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4129 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4133 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4134 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4137 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4138 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4139 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4141 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4142 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4146 dXX_Ctab(k,i)=dXX_Ci(k)
4147 dXX_C1tab(k,i)=dXX_Ci1(k)
4148 dYY_Ctab(k,i)=dYY_Ci(k)
4149 dYY_C1tab(k,i)=dYY_Ci1(k)
4150 dZZ_Ctab(k,i)=dZZ_Ci(k)
4151 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4152 dXX_XYZtab(k,i)=dXX_XYZ(k)
4153 dYY_XYZtab(k,i)=dYY_XYZ(k)
4154 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4158 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4159 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4160 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4161 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4162 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4164 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4165 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4166 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4167 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4168 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4169 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4170 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4171 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4173 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4174 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4176 C to check gradient call subroutine check_grad
4183 c------------------------------------------------------------------------------
4184 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4186 C This procedure calculates two-body contact function g(rij) and its derivative:
4189 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4192 C where x=(rij-r0ij)/delta
4194 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4197 double precision rij,r0ij,eps0ij,fcont,fprimcont
4198 double precision x,x2,x4,delta
4202 if (x.lt.-1.0D0) then
4205 else if (x.le.1.0D0) then
4208 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4209 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4216 c------------------------------------------------------------------------------
4217 subroutine splinthet(theti,delta,ss,ssder)
4218 implicit real*8 (a-h,o-z)
4219 include 'DIMENSIONS'
4220 include 'DIMENSIONS.ZSCOPT'
4221 include 'COMMON.VAR'
4222 include 'COMMON.GEO'
4225 if (theti.gt.pipol) then
4226 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4228 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4233 c------------------------------------------------------------------------------
4234 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4236 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4237 double precision ksi,ksi2,ksi3,a1,a2,a3
4238 a1=fprim0*delta/(f1-f0)
4244 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4245 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4248 c------------------------------------------------------------------------------
4249 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4251 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4252 double precision ksi,ksi2,ksi3,a1,a2,a3
4257 a2=3*(f1x-f0x)-2*fprim0x*delta
4258 a3=fprim0x*delta-2*(f1x-f0x)
4259 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4262 C-----------------------------------------------------------------------------
4264 C-----------------------------------------------------------------------------
4265 subroutine etor(etors,edihcnstr,fact)
4266 implicit real*8 (a-h,o-z)
4267 include 'DIMENSIONS'
4268 include 'DIMENSIONS.ZSCOPT'
4269 include 'COMMON.VAR'
4270 include 'COMMON.GEO'
4271 include 'COMMON.LOCAL'
4272 include 'COMMON.TORSION'
4273 include 'COMMON.INTERACT'
4274 include 'COMMON.DERIV'
4275 include 'COMMON.CHAIN'
4276 include 'COMMON.NAMES'
4277 include 'COMMON.IOUNITS'
4278 include 'COMMON.FFIELD'
4279 include 'COMMON.TORCNSTR'
4281 C Set lprn=.true. for debugging
4285 do i=iphi_start,iphi_end
4286 itori=itortyp(itype(i-2))
4287 itori1=itortyp(itype(i-1))
4290 C Proline-Proline pair is a special case...
4291 if (itori.eq.3 .and. itori1.eq.3) then
4292 if (phii.gt.-dwapi3) then
4294 fac=1.0D0/(1.0D0-cosphi)
4295 etorsi=v1(1,3,3)*fac
4296 etorsi=etorsi+etorsi
4297 etors=etors+etorsi-v1(1,3,3)
4298 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4301 v1ij=v1(j+1,itori,itori1)
4302 v2ij=v2(j+1,itori,itori1)
4305 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4306 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4310 v1ij=v1(j,itori,itori1)
4311 v2ij=v2(j,itori,itori1)
4314 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4315 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4319 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4320 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4321 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4322 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4323 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4325 ! 6/20/98 - dihedral angle constraints
4328 itori=idih_constr(i)
4331 if (difi.gt.drange(i)) then
4333 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4334 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4335 else if (difi.lt.-drange(i)) then
4337 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4338 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4340 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4341 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4343 ! write (iout,*) 'edihcnstr',edihcnstr
4346 c------------------------------------------------------------------------------
4348 subroutine etor(etors,edihcnstr,fact)
4349 implicit real*8 (a-h,o-z)
4350 include 'DIMENSIONS'
4351 include 'DIMENSIONS.ZSCOPT'
4352 include 'COMMON.VAR'
4353 include 'COMMON.GEO'
4354 include 'COMMON.LOCAL'
4355 include 'COMMON.TORSION'
4356 include 'COMMON.INTERACT'
4357 include 'COMMON.DERIV'
4358 include 'COMMON.CHAIN'
4359 include 'COMMON.NAMES'
4360 include 'COMMON.IOUNITS'
4361 include 'COMMON.FFIELD'
4362 include 'COMMON.TORCNSTR'
4364 C Set lprn=.true. for debugging
4368 do i=iphi_start,iphi_end
4369 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4370 itori=itortyp(itype(i-2))
4371 itori1=itortyp(itype(i-1))
4374 C Regular cosine and sine terms
4375 do j=1,nterm(itori,itori1)
4376 v1ij=v1(j,itori,itori1)
4377 v2ij=v2(j,itori,itori1)
4380 etors=etors+v1ij*cosphi+v2ij*sinphi
4381 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4385 C E = SUM ----------------------------------- - v1
4386 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4388 cosphi=dcos(0.5d0*phii)
4389 sinphi=dsin(0.5d0*phii)
4390 do j=1,nlor(itori,itori1)
4391 vl1ij=vlor1(j,itori,itori1)
4392 vl2ij=vlor2(j,itori,itori1)
4393 vl3ij=vlor3(j,itori,itori1)
4394 pom=vl2ij*cosphi+vl3ij*sinphi
4395 pom1=1.0d0/(pom*pom+1.0d0)
4396 etors=etors+vl1ij*pom1
4398 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4400 C Subtract the constant term
4401 etors=etors-v0(itori,itori1)
4403 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4404 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4405 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4406 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4407 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4410 ! 6/20/98 - dihedral angle constraints
4413 itori=idih_constr(i)
4415 difi=pinorm(phii-phi0(i))
4417 if (difi.gt.drange(i)) then
4419 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4420 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4421 edihi=0.25d0*ftors*difi**4
4422 else if (difi.lt.-drange(i)) then
4424 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4425 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4426 edihi=0.25d0*ftors*difi**4
4430 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4432 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4433 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4435 ! write (iout,*) 'edihcnstr',edihcnstr
4438 c----------------------------------------------------------------------------
4439 subroutine etor_d(etors_d,fact2)
4440 C 6/23/01 Compute double torsional energy
4441 implicit real*8 (a-h,o-z)
4442 include 'DIMENSIONS'
4443 include 'DIMENSIONS.ZSCOPT'
4444 include 'COMMON.VAR'
4445 include 'COMMON.GEO'
4446 include 'COMMON.LOCAL'
4447 include 'COMMON.TORSION'
4448 include 'COMMON.INTERACT'
4449 include 'COMMON.DERIV'
4450 include 'COMMON.CHAIN'
4451 include 'COMMON.NAMES'
4452 include 'COMMON.IOUNITS'
4453 include 'COMMON.FFIELD'
4454 include 'COMMON.TORCNSTR'
4456 C Set lprn=.true. for debugging
4460 do i=iphi_start,iphi_end-1
4461 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4463 itori=itortyp(itype(i-2))
4464 itori1=itortyp(itype(i-1))
4465 itori2=itortyp(itype(i))
4467 c if (iabs(itype(i+1)).eq.20) iblock=2
4472 C Regular cosine and sine terms
4473 c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
4474 c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4475 c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4476 c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4477 c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4478 do j=1,ntermd_1(itori,itori1,itori2)
4479 v1cij=v1c(1,j,itori,itori1,itori2)
4480 v1sij=v1s(1,j,itori,itori1,itori2)
4481 v2cij=v1c(2,j,itori,itori1,itori2)
4482 v2sij=v1s(2,j,itori,itori1,itori2)
4484 cosphi1=dcos(j*phii)
4485 sinphi1=dsin(j*phii)
4486 cosphi2=dcos(j*phii1)
4487 sinphi2=dsin(j*phii1)
4488 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4489 & v2cij*cosphi2+v2sij*sinphi2
4490 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4491 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4493 do k=2,ntermd_2(itori,itori1,itori2)
4494 c do k=2,ntermd_2(itori,itori1,itori2,iblock)
4496 c v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4497 c v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4498 c v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4499 c v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4500 v1cdij = v2c(k,l,itori,itori1,itori2)
4501 v2cdij = v2c(l,k,itori,itori1,itori2)
4502 v1sdij = v2s(k,l,itori,itori1,itori2)
4503 v2sdij = v2s(l,k,itori,itori1,itori2)
4504 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4505 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4506 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4507 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4508 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4509 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4510 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4511 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4512 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4513 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4516 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4517 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4523 c------------------------------------------------------------------------------
4524 subroutine eback_sc_corr(esccor)
4525 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4526 c conformational states; temporarily implemented as differences
4527 c between UNRES torsional potentials (dependent on three types of
4528 c residues) and the torsional potentials dependent on all 20 types
4529 c of residues computed from AM1 energy surfaces of terminally-blocked
4530 c amino-acid residues.
4531 implicit real*8 (a-h,o-z)
4532 include 'DIMENSIONS'
4533 include 'DIMENSIONS.ZSCOPT'
4534 include 'COMMON.VAR'
4535 include 'COMMON.GEO'
4536 include 'COMMON.LOCAL'
4537 include 'COMMON.TORSION'
4538 include 'COMMON.SCCOR'
4539 include 'COMMON.INTERACT'
4540 include 'COMMON.DERIV'
4541 include 'COMMON.CHAIN'
4542 include 'COMMON.NAMES'
4543 include 'COMMON.IOUNITS'
4544 include 'COMMON.FFIELD'
4545 include 'COMMON.CONTROL'
4547 C Set lprn=.true. for debugging
4550 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4552 do i=itau_start,itau_end
4554 isccori=isccortyp(itype(i-2))
4555 isccori1=isccortyp(itype(i-1))
4557 cccc Added 9 May 2012
4558 cc Tauangle is torsional engle depending on the value of first digit
4559 c(see comment below)
4560 cc Omicron is flat angle depending on the value of first digit
4561 c(see comment below)
4564 do intertyp=1,3 !intertyp
4565 cc Added 09 May 2012 (Adasko)
4566 cc Intertyp means interaction type of backbone mainchain correlation:
4567 c 1 = SC...Ca...Ca...Ca
4568 c 2 = Ca...Ca...Ca...SC
4569 c 3 = SC...Ca...Ca...SCi
4571 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4572 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4573 & (itype(i-1).eq.21)))
4574 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4575 & .or.(itype(i-2).eq.21)))
4576 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4577 & (itype(i-1).eq.21)))) cycle
4578 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4579 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4581 do j=1,nterm_sccor(isccori,isccori1)
4582 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4583 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4584 cosphi=dcos(j*tauangle(intertyp,i))
4585 sinphi=dsin(j*tauangle(intertyp,i))
4586 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4587 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4589 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4590 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4591 c &gloc_sc(intertyp,i-3,icg)
4593 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4594 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4595 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4596 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4597 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4601 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4605 c------------------------------------------------------------------------------
4606 subroutine multibody(ecorr)
4607 C This subroutine calculates multi-body contributions to energy following
4608 C the idea of Skolnick et al. If side chains I and J make a contact and
4609 C at the same time side chains I+1 and J+1 make a contact, an extra
4610 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4611 implicit real*8 (a-h,o-z)
4612 include 'DIMENSIONS'
4613 include 'COMMON.IOUNITS'
4614 include 'COMMON.DERIV'
4615 include 'COMMON.INTERACT'
4616 include 'COMMON.CONTACTS'
4617 double precision gx(3),gx1(3)
4620 C Set lprn=.true. for debugging
4624 write (iout,'(a)') 'Contact function values:'
4626 write (iout,'(i2,20(1x,i2,f10.5))')
4627 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4642 num_conti=num_cont(i)
4643 num_conti1=num_cont(i1)
4648 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4649 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4650 cd & ' ishift=',ishift
4651 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4652 C The system gains extra energy.
4653 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4654 endif ! j1==j+-ishift
4663 c------------------------------------------------------------------------------
4664 double precision function esccorr(i,j,k,l,jj,kk)
4665 implicit real*8 (a-h,o-z)
4666 include 'DIMENSIONS'
4667 include 'COMMON.IOUNITS'
4668 include 'COMMON.DERIV'
4669 include 'COMMON.INTERACT'
4670 include 'COMMON.CONTACTS'
4671 double precision gx(3),gx1(3)
4676 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4677 C Calculate the multi-body contribution to energy.
4678 C Calculate multi-body contributions to the gradient.
4679 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4680 cd & k,l,(gacont(m,kk,k),m=1,3)
4682 gx(m) =ekl*gacont(m,jj,i)
4683 gx1(m)=eij*gacont(m,kk,k)
4684 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4685 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4686 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4687 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4691 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4696 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4702 c------------------------------------------------------------------------------
4704 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4705 implicit real*8 (a-h,o-z)
4706 include 'DIMENSIONS'
4707 integer dimen1,dimen2,atom,indx
4708 double precision buffer(dimen1,dimen2)
4709 double precision zapas
4710 common /contacts_hb/ zapas(3,20,maxres,7),
4711 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4712 & num_cont_hb(maxres),jcont_hb(20,maxres)
4713 num_kont=num_cont_hb(atom)
4717 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4720 buffer(i,indx+22)=facont_hb(i,atom)
4721 buffer(i,indx+23)=ees0p(i,atom)
4722 buffer(i,indx+24)=ees0m(i,atom)
4723 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4725 buffer(1,indx+26)=dfloat(num_kont)
4728 c------------------------------------------------------------------------------
4729 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4730 implicit real*8 (a-h,o-z)
4731 include 'DIMENSIONS'
4732 integer dimen1,dimen2,atom,indx
4733 double precision buffer(dimen1,dimen2)
4734 double precision zapas
4735 common /contacts_hb/ zapas(3,20,maxres,7),
4736 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4737 & num_cont_hb(maxres),jcont_hb(20,maxres)
4738 num_kont=buffer(1,indx+26)
4739 num_kont_old=num_cont_hb(atom)
4740 num_cont_hb(atom)=num_kont+num_kont_old
4745 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4748 facont_hb(ii,atom)=buffer(i,indx+22)
4749 ees0p(ii,atom)=buffer(i,indx+23)
4750 ees0m(ii,atom)=buffer(i,indx+24)
4751 jcont_hb(ii,atom)=buffer(i,indx+25)
4755 c------------------------------------------------------------------------------
4757 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4758 C This subroutine calculates multi-body contributions to hydrogen-bonding
4759 implicit real*8 (a-h,o-z)
4760 include 'DIMENSIONS'
4761 include 'DIMENSIONS.ZSCOPT'
4762 include 'COMMON.IOUNITS'
4764 include 'COMMON.INFO'
4766 include 'COMMON.FFIELD'
4767 include 'COMMON.DERIV'
4768 include 'COMMON.INTERACT'
4769 include 'COMMON.CONTACTS'
4771 parameter (max_cont=maxconts)
4772 parameter (max_dim=2*(8*3+2))
4773 parameter (msglen1=max_cont*max_dim*4)
4774 parameter (msglen2=2*msglen1)
4775 integer source,CorrelType,CorrelID,Error
4776 double precision buffer(max_cont,max_dim)
4778 double precision gx(3),gx1(3)
4781 C Set lprn=.true. for debugging
4786 if (fgProcs.le.1) goto 30
4788 write (iout,'(a)') 'Contact function values:'
4790 write (iout,'(2i3,50(1x,i2,f5.2))')
4791 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4792 & j=1,num_cont_hb(i))
4795 C Caution! Following code assumes that electrostatic interactions concerning
4796 C a given atom are split among at most two processors!
4806 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4809 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4810 if (MyRank.gt.0) then
4811 C Send correlation contributions to the preceding processor
4813 nn=num_cont_hb(iatel_s)
4814 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4815 cd write (iout,*) 'The BUFFER array:'
4817 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4819 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4821 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4822 C Clear the contacts of the atom passed to the neighboring processor
4823 nn=num_cont_hb(iatel_s+1)
4825 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4827 num_cont_hb(iatel_s)=0
4829 cd write (iout,*) 'Processor ',MyID,MyRank,
4830 cd & ' is sending correlation contribution to processor',MyID-1,
4831 cd & ' msglen=',msglen
4832 cd write (*,*) 'Processor ',MyID,MyRank,
4833 cd & ' is sending correlation contribution to processor',MyID-1,
4834 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4835 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4836 cd write (iout,*) 'Processor ',MyID,
4837 cd & ' has sent correlation contribution to processor',MyID-1,
4838 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4839 cd write (*,*) 'Processor ',MyID,
4840 cd & ' has sent correlation contribution to processor',MyID-1,
4841 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4843 endif ! (MyRank.gt.0)
4847 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4848 if (MyRank.lt.fgProcs-1) then
4849 C Receive correlation contributions from the next processor
4851 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4852 cd write (iout,*) 'Processor',MyID,
4853 cd & ' is receiving correlation contribution from processor',MyID+1,
4854 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4855 cd write (*,*) 'Processor',MyID,
4856 cd & ' is receiving correlation contribution from processor',MyID+1,
4857 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4859 do while (nbytes.le.0)
4860 call mp_probe(MyID+1,CorrelType,nbytes)
4862 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4863 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4864 cd write (iout,*) 'Processor',MyID,
4865 cd & ' has received correlation contribution from processor',MyID+1,
4866 cd & ' msglen=',msglen,' nbytes=',nbytes
4867 cd write (iout,*) 'The received BUFFER array:'
4869 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4871 if (msglen.eq.msglen1) then
4872 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4873 else if (msglen.eq.msglen2) then
4874 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4875 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4878 & 'ERROR!!!! message length changed while processing correlations.'
4880 & 'ERROR!!!! message length changed while processing correlations.'
4881 call mp_stopall(Error)
4882 endif ! msglen.eq.msglen1
4883 endif ! MyRank.lt.fgProcs-1
4890 write (iout,'(a)') 'Contact function values:'
4892 write (iout,'(2i3,50(1x,i2,f5.2))')
4893 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4894 & j=1,num_cont_hb(i))
4898 C Remove the loop below after debugging !!!
4905 C Calculate the local-electrostatic correlation terms
4906 do i=iatel_s,iatel_e+1
4908 num_conti=num_cont_hb(i)
4909 num_conti1=num_cont_hb(i+1)
4914 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4915 c & ' jj=',jj,' kk=',kk
4916 if (j1.eq.j+1 .or. j1.eq.j-1) then
4917 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4918 C The system gains extra energy.
4919 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4921 else if (j1.eq.j) then
4922 C Contacts I-J and I-(J+1) occur simultaneously.
4923 C The system loses extra energy.
4924 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4929 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4930 c & ' jj=',jj,' kk=',kk
4932 C Contacts I-J and (I+1)-J occur simultaneously.
4933 C The system loses extra energy.
4934 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4941 c------------------------------------------------------------------------------
4942 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4944 C This subroutine calculates multi-body contributions to hydrogen-bonding
4945 implicit real*8 (a-h,o-z)
4946 include 'DIMENSIONS'
4947 include 'DIMENSIONS.ZSCOPT'
4948 include 'COMMON.IOUNITS'
4950 include 'COMMON.INFO'
4952 include 'COMMON.FFIELD'
4953 include 'COMMON.DERIV'
4954 include 'COMMON.INTERACT'
4955 include 'COMMON.CONTACTS'
4957 parameter (max_cont=maxconts)
4958 parameter (max_dim=2*(8*3+2))
4959 parameter (msglen1=max_cont*max_dim*4)
4960 parameter (msglen2=2*msglen1)
4961 integer source,CorrelType,CorrelID,Error
4962 double precision buffer(max_cont,max_dim)
4964 double precision gx(3),gx1(3)
4967 C Set lprn=.true. for debugging
4973 if (fgProcs.le.1) goto 30
4975 write (iout,'(a)') 'Contact function values:'
4977 write (iout,'(2i3,50(1x,i2,f5.2))')
4978 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4979 & j=1,num_cont_hb(i))
4982 C Caution! Following code assumes that electrostatic interactions concerning
4983 C a given atom are split among at most two processors!
4993 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4996 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4997 if (MyRank.gt.0) then
4998 C Send correlation contributions to the preceding processor
5000 nn=num_cont_hb(iatel_s)
5001 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5002 cd write (iout,*) 'The BUFFER array:'
5004 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5006 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5008 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5009 C Clear the contacts of the atom passed to the neighboring processor
5010 nn=num_cont_hb(iatel_s+1)
5012 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5014 num_cont_hb(iatel_s)=0
5016 cd write (iout,*) 'Processor ',MyID,MyRank,
5017 cd & ' is sending correlation contribution to processor',MyID-1,
5018 cd & ' msglen=',msglen
5019 cd write (*,*) 'Processor ',MyID,MyRank,
5020 cd & ' is sending correlation contribution to processor',MyID-1,
5021 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5022 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5023 cd write (iout,*) 'Processor ',MyID,
5024 cd & ' has sent correlation contribution to processor',MyID-1,
5025 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5026 cd write (*,*) 'Processor ',MyID,
5027 cd & ' has sent correlation contribution to processor',MyID-1,
5028 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5030 endif ! (MyRank.gt.0)
5034 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5035 if (MyRank.lt.fgProcs-1) then
5036 C Receive correlation contributions from the next processor
5038 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5039 cd write (iout,*) 'Processor',MyID,
5040 cd & ' is receiving correlation contribution from processor',MyID+1,
5041 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5042 cd write (*,*) 'Processor',MyID,
5043 cd & ' is receiving correlation contribution from processor',MyID+1,
5044 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5046 do while (nbytes.le.0)
5047 call mp_probe(MyID+1,CorrelType,nbytes)
5049 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5050 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5051 cd write (iout,*) 'Processor',MyID,
5052 cd & ' has received correlation contribution from processor',MyID+1,
5053 cd & ' msglen=',msglen,' nbytes=',nbytes
5054 cd write (iout,*) 'The received BUFFER array:'
5056 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5058 if (msglen.eq.msglen1) then
5059 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5060 else if (msglen.eq.msglen2) then
5061 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5062 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5065 & 'ERROR!!!! message length changed while processing correlations.'
5067 & 'ERROR!!!! message length changed while processing correlations.'
5068 call mp_stopall(Error)
5069 endif ! msglen.eq.msglen1
5070 endif ! MyRank.lt.fgProcs-1
5077 write (iout,'(a)') 'Contact function values:'
5079 write (iout,'(2i3,50(1x,i2,f5.2))')
5080 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5081 & j=1,num_cont_hb(i))
5087 C Remove the loop below after debugging !!!
5094 C Calculate the dipole-dipole interaction energies
5095 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5096 do i=iatel_s,iatel_e+1
5097 num_conti=num_cont_hb(i)
5104 C Calculate the local-electrostatic correlation terms
5105 do i=iatel_s,iatel_e+1
5107 num_conti=num_cont_hb(i)
5108 num_conti1=num_cont_hb(i+1)
5113 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5114 c & ' jj=',jj,' kk=',kk
5115 if (j1.eq.j+1 .or. j1.eq.j-1) then
5116 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5117 C The system gains extra energy.
5119 sqd1=dsqrt(d_cont(jj,i))
5120 sqd2=dsqrt(d_cont(kk,i1))
5121 sred_geom = sqd1*sqd2
5122 IF (sred_geom.lt.cutoff_corr) THEN
5123 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5125 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5126 c & ' jj=',jj,' kk=',kk
5127 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5128 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5130 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5131 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5134 cd write (iout,*) 'sred_geom=',sred_geom,
5135 cd & ' ekont=',ekont,' fprim=',fprimcont
5136 call calc_eello(i,j,i+1,j1,jj,kk)
5137 if (wcorr4.gt.0.0d0)
5138 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5139 if (wcorr5.gt.0.0d0)
5140 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5141 c print *,"wcorr5",ecorr5
5142 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5143 cd write(2,*)'ijkl',i,j,i+1,j1
5144 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5145 & .or. wturn6.eq.0.0d0))then
5146 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5147 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5148 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5149 cd & 'ecorr6=',ecorr6
5150 cd write (iout,'(4e15.5)') sred_geom,
5151 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5152 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5153 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5154 else if (wturn6.gt.0.0d0
5155 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5156 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5157 eturn6=eturn6+eello_turn6(i,jj,kk)
5158 cd write (2,*) 'multibody_eello:eturn6',eturn6
5162 else if (j1.eq.j) then
5163 C Contacts I-J and I-(J+1) occur simultaneously.
5164 C The system loses extra energy.
5165 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5170 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5171 c & ' jj=',jj,' kk=',kk
5173 C Contacts I-J and (I+1)-J occur simultaneously.
5174 C The system loses extra energy.
5175 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5182 c------------------------------------------------------------------------------
5183 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5184 implicit real*8 (a-h,o-z)
5185 include 'DIMENSIONS'
5186 include 'COMMON.IOUNITS'
5187 include 'COMMON.DERIV'
5188 include 'COMMON.INTERACT'
5189 include 'COMMON.CONTACTS'
5190 double precision gx(3),gx1(3)
5200 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5201 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5202 C Following 4 lines for diagnostics.
5207 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5209 c write (iout,*)'Contacts have occurred for peptide groups',
5210 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5211 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5212 C Calculate the multi-body contribution to energy.
5213 ecorr=ecorr+ekont*ees
5215 C Calculate multi-body contributions to the gradient.
5217 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5218 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5219 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5220 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5221 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5222 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5223 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5224 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5225 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5226 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5227 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5228 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5229 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5230 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5234 gradcorr(ll,m)=gradcorr(ll,m)+
5235 & ees*ekl*gacont_hbr(ll,jj,i)-
5236 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5237 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5242 gradcorr(ll,m)=gradcorr(ll,m)+
5243 & ees*eij*gacont_hbr(ll,kk,k)-
5244 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5245 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5252 C---------------------------------------------------------------------------
5253 subroutine dipole(i,j,jj)
5254 implicit real*8 (a-h,o-z)
5255 include 'DIMENSIONS'
5256 include 'DIMENSIONS.ZSCOPT'
5257 include 'COMMON.IOUNITS'
5258 include 'COMMON.CHAIN'
5259 include 'COMMON.FFIELD'
5260 include 'COMMON.DERIV'
5261 include 'COMMON.INTERACT'
5262 include 'COMMON.CONTACTS'
5263 include 'COMMON.TORSION'
5264 include 'COMMON.VAR'
5265 include 'COMMON.GEO'
5266 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5268 iti1 = itortyp(itype(i+1))
5269 if (j.lt.nres-1) then
5270 itj1 = itortyp(itype(j+1))
5275 dipi(iii,1)=Ub2(iii,i)
5276 dipderi(iii)=Ub2der(iii,i)
5277 dipi(iii,2)=b1(iii,iti1)
5278 dipj(iii,1)=Ub2(iii,j)
5279 dipderj(iii)=Ub2der(iii,j)
5280 dipj(iii,2)=b1(iii,itj1)
5284 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5287 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5290 if (.not.calc_grad) return
5295 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5299 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5304 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5305 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5307 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5309 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5311 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5315 C---------------------------------------------------------------------------
5316 subroutine calc_eello(i,j,k,l,jj,kk)
5318 C This subroutine computes matrices and vectors needed to calculate
5319 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5321 implicit real*8 (a-h,o-z)
5322 include 'DIMENSIONS'
5323 include 'DIMENSIONS.ZSCOPT'
5324 include 'COMMON.IOUNITS'
5325 include 'COMMON.CHAIN'
5326 include 'COMMON.DERIV'
5327 include 'COMMON.INTERACT'
5328 include 'COMMON.CONTACTS'
5329 include 'COMMON.TORSION'
5330 include 'COMMON.VAR'
5331 include 'COMMON.GEO'
5332 include 'COMMON.FFIELD'
5333 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5334 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5337 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5338 cd & ' jj=',jj,' kk=',kk
5339 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5342 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5343 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5346 call transpose2(aa1(1,1),aa1t(1,1))
5347 call transpose2(aa2(1,1),aa2t(1,1))
5350 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5351 & aa1tder(1,1,lll,kkk))
5352 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5353 & aa2tder(1,1,lll,kkk))
5357 C parallel orientation of the two CA-CA-CA frames.
5359 iti=itortyp(itype(i))
5363 itk1=itortyp(itype(k+1))
5364 itj=itortyp(itype(j))
5365 if (l.lt.nres-1) then
5366 itl1=itortyp(itype(l+1))
5370 C A1 kernel(j+1) A2T
5372 cd write (iout,'(3f10.5,5x,3f10.5)')
5373 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5375 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5376 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5377 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5378 C Following matrices are needed only for 6-th order cumulants
5379 IF (wcorr6.gt.0.0d0) THEN
5380 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5381 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5382 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5383 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5384 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5385 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5386 & ADtEAderx(1,1,1,1,1,1))
5388 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5389 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5390 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5391 & ADtEA1derx(1,1,1,1,1,1))
5393 C End 6-th order cumulants
5396 cd write (2,*) 'In calc_eello6'
5398 cd write (2,*) 'iii=',iii
5400 cd write (2,*) 'kkk=',kkk
5402 cd write (2,'(3(2f10.5),5x)')
5403 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5408 call transpose2(EUgder(1,1,k),auxmat(1,1))
5409 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5410 call transpose2(EUg(1,1,k),auxmat(1,1))
5411 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5412 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5416 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5417 & EAEAderx(1,1,lll,kkk,iii,1))
5421 C A1T kernel(i+1) A2
5422 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5423 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5424 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5425 C Following matrices are needed only for 6-th order cumulants
5426 IF (wcorr6.gt.0.0d0) THEN
5427 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5428 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5429 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5430 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5431 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5432 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5433 & ADtEAderx(1,1,1,1,1,2))
5434 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5435 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5436 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5437 & ADtEA1derx(1,1,1,1,1,2))
5439 C End 6-th order cumulants
5440 call transpose2(EUgder(1,1,l),auxmat(1,1))
5441 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5442 call transpose2(EUg(1,1,l),auxmat(1,1))
5443 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5444 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5448 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5449 & EAEAderx(1,1,lll,kkk,iii,2))
5454 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5455 C They are needed only when the fifth- or the sixth-order cumulants are
5457 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5458 call transpose2(AEA(1,1,1),auxmat(1,1))
5459 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5460 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5461 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5462 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5463 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5464 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5465 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5466 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5467 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5468 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5469 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5470 call transpose2(AEA(1,1,2),auxmat(1,1))
5471 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5472 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5473 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5474 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5475 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5476 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5477 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5478 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5479 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5480 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5481 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5482 C Calculate the Cartesian derivatives of the vectors.
5486 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5487 call matvec2(auxmat(1,1),b1(1,iti),
5488 & AEAb1derx(1,lll,kkk,iii,1,1))
5489 call matvec2(auxmat(1,1),Ub2(1,i),
5490 & AEAb2derx(1,lll,kkk,iii,1,1))
5491 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5492 & AEAb1derx(1,lll,kkk,iii,2,1))
5493 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5494 & AEAb2derx(1,lll,kkk,iii,2,1))
5495 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5496 call matvec2(auxmat(1,1),b1(1,itj),
5497 & AEAb1derx(1,lll,kkk,iii,1,2))
5498 call matvec2(auxmat(1,1),Ub2(1,j),
5499 & AEAb2derx(1,lll,kkk,iii,1,2))
5500 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5501 & AEAb1derx(1,lll,kkk,iii,2,2))
5502 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5503 & AEAb2derx(1,lll,kkk,iii,2,2))
5510 C Antiparallel orientation of the two CA-CA-CA frames.
5512 iti=itortyp(itype(i))
5516 itk1=itortyp(itype(k+1))
5517 itl=itortyp(itype(l))
5518 itj=itortyp(itype(j))
5519 if (j.lt.nres-1) then
5520 itj1=itortyp(itype(j+1))
5524 C A2 kernel(j-1)T A1T
5525 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5526 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5527 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5528 C Following matrices are needed only for 6-th order cumulants
5529 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5530 & j.eq.i+4 .and. l.eq.i+3)) THEN
5531 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5532 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5533 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5534 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5535 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5536 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5537 & ADtEAderx(1,1,1,1,1,1))
5538 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5539 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5540 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5541 & ADtEA1derx(1,1,1,1,1,1))
5543 C End 6-th order cumulants
5544 call transpose2(EUgder(1,1,k),auxmat(1,1))
5545 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5546 call transpose2(EUg(1,1,k),auxmat(1,1))
5547 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5548 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5552 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5553 & EAEAderx(1,1,lll,kkk,iii,1))
5557 C A2T kernel(i+1)T A1
5558 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5559 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5560 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5561 C Following matrices are needed only for 6-th order cumulants
5562 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5563 & j.eq.i+4 .and. l.eq.i+3)) THEN
5564 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5565 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5566 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5567 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5568 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5569 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5570 & ADtEAderx(1,1,1,1,1,2))
5571 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5572 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5573 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5574 & ADtEA1derx(1,1,1,1,1,2))
5576 C End 6-th order cumulants
5577 call transpose2(EUgder(1,1,j),auxmat(1,1))
5578 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5579 call transpose2(EUg(1,1,j),auxmat(1,1))
5580 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5581 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5585 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5586 & EAEAderx(1,1,lll,kkk,iii,2))
5591 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5592 C They are needed only when the fifth- or the sixth-order cumulants are
5594 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5595 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5596 call transpose2(AEA(1,1,1),auxmat(1,1))
5597 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5598 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5599 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5600 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5601 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5602 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5603 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5604 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5605 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5606 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5607 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5608 call transpose2(AEA(1,1,2),auxmat(1,1))
5609 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5610 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5611 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5612 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5613 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5614 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5615 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5616 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5617 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5618 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5619 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5620 C Calculate the Cartesian derivatives of the vectors.
5624 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,iti),
5626 & AEAb1derx(1,lll,kkk,iii,1,1))
5627 call matvec2(auxmat(1,1),Ub2(1,i),
5628 & AEAb2derx(1,lll,kkk,iii,1,1))
5629 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5630 & AEAb1derx(1,lll,kkk,iii,2,1))
5631 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5632 & AEAb2derx(1,lll,kkk,iii,2,1))
5633 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5634 call matvec2(auxmat(1,1),b1(1,itl),
5635 & AEAb1derx(1,lll,kkk,iii,1,2))
5636 call matvec2(auxmat(1,1),Ub2(1,l),
5637 & AEAb2derx(1,lll,kkk,iii,1,2))
5638 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5639 & AEAb1derx(1,lll,kkk,iii,2,2))
5640 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5641 & AEAb2derx(1,lll,kkk,iii,2,2))
5650 C---------------------------------------------------------------------------
5651 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5652 & KK,KKderg,AKA,AKAderg,AKAderx)
5656 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5657 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5658 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5663 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5665 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5668 cd if (lprn) write (2,*) 'In kernel'
5670 cd if (lprn) write (2,*) 'kkk=',kkk
5672 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5673 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5675 cd write (2,*) 'lll=',lll
5676 cd write (2,*) 'iii=1'
5678 cd write (2,'(3(2f10.5),5x)')
5679 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5682 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5683 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5685 cd write (2,*) 'lll=',lll
5686 cd write (2,*) 'iii=2'
5688 cd write (2,'(3(2f10.5),5x)')
5689 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5696 C---------------------------------------------------------------------------
5697 double precision function eello4(i,j,k,l,jj,kk)
5698 implicit real*8 (a-h,o-z)
5699 include 'DIMENSIONS'
5700 include 'DIMENSIONS.ZSCOPT'
5701 include 'COMMON.IOUNITS'
5702 include 'COMMON.CHAIN'
5703 include 'COMMON.DERIV'
5704 include 'COMMON.INTERACT'
5705 include 'COMMON.CONTACTS'
5706 include 'COMMON.TORSION'
5707 include 'COMMON.VAR'
5708 include 'COMMON.GEO'
5709 double precision pizda(2,2),ggg1(3),ggg2(3)
5710 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5714 cd print *,'eello4:',i,j,k,l,jj,kk
5715 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5716 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5717 cold eij=facont_hb(jj,i)
5718 cold ekl=facont_hb(kk,k)
5720 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5722 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5723 gcorr_loc(k-1)=gcorr_loc(k-1)
5724 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5726 gcorr_loc(l-1)=gcorr_loc(l-1)
5727 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5729 gcorr_loc(j-1)=gcorr_loc(j-1)
5730 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5735 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5736 & -EAEAderx(2,2,lll,kkk,iii,1)
5737 cd derx(lll,kkk,iii)=0.0d0
5741 cd gcorr_loc(l-1)=0.0d0
5742 cd gcorr_loc(j-1)=0.0d0
5743 cd gcorr_loc(k-1)=0.0d0
5745 cd write (iout,*)'Contacts have occurred for peptide groups',
5746 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5747 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5748 if (j.lt.nres-1) then
5755 if (l.lt.nres-1) then
5763 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5764 ggg1(ll)=eel4*g_contij(ll,1)
5765 ggg2(ll)=eel4*g_contij(ll,2)
5766 ghalf=0.5d0*ggg1(ll)
5768 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5769 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5770 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5771 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5772 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5773 ghalf=0.5d0*ggg2(ll)
5775 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5776 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5777 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5778 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5783 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5784 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5789 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5790 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5796 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5801 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5805 cd write (2,*) iii,gcorr_loc(iii)
5809 cd write (2,*) 'ekont',ekont
5810 cd write (iout,*) 'eello4',ekont*eel4
5813 C---------------------------------------------------------------------------
5814 double precision function eello5(i,j,k,l,jj,kk)
5815 implicit real*8 (a-h,o-z)
5816 include 'DIMENSIONS'
5817 include 'DIMENSIONS.ZSCOPT'
5818 include 'COMMON.IOUNITS'
5819 include 'COMMON.CHAIN'
5820 include 'COMMON.DERIV'
5821 include 'COMMON.INTERACT'
5822 include 'COMMON.CONTACTS'
5823 include 'COMMON.TORSION'
5824 include 'COMMON.VAR'
5825 include 'COMMON.GEO'
5826 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5827 double precision ggg1(3),ggg2(3)
5828 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5833 C /l\ / \ \ / \ / \ / C
5834 C / \ / \ \ / \ / \ / C
5835 C j| o |l1 | o | o| o | | o |o C
5836 C \ |/k\| |/ \| / |/ \| |/ \| C
5837 C \i/ \ / \ / / \ / \ C
5839 C (I) (II) (III) (IV) C
5841 C eello5_1 eello5_2 eello5_3 eello5_4 C
5843 C Antiparallel chains C
5846 C /j\ / \ \ / \ / \ / C
5847 C / \ / \ \ / \ / \ / C
5848 C j1| o |l | o | o| o | | o |o C
5849 C \ |/k\| |/ \| / |/ \| |/ \| C
5850 C \i/ \ / \ / / \ / \ C
5852 C (I) (II) (III) (IV) C
5854 C eello5_1 eello5_2 eello5_3 eello5_4 C
5856 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5859 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5864 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5866 itk=itortyp(itype(k))
5867 itl=itortyp(itype(l))
5868 itj=itortyp(itype(j))
5873 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5874 cd & eel5_3_num,eel5_4_num)
5878 derx(lll,kkk,iii)=0.0d0
5882 cd eij=facont_hb(jj,i)
5883 cd ekl=facont_hb(kk,k)
5885 cd write (iout,*)'Contacts have occurred for peptide groups',
5886 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5888 C Contribution from the graph I.
5889 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5890 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5891 call transpose2(EUg(1,1,k),auxmat(1,1))
5892 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5893 vv(1)=pizda(1,1)-pizda(2,2)
5894 vv(2)=pizda(1,2)+pizda(2,1)
5895 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5896 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5898 C Explicit gradient in virtual-dihedral angles.
5899 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5900 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5901 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5902 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5903 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5904 vv(1)=pizda(1,1)-pizda(2,2)
5905 vv(2)=pizda(1,2)+pizda(2,1)
5906 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5907 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5908 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5909 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5910 vv(1)=pizda(1,1)-pizda(2,2)
5911 vv(2)=pizda(1,2)+pizda(2,1)
5913 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5914 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5915 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5917 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5918 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5919 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5921 C Cartesian gradient
5925 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5927 vv(1)=pizda(1,1)-pizda(2,2)
5928 vv(2)=pizda(1,2)+pizda(2,1)
5929 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5930 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5931 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5938 C Contribution from graph II
5939 call transpose2(EE(1,1,itk),auxmat(1,1))
5940 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5941 vv(1)=pizda(1,1)+pizda(2,2)
5942 vv(2)=pizda(2,1)-pizda(1,2)
5943 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5944 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5946 C Explicit gradient in virtual-dihedral angles.
5947 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5948 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5949 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5950 vv(1)=pizda(1,1)+pizda(2,2)
5951 vv(2)=pizda(2,1)-pizda(1,2)
5953 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5954 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5955 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5957 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5958 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5959 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5961 C Cartesian gradient
5965 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5967 vv(1)=pizda(1,1)+pizda(2,2)
5968 vv(2)=pizda(2,1)-pizda(1,2)
5969 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5970 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5971 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5980 C Parallel orientation
5981 C Contribution from graph III
5982 call transpose2(EUg(1,1,l),auxmat(1,1))
5983 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5984 vv(1)=pizda(1,1)-pizda(2,2)
5985 vv(2)=pizda(1,2)+pizda(2,1)
5986 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5987 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5989 C Explicit gradient in virtual-dihedral angles.
5990 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5991 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5992 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5993 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5994 vv(1)=pizda(1,1)-pizda(2,2)
5995 vv(2)=pizda(1,2)+pizda(2,1)
5996 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5997 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5998 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5999 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6000 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6001 vv(1)=pizda(1,1)-pizda(2,2)
6002 vv(2)=pizda(1,2)+pizda(2,1)
6003 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6004 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6005 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6006 C Cartesian gradient
6010 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6012 vv(1)=pizda(1,1)-pizda(2,2)
6013 vv(2)=pizda(1,2)+pizda(2,1)
6014 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6015 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6016 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6022 C Contribution from graph IV
6024 call transpose2(EE(1,1,itl),auxmat(1,1))
6025 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6026 vv(1)=pizda(1,1)+pizda(2,2)
6027 vv(2)=pizda(2,1)-pizda(1,2)
6028 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6029 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6031 C Explicit gradient in virtual-dihedral angles.
6032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6033 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6034 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6035 vv(1)=pizda(1,1)+pizda(2,2)
6036 vv(2)=pizda(2,1)-pizda(1,2)
6037 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6038 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6039 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6040 C Cartesian gradient
6044 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6046 vv(1)=pizda(1,1)+pizda(2,2)
6047 vv(2)=pizda(2,1)-pizda(1,2)
6048 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6049 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6050 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6056 C Antiparallel orientation
6057 C Contribution from graph III
6059 call transpose2(EUg(1,1,j),auxmat(1,1))
6060 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6061 vv(1)=pizda(1,1)-pizda(2,2)
6062 vv(2)=pizda(1,2)+pizda(2,1)
6063 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6064 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6066 C Explicit gradient in virtual-dihedral angles.
6067 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6068 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6069 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6070 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6071 vv(1)=pizda(1,1)-pizda(2,2)
6072 vv(2)=pizda(1,2)+pizda(2,1)
6073 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6074 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6075 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6076 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6077 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6078 vv(1)=pizda(1,1)-pizda(2,2)
6079 vv(2)=pizda(1,2)+pizda(2,1)
6080 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6081 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6082 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6083 C Cartesian gradient
6087 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6089 vv(1)=pizda(1,1)-pizda(2,2)
6090 vv(2)=pizda(1,2)+pizda(2,1)
6091 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6092 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6093 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6099 C Contribution from graph IV
6101 call transpose2(EE(1,1,itj),auxmat(1,1))
6102 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6103 vv(1)=pizda(1,1)+pizda(2,2)
6104 vv(2)=pizda(2,1)-pizda(1,2)
6105 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6106 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6108 C Explicit gradient in virtual-dihedral angles.
6109 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6110 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6111 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6112 vv(1)=pizda(1,1)+pizda(2,2)
6113 vv(2)=pizda(2,1)-pizda(1,2)
6114 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6115 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6116 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6117 C Cartesian gradient
6121 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6123 vv(1)=pizda(1,1)+pizda(2,2)
6124 vv(2)=pizda(2,1)-pizda(1,2)
6125 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6126 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6127 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6134 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6135 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6136 cd write (2,*) 'ijkl',i,j,k,l
6137 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6138 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6140 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6141 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6142 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6143 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6145 if (j.lt.nres-1) then
6152 if (l.lt.nres-1) then
6162 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6164 ggg1(ll)=eel5*g_contij(ll,1)
6165 ggg2(ll)=eel5*g_contij(ll,2)
6166 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6167 ghalf=0.5d0*ggg1(ll)
6169 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6170 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6171 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6172 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6173 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6174 ghalf=0.5d0*ggg2(ll)
6176 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6177 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6178 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6179 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6184 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6185 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6190 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6191 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6197 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6202 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6206 cd write (2,*) iii,g_corr5_loc(iii)
6210 cd write (2,*) 'ekont',ekont
6211 cd write (iout,*) 'eello5',ekont*eel5
6214 c--------------------------------------------------------------------------
6215 double precision function eello6(i,j,k,l,jj,kk)
6216 implicit real*8 (a-h,o-z)
6217 include 'DIMENSIONS'
6218 include 'DIMENSIONS.ZSCOPT'
6219 include 'COMMON.IOUNITS'
6220 include 'COMMON.CHAIN'
6221 include 'COMMON.DERIV'
6222 include 'COMMON.INTERACT'
6223 include 'COMMON.CONTACTS'
6224 include 'COMMON.TORSION'
6225 include 'COMMON.VAR'
6226 include 'COMMON.GEO'
6227 include 'COMMON.FFIELD'
6228 double precision ggg1(3),ggg2(3)
6229 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6234 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6242 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6243 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6247 derx(lll,kkk,iii)=0.0d0
6251 cd eij=facont_hb(jj,i)
6252 cd ekl=facont_hb(kk,k)
6258 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6259 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6260 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6261 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6262 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6263 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6265 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6266 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6267 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6268 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6269 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6270 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6274 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6276 C If turn contributions are considered, they will be handled separately.
6277 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6278 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6279 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6280 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6281 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6282 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6283 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6286 if (j.lt.nres-1) then
6293 if (l.lt.nres-1) then
6301 ggg1(ll)=eel6*g_contij(ll,1)
6302 ggg2(ll)=eel6*g_contij(ll,2)
6303 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6304 ghalf=0.5d0*ggg1(ll)
6306 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6307 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6308 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6309 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6310 ghalf=0.5d0*ggg2(ll)
6311 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6313 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6314 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6315 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6316 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6321 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6322 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6327 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6328 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6334 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6339 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6343 cd write (2,*) iii,g_corr6_loc(iii)
6347 cd write (2,*) 'ekont',ekont
6348 cd write (iout,*) 'eello6',ekont*eel6
6351 c--------------------------------------------------------------------------
6352 double precision function eello6_graph1(i,j,k,l,imat,swap)
6353 implicit real*8 (a-h,o-z)
6354 include 'DIMENSIONS'
6355 include 'DIMENSIONS.ZSCOPT'
6356 include 'COMMON.IOUNITS'
6357 include 'COMMON.CHAIN'
6358 include 'COMMON.DERIV'
6359 include 'COMMON.INTERACT'
6360 include 'COMMON.CONTACTS'
6361 include 'COMMON.TORSION'
6362 include 'COMMON.VAR'
6363 include 'COMMON.GEO'
6364 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6368 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6370 C Parallel Antiparallel C
6376 C \ j|/k\| / \ |/k\|l / C
6381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6382 itk=itortyp(itype(k))
6383 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6384 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6385 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6386 call transpose2(EUgC(1,1,k),auxmat(1,1))
6387 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6388 vv1(1)=pizda1(1,1)-pizda1(2,2)
6389 vv1(2)=pizda1(1,2)+pizda1(2,1)
6390 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6391 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6392 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6393 s5=scalar2(vv(1),Dtobr2(1,i))
6394 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6395 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6396 if (.not. calc_grad) return
6397 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6398 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6399 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6400 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6401 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6402 & +scalar2(vv(1),Dtobr2der(1,i)))
6403 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6404 vv1(1)=pizda1(1,1)-pizda1(2,2)
6405 vv1(2)=pizda1(1,2)+pizda1(2,1)
6406 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6407 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6409 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6410 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6411 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6412 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6413 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6415 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6416 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6417 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6418 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6419 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6421 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6422 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6423 vv1(1)=pizda1(1,1)-pizda1(2,2)
6424 vv1(2)=pizda1(1,2)+pizda1(2,1)
6425 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6426 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6427 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6428 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6437 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6438 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6439 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6440 call transpose2(EUgC(1,1,k),auxmat(1,1))
6441 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6443 vv1(1)=pizda1(1,1)-pizda1(2,2)
6444 vv1(2)=pizda1(1,2)+pizda1(2,1)
6445 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6446 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6447 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6448 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6449 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6450 s5=scalar2(vv(1),Dtobr2(1,i))
6451 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6457 c----------------------------------------------------------------------------
6458 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6459 implicit real*8 (a-h,o-z)
6460 include 'DIMENSIONS'
6461 include 'DIMENSIONS.ZSCOPT'
6462 include 'COMMON.IOUNITS'
6463 include 'COMMON.CHAIN'
6464 include 'COMMON.DERIV'
6465 include 'COMMON.INTERACT'
6466 include 'COMMON.CONTACTS'
6467 include 'COMMON.TORSION'
6468 include 'COMMON.VAR'
6469 include 'COMMON.GEO'
6471 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6472 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6475 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6477 C Parallel Antiparallel C
6483 C \ j|/k\| \ |/k\|l C
6488 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6489 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6490 C AL 7/4/01 s1 would occur in the sixth-order moment,
6491 C but not in a cluster cumulant
6493 s1=dip(1,jj,i)*dip(1,kk,k)
6495 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6496 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6497 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6498 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6499 call transpose2(EUg(1,1,k),auxmat(1,1))
6500 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6501 vv(1)=pizda(1,1)-pizda(2,2)
6502 vv(2)=pizda(1,2)+pizda(2,1)
6503 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6504 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6506 eello6_graph2=-(s1+s2+s3+s4)
6508 eello6_graph2=-(s2+s3+s4)
6511 if (.not. calc_grad) return
6512 C Derivatives in gamma(i-1)
6515 s1=dipderg(1,jj,i)*dip(1,kk,k)
6517 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6518 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6519 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6520 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6522 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6524 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6526 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6528 C Derivatives in gamma(k-1)
6530 s1=dip(1,jj,i)*dipderg(1,kk,k)
6532 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6533 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6534 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6535 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6536 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6537 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6538 vv(1)=pizda(1,1)-pizda(2,2)
6539 vv(2)=pizda(1,2)+pizda(2,1)
6540 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6542 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6544 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6546 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6547 C Derivatives in gamma(j-1) or gamma(l-1)
6550 s1=dipderg(3,jj,i)*dip(1,kk,k)
6552 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6553 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6554 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6555 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6556 vv(1)=pizda(1,1)-pizda(2,2)
6557 vv(2)=pizda(1,2)+pizda(2,1)
6558 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6561 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6563 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6566 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6567 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6569 C Derivatives in gamma(l-1) or gamma(j-1)
6572 s1=dip(1,jj,i)*dipderg(3,kk,k)
6574 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6575 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6576 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6577 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6578 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6579 vv(1)=pizda(1,1)-pizda(2,2)
6580 vv(2)=pizda(1,2)+pizda(2,1)
6581 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6584 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6586 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6589 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6590 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6592 C Cartesian derivatives.
6594 write (2,*) 'In eello6_graph2'
6596 write (2,*) 'iii=',iii
6598 write (2,*) 'kkk=',kkk
6600 write (2,'(3(2f10.5),5x)')
6601 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6611 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6613 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6616 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6618 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6619 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6621 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6622 call transpose2(EUg(1,1,k),auxmat(1,1))
6623 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6625 vv(1)=pizda(1,1)-pizda(2,2)
6626 vv(2)=pizda(1,2)+pizda(2,1)
6627 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6628 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6632 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6635 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6637 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6644 c----------------------------------------------------------------------------
6645 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6646 implicit real*8 (a-h,o-z)
6647 include 'DIMENSIONS'
6648 include 'DIMENSIONS.ZSCOPT'
6649 include 'COMMON.IOUNITS'
6650 include 'COMMON.CHAIN'
6651 include 'COMMON.DERIV'
6652 include 'COMMON.INTERACT'
6653 include 'COMMON.CONTACTS'
6654 include 'COMMON.TORSION'
6655 include 'COMMON.VAR'
6656 include 'COMMON.GEO'
6657 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6659 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6661 C Parallel Antiparallel C
6667 C j|/k\| / |/k\|l / C
6672 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6674 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6675 C energy moment and not to the cluster cumulant.
6676 iti=itortyp(itype(i))
6677 if (j.lt.nres-1) then
6678 itj1=itortyp(itype(j+1))
6682 itk=itortyp(itype(k))
6683 itk1=itortyp(itype(k+1))
6684 if (l.lt.nres-1) then
6685 itl1=itortyp(itype(l+1))
6690 s1=dip(4,jj,i)*dip(4,kk,k)
6692 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6693 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6694 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6695 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6696 call transpose2(EE(1,1,itk),auxmat(1,1))
6697 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6698 vv(1)=pizda(1,1)+pizda(2,2)
6699 vv(2)=pizda(2,1)-pizda(1,2)
6700 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6701 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6703 eello6_graph3=-(s1+s2+s3+s4)
6705 eello6_graph3=-(s2+s3+s4)
6708 if (.not. calc_grad) return
6709 C Derivatives in gamma(k-1)
6710 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6711 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6712 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6713 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6714 C Derivatives in gamma(l-1)
6715 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6716 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6717 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6718 vv(1)=pizda(1,1)+pizda(2,2)
6719 vv(2)=pizda(2,1)-pizda(1,2)
6720 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6721 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6722 C Cartesian derivatives.
6728 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6730 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6733 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6735 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6736 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6738 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6739 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6741 vv(1)=pizda(1,1)+pizda(2,2)
6742 vv(2)=pizda(2,1)-pizda(1,2)
6743 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6745 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6747 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6750 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6752 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6754 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6760 c----------------------------------------------------------------------------
6761 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6762 implicit real*8 (a-h,o-z)
6763 include 'DIMENSIONS'
6764 include 'DIMENSIONS.ZSCOPT'
6765 include 'COMMON.IOUNITS'
6766 include 'COMMON.CHAIN'
6767 include 'COMMON.DERIV'
6768 include 'COMMON.INTERACT'
6769 include 'COMMON.CONTACTS'
6770 include 'COMMON.TORSION'
6771 include 'COMMON.VAR'
6772 include 'COMMON.GEO'
6773 include 'COMMON.FFIELD'
6774 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6775 & auxvec1(2),auxmat1(2,2)
6777 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6779 C Parallel Antiparallel C
6785 C \ j|/k\| \ |/k\|l C
6790 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6792 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6793 C energy moment and not to the cluster cumulant.
6794 cd write (2,*) 'eello_graph4: wturn6',wturn6
6795 iti=itortyp(itype(i))
6796 itj=itortyp(itype(j))
6797 if (j.lt.nres-1) then
6798 itj1=itortyp(itype(j+1))
6802 itk=itortyp(itype(k))
6803 if (k.lt.nres-1) then
6804 itk1=itortyp(itype(k+1))
6808 itl=itortyp(itype(l))
6809 if (l.lt.nres-1) then
6810 itl1=itortyp(itype(l+1))
6814 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6815 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6816 cd & ' itl',itl,' itl1',itl1
6819 s1=dip(3,jj,i)*dip(3,kk,k)
6821 s1=dip(2,jj,j)*dip(2,kk,l)
6824 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6825 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6827 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6828 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6830 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6831 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6833 call transpose2(EUg(1,1,k),auxmat(1,1))
6834 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6835 vv(1)=pizda(1,1)-pizda(2,2)
6836 vv(2)=pizda(2,1)+pizda(1,2)
6837 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6838 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6840 eello6_graph4=-(s1+s2+s3+s4)
6842 eello6_graph4=-(s2+s3+s4)
6844 if (.not. calc_grad) return
6845 C Derivatives in gamma(i-1)
6849 s1=dipderg(2,jj,i)*dip(3,kk,k)
6851 s1=dipderg(4,jj,j)*dip(2,kk,l)
6854 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6856 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6857 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6859 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6860 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6862 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6863 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6864 cd write (2,*) 'turn6 derivatives'
6866 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6868 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6872 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6874 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6878 C Derivatives in gamma(k-1)
6881 s1=dip(3,jj,i)*dipderg(2,kk,k)
6883 s1=dip(2,jj,j)*dipderg(4,kk,l)
6886 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6887 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6889 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6890 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6892 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6893 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6895 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6896 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6897 vv(1)=pizda(1,1)-pizda(2,2)
6898 vv(2)=pizda(2,1)+pizda(1,2)
6899 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6900 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6902 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6904 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6908 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6910 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6913 C Derivatives in gamma(j-1) or gamma(l-1)
6914 if (l.eq.j+1 .and. l.gt.1) then
6915 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6916 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6917 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6918 vv(1)=pizda(1,1)-pizda(2,2)
6919 vv(2)=pizda(2,1)+pizda(1,2)
6920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6921 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6922 else if (j.gt.1) then
6923 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6924 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6925 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6926 vv(1)=pizda(1,1)-pizda(2,2)
6927 vv(2)=pizda(2,1)+pizda(1,2)
6928 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6929 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6930 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6932 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6935 C Cartesian derivatives.
6942 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6944 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6948 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6950 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6954 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6956 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6958 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6959 & b1(1,itj1),auxvec(1))
6960 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6962 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6963 & b1(1,itl1),auxvec(1))
6964 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6966 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6968 vv(1)=pizda(1,1)-pizda(2,2)
6969 vv(2)=pizda(2,1)+pizda(1,2)
6970 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6972 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6974 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6977 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6980 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6983 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6985 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6987 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6991 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6993 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6996 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6998 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7006 c----------------------------------------------------------------------------
7007 double precision function eello_turn6(i,jj,kk)
7008 implicit real*8 (a-h,o-z)
7009 include 'DIMENSIONS'
7010 include 'DIMENSIONS.ZSCOPT'
7011 include 'COMMON.IOUNITS'
7012 include 'COMMON.CHAIN'
7013 include 'COMMON.DERIV'
7014 include 'COMMON.INTERACT'
7015 include 'COMMON.CONTACTS'
7016 include 'COMMON.TORSION'
7017 include 'COMMON.VAR'
7018 include 'COMMON.GEO'
7019 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7020 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7022 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7023 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7024 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7025 C the respective energy moment and not to the cluster cumulant.
7030 iti=itortyp(itype(i))
7031 itk=itortyp(itype(k))
7032 itk1=itortyp(itype(k+1))
7033 itl=itortyp(itype(l))
7034 itj=itortyp(itype(j))
7035 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7036 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7037 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7042 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7044 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7048 derx_turn(lll,kkk,iii)=0.0d0
7055 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7057 cd write (2,*) 'eello6_5',eello6_5
7059 call transpose2(AEA(1,1,1),auxmat(1,1))
7060 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7061 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7062 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7066 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7067 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7068 s2 = scalar2(b1(1,itk),vtemp1(1))
7070 call transpose2(AEA(1,1,2),atemp(1,1))
7071 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7072 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7073 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7077 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7078 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7079 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7081 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7082 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7083 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7084 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7085 ss13 = scalar2(b1(1,itk),vtemp4(1))
7086 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7090 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7096 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7098 C Derivatives in gamma(i+2)
7100 call transpose2(AEA(1,1,1),auxmatd(1,1))
7101 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7102 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7103 call transpose2(AEAderg(1,1,2),atempd(1,1))
7104 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7105 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7109 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7110 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7111 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7117 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7118 C Derivatives in gamma(i+3)
7120 call transpose2(AEA(1,1,1),auxmatd(1,1))
7121 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7122 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7123 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7127 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7128 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7129 s2d = scalar2(b1(1,itk),vtemp1d(1))
7131 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7132 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7134 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7136 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7137 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7138 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7148 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7149 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7151 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7152 & -0.5d0*ekont*(s2d+s12d)
7154 C Derivatives in gamma(i+4)
7155 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7156 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7157 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7159 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7160 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7161 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7171 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7173 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7175 C Derivatives in gamma(i+5)
7177 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7178 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7179 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7183 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7184 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7185 s2d = scalar2(b1(1,itk),vtemp1d(1))
7187 call transpose2(AEA(1,1,2),atempd(1,1))
7188 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7189 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7193 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7194 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7196 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7197 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7198 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7208 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7209 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7211 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7212 & -0.5d0*ekont*(s2d+s12d)
7214 C Cartesian derivatives
7219 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7220 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7221 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7225 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7226 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7228 s2d = scalar2(b1(1,itk),vtemp1d(1))
7230 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7231 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7232 s8d = -(atempd(1,1)+atempd(2,2))*
7233 & scalar2(cc(1,1,itl),vtemp2(1))
7237 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7239 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7240 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7247 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7250 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7254 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7255 & - 0.5d0*(s8d+s12d)
7257 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7266 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7268 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7269 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7270 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7271 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7272 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7274 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7275 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7276 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7280 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7281 cd & 16*eel_turn6_num
7283 if (j.lt.nres-1) then
7290 if (l.lt.nres-1) then
7298 ggg1(ll)=eel_turn6*g_contij(ll,1)
7299 ggg2(ll)=eel_turn6*g_contij(ll,2)
7300 ghalf=0.5d0*ggg1(ll)
7302 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7303 & +ekont*derx_turn(ll,2,1)
7304 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7305 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7306 & +ekont*derx_turn(ll,4,1)
7307 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7308 ghalf=0.5d0*ggg2(ll)
7310 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7311 & +ekont*derx_turn(ll,2,2)
7312 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7313 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7314 & +ekont*derx_turn(ll,4,2)
7315 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7320 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7325 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7331 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7336 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7340 cd write (2,*) iii,g_corr6_loc(iii)
7343 eello_turn6=ekont*eel_turn6
7344 cd write (2,*) 'ekont',ekont
7345 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7348 crc-------------------------------------------------
7349 SUBROUTINE MATVEC2(A1,V1,V2)
7350 implicit real*8 (a-h,o-z)
7351 include 'DIMENSIONS'
7352 DIMENSION A1(2,2),V1(2),V2(2)
7356 c 3 VI=VI+A1(I,K)*V1(K)
7360 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7361 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7366 C---------------------------------------
7367 SUBROUTINE MATMAT2(A1,A2,A3)
7368 implicit real*8 (a-h,o-z)
7369 include 'DIMENSIONS'
7370 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7371 c DIMENSION AI3(2,2)
7375 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7381 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7382 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7383 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7384 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7392 c-------------------------------------------------------------------------
7393 double precision function scalar2(u,v)
7395 double precision u(2),v(2)
7398 scalar2=u(1)*v(1)+u(2)*v(2)
7402 C-----------------------------------------------------------------------------
7404 subroutine transpose2(a,at)
7406 double precision a(2,2),at(2,2)
7413 c--------------------------------------------------------------------------
7414 subroutine transpose(n,a,at)
7417 double precision a(n,n),at(n,n)
7425 C---------------------------------------------------------------------------
7426 subroutine prodmat3(a1,a2,kk,transp,prod)
7429 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7431 crc double precision auxmat(2,2),prod_(2,2)
7434 crc call transpose2(kk(1,1),auxmat(1,1))
7435 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7436 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7438 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7439 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7440 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7441 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7442 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7443 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7444 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7445 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7448 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7449 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7451 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7452 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7453 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7454 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7455 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7456 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7457 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7458 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7461 c call transpose2(a2(1,1),a2t(1,1))
7464 crc print *,((prod_(i,j),i=1,2),j=1,2)
7465 crc print *,((prod(i,j),i=1,2),j=1,2)
7469 C-----------------------------------------------------------------------------
7470 double precision function scalar(u,v)
7472 double precision u(3),v(3)