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 'DIMENSIONS.ZSCOPT'
2873 include 'COMMON.SBRIDGE'
2874 include 'COMMON.CHAIN'
2875 include 'COMMON.DERIV'
2876 include 'COMMON.VAR'
2877 include 'COMMON.INTERACT'
2878 include 'COMMON.IOUNITS'
2879 include 'COMMON.NAMES'
2884 write (iout,'(a4,2x,i4,3f10.5,5x,3f10.5)') restyp(itype(i)),i,
2885 & (c(j,i),j=1,3),(c(j,i+nres),j=1,3)
2887 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2888 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2890 if (link_end.eq.0) return
2891 do i=link_start,link_end
2892 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2893 C CA-CA distance used in regularization of structure.
2896 C iii and jjj point to the residues for which the distance is assigned.
2897 if (ii.gt.nres) then
2905 write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2906 & dhpb(i),dhpb1(i),forcon(i)
2908 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2909 C distance and angle dependent SS bond potential.
2910 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2911 call ssbond_ene(iii,jjj,eij)
2913 cd write (iout,*) "eij",eij
2914 else if (ii.gt.nres .and. jj.gt.nres) then
2915 c Restraints from contact prediction
2917 if (dhpb1(i).gt.0.0d0) then
2918 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2919 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2921 write (iout,*) "beta nmr",
2922 & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2927 C Get the force constant corresponding to this distance.
2929 C Calculate the contribution to energy.
2930 ehpb=ehpb+waga*rdis*rdis
2932 write (iout,*) "beta reg",dd,waga*rdis*rdis
2935 C Evaluate gradient.
2940 ggg(j)=fac*(c(j,jj)-c(j,ii))
2943 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2944 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2947 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2948 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2951 C Calculate the distance between the two points and its difference from the
2954 if (dhpb1(i).gt.0.0d0) then
2955 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2956 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2958 write (iout,*) "alph nmr",
2959 & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2963 C Get the force constant corresponding to this distance.
2965 C Calculate the contribution to energy.
2966 ehpb=ehpb+waga*rdis*rdis
2968 write (iout,*) "alpha reg",dd,waga*rdis*rdis
2971 C Evaluate gradient.
2975 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2976 cd & ' waga=',waga,' fac=',fac
2978 ggg(j)=fac*(c(j,jj)-c(j,ii))
2980 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2981 C If this is a SC-SC distance, we need to calculate the contributions to the
2982 C Cartesian gradient in the SC vectors (ghpbx).
2985 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2986 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2990 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2991 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2998 C--------------------------------------------------------------------------
2999 subroutine ssbond_ene(i,j,eij)
3001 C Calculate the distance and angle dependent SS-bond potential energy
3002 C using a free-energy function derived based on RHF/6-31G** ab initio
3003 C calculations of diethyl disulfide.
3005 C A. Liwo and U. Kozlowska, 11/24/03
3007 implicit real*8 (a-h,o-z)
3008 include 'DIMENSIONS'
3009 include 'DIMENSIONS.ZSCOPT'
3010 include 'COMMON.SBRIDGE'
3011 include 'COMMON.CHAIN'
3012 include 'COMMON.DERIV'
3013 include 'COMMON.LOCAL'
3014 include 'COMMON.INTERACT'
3015 include 'COMMON.VAR'
3016 include 'COMMON.IOUNITS'
3017 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3022 dxi=dc_norm(1,nres+i)
3023 dyi=dc_norm(2,nres+i)
3024 dzi=dc_norm(3,nres+i)
3025 dsci_inv=dsc_inv(itypi)
3027 dscj_inv=dsc_inv(itypj)
3031 dxj=dc_norm(1,nres+j)
3032 dyj=dc_norm(2,nres+j)
3033 dzj=dc_norm(3,nres+j)
3034 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3039 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3040 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3041 om12=dxi*dxj+dyi*dyj+dzi*dzj
3043 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3044 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3050 deltat12=om2-om1+2.0d0
3052 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3053 & +akct*deltad*deltat12
3054 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3055 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3056 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3057 c & " deltat12",deltat12," eij",eij
3058 ed=2*akcm*deltad+akct*deltat12
3060 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3061 eom1=-2*akth*deltat1-pom1-om2*pom2
3062 eom2= 2*akth*deltat2+pom1-om1*pom2
3065 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3068 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3069 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3070 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3071 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3074 C Calculate the components of the gradient in DC and X
3078 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3083 C--------------------------------------------------------------------------
3084 subroutine ebond(estr)
3086 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3088 implicit real*8 (a-h,o-z)
3089 include 'DIMENSIONS'
3090 include 'DIMENSIONS.ZSCOPT'
3091 include 'COMMON.LOCAL'
3092 include 'COMMON.GEO'
3093 include 'COMMON.INTERACT'
3094 include 'COMMON.DERIV'
3095 include 'COMMON.VAR'
3096 include 'COMMON.CHAIN'
3097 include 'COMMON.IOUNITS'
3098 include 'COMMON.NAMES'
3099 include 'COMMON.FFIELD'
3100 include 'COMMON.CONTROL'
3101 double precision u(3),ud(3)
3104 diff = vbld(i)-vbldp0
3105 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3108 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3113 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3120 diff=vbld(i+nres)-vbldsc0(1,iti)
3121 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3122 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3123 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3125 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3129 diff=vbld(i+nres)-vbldsc0(j,iti)
3130 ud(j)=aksc(j,iti)*diff
3131 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3145 uprod2=uprod2*u(k)*u(k)
3149 usumsqder=usumsqder+ud(j)*uprod2
3151 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3152 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3153 estr=estr+uprod/usum
3155 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3163 C--------------------------------------------------------------------------
3164 subroutine ebend(etheta)
3166 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3167 C angles gamma and its derivatives in consecutive thetas and gammas.
3169 implicit real*8 (a-h,o-z)
3170 include 'DIMENSIONS'
3171 include 'DIMENSIONS.ZSCOPT'
3172 include 'COMMON.LOCAL'
3173 include 'COMMON.GEO'
3174 include 'COMMON.INTERACT'
3175 include 'COMMON.DERIV'
3176 include 'COMMON.VAR'
3177 include 'COMMON.CHAIN'
3178 include 'COMMON.IOUNITS'
3179 include 'COMMON.NAMES'
3180 include 'COMMON.FFIELD'
3181 common /calcthet/ term1,term2,termm,diffak,ratak,
3182 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3183 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3184 double precision y(2),z(2)
3186 time11=dexp(-2*time)
3189 c write (iout,*) "nres",nres
3190 c write (*,'(a,i2)') 'EBEND ICG=',icg
3191 c write (iout,*) ithet_start,ithet_end
3192 do i=ithet_start,ithet_end
3193 C Zero the energy function and its derivative at 0 or pi.
3194 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3196 c if (i.gt.ithet_start .and.
3197 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3198 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3206 c if (i.lt.nres .and. itel(i).ne.0) then
3218 call proc_proc(phii,icrc)
3219 if (icrc.eq.1) phii=150.0
3233 call proc_proc(phii1,icrc)
3234 if (icrc.eq.1) phii1=150.0
3246 C Calculate the "mean" value of theta from the part of the distribution
3247 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3248 C In following comments this theta will be referred to as t_c.
3249 thet_pred_mean=0.0d0
3253 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3255 c write (iout,*) "thet_pred_mean",thet_pred_mean
3256 dthett=thet_pred_mean*ssd
3257 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3258 c write (iout,*) "thet_pred_mean",thet_pred_mean
3259 C Derivatives of the "mean" values in gamma1 and gamma2.
3260 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3261 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3262 if (theta(i).gt.pi-delta) then
3263 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3265 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3266 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3267 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3269 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3271 else if (theta(i).lt.delta) then
3272 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3273 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3274 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3276 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3277 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3280 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3283 etheta=etheta+ethetai
3284 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3285 c & rad2deg*phii,rad2deg*phii1,ethetai
3286 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3287 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3288 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3291 C Ufff.... We've done all this!!!
3294 C---------------------------------------------------------------------------
3295 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3297 implicit real*8 (a-h,o-z)
3298 include 'DIMENSIONS'
3299 include 'COMMON.LOCAL'
3300 include 'COMMON.IOUNITS'
3301 common /calcthet/ term1,term2,termm,diffak,ratak,
3302 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3303 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3304 C Calculate the contributions to both Gaussian lobes.
3305 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3306 C The "polynomial part" of the "standard deviation" of this part of
3310 sig=sig*thet_pred_mean+polthet(j,it)
3312 C Derivative of the "interior part" of the "standard deviation of the"
3313 C gamma-dependent Gaussian lobe in t_c.
3314 sigtc=3*polthet(3,it)
3316 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3319 C Set the parameters of both Gaussian lobes of the distribution.
3320 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3321 fac=sig*sig+sigc0(it)
3324 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3325 sigsqtc=-4.0D0*sigcsq*sigtc
3326 c print *,i,sig,sigtc,sigsqtc
3327 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3328 sigtc=-sigtc/(fac*fac)
3329 C Following variable is sigma(t_c)**(-2)
3330 sigcsq=sigcsq*sigcsq
3332 sig0inv=1.0D0/sig0i**2
3333 delthec=thetai-thet_pred_mean
3334 delthe0=thetai-theta0i
3335 term1=-0.5D0*sigcsq*delthec*delthec
3336 term2=-0.5D0*sig0inv*delthe0*delthe0
3337 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3338 C NaNs in taking the logarithm. We extract the largest exponent which is added
3339 C to the energy (this being the log of the distribution) at the end of energy
3340 C term evaluation for this virtual-bond angle.
3341 if (term1.gt.term2) then
3343 term2=dexp(term2-termm)
3347 term1=dexp(term1-termm)
3350 C The ratio between the gamma-independent and gamma-dependent lobes of
3351 C the distribution is a Gaussian function of thet_pred_mean too.
3352 diffak=gthet(2,it)-thet_pred_mean
3353 ratak=diffak/gthet(3,it)**2
3354 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3355 C Let's differentiate it in thet_pred_mean NOW.
3357 C Now put together the distribution terms to make complete distribution.
3358 termexp=term1+ak*term2
3359 termpre=sigc+ak*sig0i
3360 C Contribution of the bending energy from this theta is just the -log of
3361 C the sum of the contributions from the two lobes and the pre-exponential
3362 C factor. Simple enough, isn't it?
3363 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3364 C NOW the derivatives!!!
3365 C 6/6/97 Take into account the deformation.
3366 E_theta=(delthec*sigcsq*term1
3367 & +ak*delthe0*sig0inv*term2)/termexp
3368 E_tc=((sigtc+aktc*sig0i)/termpre
3369 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3370 & aktc*term2)/termexp)
3373 c-----------------------------------------------------------------------------
3374 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3375 implicit real*8 (a-h,o-z)
3376 include 'DIMENSIONS'
3377 include 'COMMON.LOCAL'
3378 include 'COMMON.IOUNITS'
3379 common /calcthet/ term1,term2,termm,diffak,ratak,
3380 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3381 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3382 delthec=thetai-thet_pred_mean
3383 delthe0=thetai-theta0i
3384 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3385 t3 = thetai-thet_pred_mean
3389 t14 = t12+t6*sigsqtc
3391 t21 = thetai-theta0i
3397 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3398 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3399 & *(-t12*t9-ak*sig0inv*t27)
3403 C--------------------------------------------------------------------------
3404 subroutine ebend(etheta)
3406 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3407 C angles gamma and its derivatives in consecutive thetas and gammas.
3408 C ab initio-derived potentials from
3409 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3411 implicit real*8 (a-h,o-z)
3412 include 'DIMENSIONS'
3413 include 'DIMENSIONS.ZSCOPT'
3414 include 'COMMON.LOCAL'
3415 include 'COMMON.GEO'
3416 include 'COMMON.INTERACT'
3417 include 'COMMON.DERIV'
3418 include 'COMMON.VAR'
3419 include 'COMMON.CHAIN'
3420 include 'COMMON.IOUNITS'
3421 include 'COMMON.NAMES'
3422 include 'COMMON.FFIELD'
3423 include 'COMMON.CONTROL'
3424 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3425 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3426 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3427 & sinph1ph2(maxdouble,maxdouble)
3428 logical lprn /.false./, lprn1 /.false./
3430 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3431 do i=ithet_start,ithet_end
3435 theti2=0.5d0*theta(i)
3436 ityp2=ithetyp(itype(i-1))
3438 coskt(k)=dcos(k*theti2)
3439 sinkt(k)=dsin(k*theti2)
3444 if (phii.ne.phii) phii=150.0
3448 ityp1=ithetyp(itype(i-2))
3450 cosph1(k)=dcos(k*phii)
3451 sinph1(k)=dsin(k*phii)
3464 if (phii1.ne.phii1) phii1=150.0
3469 ityp3=ithetyp(itype(i))
3471 cosph2(k)=dcos(k*phii1)
3472 sinph2(k)=dsin(k*phii1)
3482 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3483 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3485 ethetai=aa0thet(ityp1,ityp2,ityp3)
3488 ccl=cosph1(l)*cosph2(k-l)
3489 ssl=sinph1(l)*sinph2(k-l)
3490 scl=sinph1(l)*cosph2(k-l)
3491 csl=cosph1(l)*sinph2(k-l)
3492 cosph1ph2(l,k)=ccl-ssl
3493 cosph1ph2(k,l)=ccl+ssl
3494 sinph1ph2(l,k)=scl+csl
3495 sinph1ph2(k,l)=scl-csl
3499 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3500 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3501 write (iout,*) "coskt and sinkt"
3503 write (iout,*) k,coskt(k),sinkt(k)
3507 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3508 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3511 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3512 & " ethetai",ethetai
3515 write (iout,*) "cosph and sinph"
3517 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3519 write (iout,*) "cosph1ph2 and sinph2ph2"
3522 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3523 & sinph1ph2(l,k),sinph1ph2(k,l)
3526 write(iout,*) "ethetai",ethetai
3530 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3531 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3532 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3533 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3534 ethetai=ethetai+sinkt(m)*aux
3535 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3536 dephii=dephii+k*sinkt(m)*(
3537 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3538 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3539 dephii1=dephii1+k*sinkt(m)*(
3540 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3541 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3543 & write (iout,*) "m",m," k",k," bbthet",
3544 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3545 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3546 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3547 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3551 & write(iout,*) "ethetai",ethetai
3555 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3556 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3557 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3558 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3559 ethetai=ethetai+sinkt(m)*aux
3560 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3561 dephii=dephii+l*sinkt(m)*(
3562 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3563 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3564 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3565 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3566 dephii1=dephii1+(k-l)*sinkt(m)*(
3567 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3568 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3569 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3570 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3572 write (iout,*) "m",m," k",k," l",l," ffthet",
3573 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3574 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3575 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3576 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3577 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3578 & cosph1ph2(k,l)*sinkt(m),
3579 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3585 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3586 & i,theta(i)*rad2deg,phii*rad2deg,
3587 & phii1*rad2deg,ethetai
3588 etheta=etheta+ethetai
3589 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3590 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3591 gloc(nphi+i-2,icg)=wang*dethetai
3597 c-----------------------------------------------------------------------------
3598 subroutine esc(escloc)
3599 C Calculate the local energy of a side chain and its derivatives in the
3600 C corresponding virtual-bond valence angles THETA and the spherical angles
3602 implicit real*8 (a-h,o-z)
3603 include 'DIMENSIONS'
3604 include 'DIMENSIONS.ZSCOPT'
3605 include 'COMMON.GEO'
3606 include 'COMMON.LOCAL'
3607 include 'COMMON.VAR'
3608 include 'COMMON.INTERACT'
3609 include 'COMMON.DERIV'
3610 include 'COMMON.CHAIN'
3611 include 'COMMON.IOUNITS'
3612 include 'COMMON.NAMES'
3613 include 'COMMON.FFIELD'
3614 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3615 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3616 common /sccalc/ time11,time12,time112,theti,it,nlobit
3619 c write (iout,'(a)') 'ESC'
3620 do i=loc_start,loc_end
3622 if (it.eq.10) goto 1
3624 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3625 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3626 theti=theta(i+1)-pipol
3630 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3632 if (x(2).gt.pi-delta) then
3636 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3638 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3639 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3641 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3642 & ddersc0(1),dersc(1))
3643 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3644 & ddersc0(3),dersc(3))
3646 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3648 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3649 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3650 & dersc0(2),esclocbi,dersc02)
3651 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3653 call splinthet(x(2),0.5d0*delta,ss,ssd)
3658 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3660 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3661 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3663 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3665 c write (iout,*) escloci
3666 else if (x(2).lt.delta) then
3670 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3672 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3673 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3675 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3676 & ddersc0(1),dersc(1))
3677 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3678 & ddersc0(3),dersc(3))
3680 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3682 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3683 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3684 & dersc0(2),esclocbi,dersc02)
3685 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3690 call splinthet(x(2),0.5d0*delta,ss,ssd)
3692 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3694 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3695 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3697 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3698 c write (iout,*) escloci
3700 call enesc(x,escloci,dersc,ddummy,.false.)
3703 escloc=escloc+escloci
3704 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3706 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3708 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3709 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3714 C---------------------------------------------------------------------------
3715 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3716 implicit real*8 (a-h,o-z)
3717 include 'DIMENSIONS'
3718 include 'COMMON.GEO'
3719 include 'COMMON.LOCAL'
3720 include 'COMMON.IOUNITS'
3721 common /sccalc/ time11,time12,time112,theti,it,nlobit
3722 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3723 double precision contr(maxlob,-1:1)
3725 c write (iout,*) 'it=',it,' nlobit=',nlobit
3729 if (mixed) ddersc(j)=0.0d0
3733 C Because of periodicity of the dependence of the SC energy in omega we have
3734 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3735 C To avoid underflows, first compute & store the exponents.
3743 z(k)=x(k)-censc(k,j,it)
3748 Axk=Axk+gaussc(l,k,j,it)*z(l)
3754 expfac=expfac+Ax(k,j,iii)*z(k)
3762 C As in the case of ebend, we want to avoid underflows in exponentiation and
3763 C subsequent NaNs and INFs in energy calculation.
3764 C Find the largest exponent
3768 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3772 cd print *,'it=',it,' emin=',emin
3774 C Compute the contribution to SC energy and derivatives
3778 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3779 cd print *,'j=',j,' expfac=',expfac
3780 escloc_i=escloc_i+expfac
3782 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3786 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3787 & +gaussc(k,2,j,it))*expfac
3794 dersc(1)=dersc(1)/cos(theti)**2
3795 ddersc(1)=ddersc(1)/cos(theti)**2
3798 escloci=-(dlog(escloc_i)-emin)
3800 dersc(j)=dersc(j)/escloc_i
3804 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3809 C------------------------------------------------------------------------------
3810 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3811 implicit real*8 (a-h,o-z)
3812 include 'DIMENSIONS'
3813 include 'COMMON.GEO'
3814 include 'COMMON.LOCAL'
3815 include 'COMMON.IOUNITS'
3816 common /sccalc/ time11,time12,time112,theti,it,nlobit
3817 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3818 double precision contr(maxlob)
3829 z(k)=x(k)-censc(k,j,it)
3835 Axk=Axk+gaussc(l,k,j,it)*z(l)
3841 expfac=expfac+Ax(k,j)*z(k)
3846 C As in the case of ebend, we want to avoid underflows in exponentiation and
3847 C subsequent NaNs and INFs in energy calculation.
3848 C Find the largest exponent
3851 if (emin.gt.contr(j)) emin=contr(j)
3855 C Compute the contribution to SC energy and derivatives
3859 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3860 escloc_i=escloc_i+expfac
3862 dersc(k)=dersc(k)+Ax(k,j)*expfac
3864 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3865 & +gaussc(1,2,j,it))*expfac
3869 dersc(1)=dersc(1)/cos(theti)**2
3870 dersc12=dersc12/cos(theti)**2
3871 escloci=-(dlog(escloc_i)-emin)
3873 dersc(j)=dersc(j)/escloc_i
3875 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3879 c----------------------------------------------------------------------------------
3880 subroutine esc(escloc)
3881 C Calculate the local energy of a side chain and its derivatives in the
3882 C corresponding virtual-bond valence angles THETA and the spherical angles
3883 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3884 C added by Urszula Kozlowska. 07/11/2007
3886 implicit real*8 (a-h,o-z)
3887 include 'DIMENSIONS'
3888 include 'DIMENSIONS.ZSCOPT'
3889 include 'COMMON.GEO'
3890 include 'COMMON.LOCAL'
3891 include 'COMMON.VAR'
3892 include 'COMMON.SCROT'
3893 include 'COMMON.INTERACT'
3894 include 'COMMON.DERIV'
3895 include 'COMMON.CHAIN'
3896 include 'COMMON.IOUNITS'
3897 include 'COMMON.NAMES'
3898 include 'COMMON.FFIELD'
3899 include 'COMMON.CONTROL'
3900 include 'COMMON.VECTORS'
3901 double precision x_prime(3),y_prime(3),z_prime(3)
3902 & , sumene,dsc_i,dp2_i,x(65),
3903 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3904 & de_dxx,de_dyy,de_dzz,de_dt
3905 double precision s1_t,s1_6_t,s2_t,s2_6_t
3907 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3908 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3909 & dt_dCi(3),dt_dCi1(3)
3910 common /sccalc/ time11,time12,time112,theti,it,nlobit
3913 do i=loc_start,loc_end
3914 costtab(i+1) =dcos(theta(i+1))
3915 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3916 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3917 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3918 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3919 cosfac=dsqrt(cosfac2)
3920 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3921 sinfac=dsqrt(sinfac2)
3923 if (it.eq.10) goto 1
3925 C Compute the axes of tghe local cartesian coordinates system; store in
3926 c x_prime, y_prime and z_prime
3933 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3934 C & dc_norm(3,i+nres)
3936 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3937 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3940 z_prime(j) = -uz(j,i-1)
3943 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3944 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3945 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3946 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3947 c & " xy",scalar(x_prime(1),y_prime(1)),
3948 c & " xz",scalar(x_prime(1),z_prime(1)),
3949 c & " yy",scalar(y_prime(1),y_prime(1)),
3950 c & " yz",scalar(y_prime(1),z_prime(1)),
3951 c & " zz",scalar(z_prime(1),z_prime(1))
3953 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3954 C to local coordinate system. Store in xx, yy, zz.
3960 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3961 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3962 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3969 C Compute the energy of the ith side cbain
3971 c write (2,*) "xx",xx," yy",yy," zz",zz
3974 x(j) = sc_parmin(j,it)
3977 Cc diagnostics - remove later
3979 yy1 = dsin(alph(2))*dcos(omeg(2))
3980 zz1 = -dsin(alph(2))*dsin(omeg(2))
3981 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3982 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3984 C," --- ", xx_w,yy_w,zz_w
3987 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3988 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3990 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3991 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3993 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3994 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3995 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3996 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3997 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3999 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4000 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4001 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4002 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4003 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4005 dsc_i = 0.743d0+x(61)
4007 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4008 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4009 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4010 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4011 s1=(1+x(63))/(0.1d0 + dscp1)
4012 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4013 s2=(1+x(65))/(0.1d0 + dscp2)
4014 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4015 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4016 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4017 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4019 c & dscp1,dscp2,sumene
4020 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4021 escloc = escloc + sumene
4022 c write (2,*) "escloc",escloc
4023 if (.not. calc_grad) goto 1
4026 C This section to check the numerical derivatives of the energy of ith side
4027 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4028 C #define DEBUG in the code to turn it on.
4030 write (2,*) "sumene =",sumene
4034 write (2,*) xx,yy,zz
4035 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4036 de_dxx_num=(sumenep-sumene)/aincr
4038 write (2,*) "xx+ sumene from enesc=",sumenep
4041 write (2,*) xx,yy,zz
4042 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4043 de_dyy_num=(sumenep-sumene)/aincr
4045 write (2,*) "yy+ sumene from enesc=",sumenep
4048 write (2,*) xx,yy,zz
4049 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4050 de_dzz_num=(sumenep-sumene)/aincr
4052 write (2,*) "zz+ sumene from enesc=",sumenep
4053 costsave=cost2tab(i+1)
4054 sintsave=sint2tab(i+1)
4055 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4056 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4057 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4058 de_dt_num=(sumenep-sumene)/aincr
4059 write (2,*) " t+ sumene from enesc=",sumenep
4060 cost2tab(i+1)=costsave
4061 sint2tab(i+1)=sintsave
4062 C End of diagnostics section.
4065 C Compute the gradient of esc
4067 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4068 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4069 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4070 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4071 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4072 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4073 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4074 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4075 pom1=(sumene3*sint2tab(i+1)+sumene1)
4076 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4077 pom2=(sumene4*cost2tab(i+1)+sumene2)
4078 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4079 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4080 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4081 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4083 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4084 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4085 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4087 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4088 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4089 & +(pom1+pom2)*pom_dx
4091 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4094 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4095 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4096 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4098 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4099 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4100 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4101 & +x(59)*zz**2 +x(60)*xx*zz
4102 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4103 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4104 & +(pom1-pom2)*pom_dy
4106 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4109 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4110 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4111 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4112 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4113 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4114 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4115 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4116 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4118 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4121 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4122 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4123 & +pom1*pom_dt1+pom2*pom_dt2
4125 write(2,*), "de_dt = ", de_dt,de_dt_num
4129 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4130 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4131 cosfac2xx=cosfac2*xx
4132 sinfac2yy=sinfac2*yy
4134 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4136 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4138 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4139 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4140 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4141 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4142 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4143 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4144 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4145 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4146 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4147 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4151 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4152 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4155 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4156 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4157 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4159 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4160 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4164 dXX_Ctab(k,i)=dXX_Ci(k)
4165 dXX_C1tab(k,i)=dXX_Ci1(k)
4166 dYY_Ctab(k,i)=dYY_Ci(k)
4167 dYY_C1tab(k,i)=dYY_Ci1(k)
4168 dZZ_Ctab(k,i)=dZZ_Ci(k)
4169 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4170 dXX_XYZtab(k,i)=dXX_XYZ(k)
4171 dYY_XYZtab(k,i)=dYY_XYZ(k)
4172 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4176 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4177 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4178 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4179 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4180 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4182 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4183 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4184 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4185 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4186 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4187 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4188 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4189 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4191 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4192 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4194 C to check gradient call subroutine check_grad
4201 c------------------------------------------------------------------------------
4202 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4204 C This procedure calculates two-body contact function g(rij) and its derivative:
4207 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4210 C where x=(rij-r0ij)/delta
4212 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4215 double precision rij,r0ij,eps0ij,fcont,fprimcont
4216 double precision x,x2,x4,delta
4220 if (x.lt.-1.0D0) then
4223 else if (x.le.1.0D0) then
4226 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4227 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4234 c------------------------------------------------------------------------------
4235 subroutine splinthet(theti,delta,ss,ssder)
4236 implicit real*8 (a-h,o-z)
4237 include 'DIMENSIONS'
4238 include 'DIMENSIONS.ZSCOPT'
4239 include 'COMMON.VAR'
4240 include 'COMMON.GEO'
4243 if (theti.gt.pipol) then
4244 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4246 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4251 c------------------------------------------------------------------------------
4252 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4254 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4255 double precision ksi,ksi2,ksi3,a1,a2,a3
4256 a1=fprim0*delta/(f1-f0)
4262 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4263 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4266 c------------------------------------------------------------------------------
4267 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4269 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4270 double precision ksi,ksi2,ksi3,a1,a2,a3
4275 a2=3*(f1x-f0x)-2*fprim0x*delta
4276 a3=fprim0x*delta-2*(f1x-f0x)
4277 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4280 C-----------------------------------------------------------------------------
4282 C-----------------------------------------------------------------------------
4283 subroutine etor(etors,edihcnstr,fact)
4284 implicit real*8 (a-h,o-z)
4285 include 'DIMENSIONS'
4286 include 'DIMENSIONS.ZSCOPT'
4287 include 'COMMON.VAR'
4288 include 'COMMON.GEO'
4289 include 'COMMON.LOCAL'
4290 include 'COMMON.TORSION'
4291 include 'COMMON.INTERACT'
4292 include 'COMMON.DERIV'
4293 include 'COMMON.CHAIN'
4294 include 'COMMON.NAMES'
4295 include 'COMMON.IOUNITS'
4296 include 'COMMON.FFIELD'
4297 include 'COMMON.TORCNSTR'
4299 C Set lprn=.true. for debugging
4303 do i=iphi_start,iphi_end
4304 itori=itortyp(itype(i-2))
4305 itori1=itortyp(itype(i-1))
4308 C Proline-Proline pair is a special case...
4309 if (itori.eq.3 .and. itori1.eq.3) then
4310 if (phii.gt.-dwapi3) then
4312 fac=1.0D0/(1.0D0-cosphi)
4313 etorsi=v1(1,3,3)*fac
4314 etorsi=etorsi+etorsi
4315 etors=etors+etorsi-v1(1,3,3)
4316 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4319 v1ij=v1(j+1,itori,itori1)
4320 v2ij=v2(j+1,itori,itori1)
4323 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4324 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4328 v1ij=v1(j,itori,itori1)
4329 v2ij=v2(j,itori,itori1)
4332 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4333 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4337 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4338 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4339 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4340 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4341 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4343 ! 6/20/98 - dihedral angle constraints
4346 itori=idih_constr(i)
4349 if (difi.gt.drange(i)) then
4351 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4352 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4353 else if (difi.lt.-drange(i)) then
4355 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4356 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4358 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4359 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4361 ! write (iout,*) 'edihcnstr',edihcnstr
4364 c------------------------------------------------------------------------------
4366 subroutine etor(etors,edihcnstr,fact)
4367 implicit real*8 (a-h,o-z)
4368 include 'DIMENSIONS'
4369 include 'DIMENSIONS.ZSCOPT'
4370 include 'COMMON.VAR'
4371 include 'COMMON.GEO'
4372 include 'COMMON.LOCAL'
4373 include 'COMMON.TORSION'
4374 include 'COMMON.INTERACT'
4375 include 'COMMON.DERIV'
4376 include 'COMMON.CHAIN'
4377 include 'COMMON.NAMES'
4378 include 'COMMON.IOUNITS'
4379 include 'COMMON.FFIELD'
4380 include 'COMMON.TORCNSTR'
4382 C Set lprn=.true. for debugging
4386 do i=iphi_start,iphi_end
4387 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4388 itori=itortyp(itype(i-2))
4389 itori1=itortyp(itype(i-1))
4392 C Regular cosine and sine terms
4393 do j=1,nterm(itori,itori1)
4394 v1ij=v1(j,itori,itori1)
4395 v2ij=v2(j,itori,itori1)
4398 etors=etors+v1ij*cosphi+v2ij*sinphi
4399 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4403 C E = SUM ----------------------------------- - v1
4404 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4406 cosphi=dcos(0.5d0*phii)
4407 sinphi=dsin(0.5d0*phii)
4408 do j=1,nlor(itori,itori1)
4409 vl1ij=vlor1(j,itori,itori1)
4410 vl2ij=vlor2(j,itori,itori1)
4411 vl3ij=vlor3(j,itori,itori1)
4412 pom=vl2ij*cosphi+vl3ij*sinphi
4413 pom1=1.0d0/(pom*pom+1.0d0)
4414 etors=etors+vl1ij*pom1
4416 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4418 C Subtract the constant term
4419 etors=etors-v0(itori,itori1)
4421 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4422 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4423 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4424 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4425 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4428 ! 6/20/98 - dihedral angle constraints
4431 itori=idih_constr(i)
4433 difi=pinorm(phii-phi0(i))
4435 if (difi.gt.drange(i)) then
4437 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4438 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4439 edihi=0.25d0*ftors*difi**4
4440 else if (difi.lt.-drange(i)) then
4442 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4443 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4444 edihi=0.25d0*ftors*difi**4
4448 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4450 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4451 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4453 ! write (iout,*) 'edihcnstr',edihcnstr
4456 c----------------------------------------------------------------------------
4457 subroutine etor_d(etors_d,fact2)
4458 C 6/23/01 Compute double torsional energy
4459 implicit real*8 (a-h,o-z)
4460 include 'DIMENSIONS'
4461 include 'DIMENSIONS.ZSCOPT'
4462 include 'COMMON.VAR'
4463 include 'COMMON.GEO'
4464 include 'COMMON.LOCAL'
4465 include 'COMMON.TORSION'
4466 include 'COMMON.INTERACT'
4467 include 'COMMON.DERIV'
4468 include 'COMMON.CHAIN'
4469 include 'COMMON.NAMES'
4470 include 'COMMON.IOUNITS'
4471 include 'COMMON.FFIELD'
4472 include 'COMMON.TORCNSTR'
4474 C Set lprn=.true. for debugging
4478 do i=iphi_start,iphi_end-1
4479 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4481 itori=itortyp(itype(i-2))
4482 itori1=itortyp(itype(i-1))
4483 itori2=itortyp(itype(i))
4488 C Regular cosine and sine terms
4489 do j=1,ntermd_1(itori,itori1,itori2)
4490 v1cij=v1c(1,j,itori,itori1,itori2)
4491 v1sij=v1s(1,j,itori,itori1,itori2)
4492 v2cij=v1c(2,j,itori,itori1,itori2)
4493 v2sij=v1s(2,j,itori,itori1,itori2)
4494 cosphi1=dcos(j*phii)
4495 sinphi1=dsin(j*phii)
4496 cosphi2=dcos(j*phii1)
4497 sinphi2=dsin(j*phii1)
4498 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4499 & v2cij*cosphi2+v2sij*sinphi2
4500 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4501 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4503 do k=2,ntermd_2(itori,itori1,itori2)
4505 v1cdij = v2c(k,l,itori,itori1,itori2)
4506 v2cdij = v2c(l,k,itori,itori1,itori2)
4507 v1sdij = v2s(k,l,itori,itori1,itori2)
4508 v2sdij = v2s(l,k,itori,itori1,itori2)
4509 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4510 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4511 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4512 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4513 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4514 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4515 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4516 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4517 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4518 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4521 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4522 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4528 c------------------------------------------------------------------------------
4529 subroutine eback_sc_corr(esccor)
4530 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4531 c conformational states; temporarily implemented as differences
4532 c between UNRES torsional potentials (dependent on three types of
4533 c residues) and the torsional potentials dependent on all 20 types
4534 c of residues computed from AM1 energy surfaces of terminally-blocked
4535 c amino-acid residues.
4536 implicit real*8 (a-h,o-z)
4537 include 'DIMENSIONS'
4538 include 'DIMENSIONS.ZSCOPT'
4539 include 'COMMON.VAR'
4540 include 'COMMON.GEO'
4541 include 'COMMON.LOCAL'
4542 include 'COMMON.TORSION'
4543 include 'COMMON.SCCOR'
4544 include 'COMMON.INTERACT'
4545 include 'COMMON.DERIV'
4546 include 'COMMON.CHAIN'
4547 include 'COMMON.NAMES'
4548 include 'COMMON.IOUNITS'
4549 include 'COMMON.FFIELD'
4550 include 'COMMON.CONTROL'
4552 C Set lprn=.true. for debugging
4555 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4557 do i=itau_start,itau_end
4559 isccori=isccortyp(itype(i-2))
4560 isccori1=isccortyp(itype(i-1))
4562 cccc Added 9 May 2012
4563 cc Tauangle is torsional engle depending on the value of first digit
4564 c(see comment below)
4565 cc Omicron is flat angle depending on the value of first digit
4566 c(see comment below)
4569 do intertyp=1,3 !intertyp
4570 cc Added 09 May 2012 (Adasko)
4571 cc Intertyp means interaction type of backbone mainchain correlation:
4572 c 1 = SC...Ca...Ca...Ca
4573 c 2 = Ca...Ca...Ca...SC
4574 c 3 = SC...Ca...Ca...SCi
4576 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4577 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4578 & (itype(i-1).eq.21)))
4579 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4580 & .or.(itype(i-2).eq.21)))
4581 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4582 & (itype(i-1).eq.21)))) cycle
4583 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4584 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4586 do j=1,nterm_sccor(isccori,isccori1)
4587 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4588 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4589 cosphi=dcos(j*tauangle(intertyp,i))
4590 sinphi=dsin(j*tauangle(intertyp,i))
4591 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4592 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4594 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4595 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4596 c &gloc_sc(intertyp,i-3,icg)
4598 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4599 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4600 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4601 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4602 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4606 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4610 c------------------------------------------------------------------------------
4611 subroutine multibody(ecorr)
4612 C This subroutine calculates multi-body contributions to energy following
4613 C the idea of Skolnick et al. If side chains I and J make a contact and
4614 C at the same time side chains I+1 and J+1 make a contact, an extra
4615 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4616 implicit real*8 (a-h,o-z)
4617 include 'DIMENSIONS'
4618 include 'COMMON.IOUNITS'
4619 include 'COMMON.DERIV'
4620 include 'COMMON.INTERACT'
4621 include 'COMMON.CONTACTS'
4622 double precision gx(3),gx1(3)
4625 C Set lprn=.true. for debugging
4629 write (iout,'(a)') 'Contact function values:'
4631 write (iout,'(i2,20(1x,i2,f10.5))')
4632 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4647 num_conti=num_cont(i)
4648 num_conti1=num_cont(i1)
4653 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4654 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4655 cd & ' ishift=',ishift
4656 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4657 C The system gains extra energy.
4658 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4659 endif ! j1==j+-ishift
4668 c------------------------------------------------------------------------------
4669 double precision function esccorr(i,j,k,l,jj,kk)
4670 implicit real*8 (a-h,o-z)
4671 include 'DIMENSIONS'
4672 include 'COMMON.IOUNITS'
4673 include 'COMMON.DERIV'
4674 include 'COMMON.INTERACT'
4675 include 'COMMON.CONTACTS'
4676 double precision gx(3),gx1(3)
4681 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4682 C Calculate the multi-body contribution to energy.
4683 C Calculate multi-body contributions to the gradient.
4684 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4685 cd & k,l,(gacont(m,kk,k),m=1,3)
4687 gx(m) =ekl*gacont(m,jj,i)
4688 gx1(m)=eij*gacont(m,kk,k)
4689 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4690 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4691 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4692 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4696 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4701 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4707 c------------------------------------------------------------------------------
4709 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4710 implicit real*8 (a-h,o-z)
4711 include 'DIMENSIONS'
4712 integer dimen1,dimen2,atom,indx
4713 double precision buffer(dimen1,dimen2)
4714 double precision zapas
4715 common /contacts_hb/ zapas(3,20,maxres,7),
4716 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4717 & num_cont_hb(maxres),jcont_hb(20,maxres)
4718 num_kont=num_cont_hb(atom)
4722 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4725 buffer(i,indx+22)=facont_hb(i,atom)
4726 buffer(i,indx+23)=ees0p(i,atom)
4727 buffer(i,indx+24)=ees0m(i,atom)
4728 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4730 buffer(1,indx+26)=dfloat(num_kont)
4733 c------------------------------------------------------------------------------
4734 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4735 implicit real*8 (a-h,o-z)
4736 include 'DIMENSIONS'
4737 integer dimen1,dimen2,atom,indx
4738 double precision buffer(dimen1,dimen2)
4739 double precision zapas
4740 common /contacts_hb/ zapas(3,20,maxres,7),
4741 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4742 & num_cont_hb(maxres),jcont_hb(20,maxres)
4743 num_kont=buffer(1,indx+26)
4744 num_kont_old=num_cont_hb(atom)
4745 num_cont_hb(atom)=num_kont+num_kont_old
4750 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4753 facont_hb(ii,atom)=buffer(i,indx+22)
4754 ees0p(ii,atom)=buffer(i,indx+23)
4755 ees0m(ii,atom)=buffer(i,indx+24)
4756 jcont_hb(ii,atom)=buffer(i,indx+25)
4760 c------------------------------------------------------------------------------
4762 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4763 C This subroutine calculates multi-body contributions to hydrogen-bonding
4764 implicit real*8 (a-h,o-z)
4765 include 'DIMENSIONS'
4766 include 'DIMENSIONS.ZSCOPT'
4767 include 'COMMON.IOUNITS'
4769 include 'COMMON.INFO'
4771 include 'COMMON.FFIELD'
4772 include 'COMMON.DERIV'
4773 include 'COMMON.INTERACT'
4774 include 'COMMON.CONTACTS'
4776 parameter (max_cont=maxconts)
4777 parameter (max_dim=2*(8*3+2))
4778 parameter (msglen1=max_cont*max_dim*4)
4779 parameter (msglen2=2*msglen1)
4780 integer source,CorrelType,CorrelID,Error
4781 double precision buffer(max_cont,max_dim)
4783 double precision gx(3),gx1(3)
4786 C Set lprn=.true. for debugging
4791 if (fgProcs.le.1) goto 30
4793 write (iout,'(a)') 'Contact function values:'
4795 write (iout,'(2i3,50(1x,i2,f5.2))')
4796 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4797 & j=1,num_cont_hb(i))
4800 C Caution! Following code assumes that electrostatic interactions concerning
4801 C a given atom are split among at most two processors!
4811 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4814 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4815 if (MyRank.gt.0) then
4816 C Send correlation contributions to the preceding processor
4818 nn=num_cont_hb(iatel_s)
4819 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4820 cd write (iout,*) 'The BUFFER array:'
4822 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4824 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4826 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4827 C Clear the contacts of the atom passed to the neighboring processor
4828 nn=num_cont_hb(iatel_s+1)
4830 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4832 num_cont_hb(iatel_s)=0
4834 cd write (iout,*) 'Processor ',MyID,MyRank,
4835 cd & ' is sending correlation contribution to processor',MyID-1,
4836 cd & ' msglen=',msglen
4837 cd write (*,*) 'Processor ',MyID,MyRank,
4838 cd & ' is sending correlation contribution to processor',MyID-1,
4839 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4840 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4841 cd write (iout,*) 'Processor ',MyID,
4842 cd & ' has sent correlation contribution to processor',MyID-1,
4843 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4844 cd write (*,*) 'Processor ',MyID,
4845 cd & ' has sent correlation contribution to processor',MyID-1,
4846 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4848 endif ! (MyRank.gt.0)
4852 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4853 if (MyRank.lt.fgProcs-1) then
4854 C Receive correlation contributions from the next processor
4856 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4857 cd write (iout,*) 'Processor',MyID,
4858 cd & ' is receiving correlation contribution from processor',MyID+1,
4859 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4860 cd write (*,*) 'Processor',MyID,
4861 cd & ' is receiving correlation contribution from processor',MyID+1,
4862 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4864 do while (nbytes.le.0)
4865 call mp_probe(MyID+1,CorrelType,nbytes)
4867 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4868 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4869 cd write (iout,*) 'Processor',MyID,
4870 cd & ' has received correlation contribution from processor',MyID+1,
4871 cd & ' msglen=',msglen,' nbytes=',nbytes
4872 cd write (iout,*) 'The received BUFFER array:'
4874 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4876 if (msglen.eq.msglen1) then
4877 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4878 else if (msglen.eq.msglen2) then
4879 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4880 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4883 & 'ERROR!!!! message length changed while processing correlations.'
4885 & 'ERROR!!!! message length changed while processing correlations.'
4886 call mp_stopall(Error)
4887 endif ! msglen.eq.msglen1
4888 endif ! MyRank.lt.fgProcs-1
4895 write (iout,'(a)') 'Contact function values:'
4897 write (iout,'(2i3,50(1x,i2,f5.2))')
4898 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4899 & j=1,num_cont_hb(i))
4903 C Remove the loop below after debugging !!!
4910 C Calculate the local-electrostatic correlation terms
4911 do i=iatel_s,iatel_e+1
4913 num_conti=num_cont_hb(i)
4914 num_conti1=num_cont_hb(i+1)
4919 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4920 c & ' jj=',jj,' kk=',kk
4921 if (j1.eq.j+1 .or. j1.eq.j-1) then
4922 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4923 C The system gains extra energy.
4924 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4926 else if (j1.eq.j) then
4927 C Contacts I-J and I-(J+1) occur simultaneously.
4928 C The system loses extra energy.
4929 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4934 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4935 c & ' jj=',jj,' kk=',kk
4937 C Contacts I-J and (I+1)-J occur simultaneously.
4938 C The system loses extra energy.
4939 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4946 c------------------------------------------------------------------------------
4947 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4949 C This subroutine calculates multi-body contributions to hydrogen-bonding
4950 implicit real*8 (a-h,o-z)
4951 include 'DIMENSIONS'
4952 include 'DIMENSIONS.ZSCOPT'
4953 include 'COMMON.IOUNITS'
4955 include 'COMMON.INFO'
4957 include 'COMMON.FFIELD'
4958 include 'COMMON.DERIV'
4959 include 'COMMON.INTERACT'
4960 include 'COMMON.CONTACTS'
4962 parameter (max_cont=maxconts)
4963 parameter (max_dim=2*(8*3+2))
4964 parameter (msglen1=max_cont*max_dim*4)
4965 parameter (msglen2=2*msglen1)
4966 integer source,CorrelType,CorrelID,Error
4967 double precision buffer(max_cont,max_dim)
4969 double precision gx(3),gx1(3)
4972 C Set lprn=.true. for debugging
4978 if (fgProcs.le.1) goto 30
4980 write (iout,'(a)') 'Contact function values:'
4982 write (iout,'(2i3,50(1x,i2,f5.2))')
4983 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4984 & j=1,num_cont_hb(i))
4987 C Caution! Following code assumes that electrostatic interactions concerning
4988 C a given atom are split among at most two processors!
4998 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5001 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5002 if (MyRank.gt.0) then
5003 C Send correlation contributions to the preceding processor
5005 nn=num_cont_hb(iatel_s)
5006 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5007 cd write (iout,*) 'The BUFFER array:'
5009 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5011 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5013 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5014 C Clear the contacts of the atom passed to the neighboring processor
5015 nn=num_cont_hb(iatel_s+1)
5017 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5019 num_cont_hb(iatel_s)=0
5021 cd write (iout,*) 'Processor ',MyID,MyRank,
5022 cd & ' is sending correlation contribution to processor',MyID-1,
5023 cd & ' msglen=',msglen
5024 cd write (*,*) 'Processor ',MyID,MyRank,
5025 cd & ' is sending correlation contribution to processor',MyID-1,
5026 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5027 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5028 cd write (iout,*) 'Processor ',MyID,
5029 cd & ' has sent correlation contribution to processor',MyID-1,
5030 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5031 cd write (*,*) 'Processor ',MyID,
5032 cd & ' has sent correlation contribution to processor',MyID-1,
5033 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5035 endif ! (MyRank.gt.0)
5039 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5040 if (MyRank.lt.fgProcs-1) then
5041 C Receive correlation contributions from the next processor
5043 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5044 cd write (iout,*) 'Processor',MyID,
5045 cd & ' is receiving correlation contribution from processor',MyID+1,
5046 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5047 cd write (*,*) 'Processor',MyID,
5048 cd & ' is receiving correlation contribution from processor',MyID+1,
5049 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5051 do while (nbytes.le.0)
5052 call mp_probe(MyID+1,CorrelType,nbytes)
5054 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5055 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5056 cd write (iout,*) 'Processor',MyID,
5057 cd & ' has received correlation contribution from processor',MyID+1,
5058 cd & ' msglen=',msglen,' nbytes=',nbytes
5059 cd write (iout,*) 'The received BUFFER array:'
5061 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5063 if (msglen.eq.msglen1) then
5064 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5065 else if (msglen.eq.msglen2) then
5066 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5067 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5070 & 'ERROR!!!! message length changed while processing correlations.'
5072 & 'ERROR!!!! message length changed while processing correlations.'
5073 call mp_stopall(Error)
5074 endif ! msglen.eq.msglen1
5075 endif ! MyRank.lt.fgProcs-1
5082 write (iout,'(a)') 'Contact function values:'
5084 write (iout,'(2i3,50(1x,i2,f5.2))')
5085 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5086 & j=1,num_cont_hb(i))
5092 C Remove the loop below after debugging !!!
5099 C Calculate the dipole-dipole interaction energies
5100 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5101 do i=iatel_s,iatel_e+1
5102 num_conti=num_cont_hb(i)
5109 C Calculate the local-electrostatic correlation terms
5110 do i=iatel_s,iatel_e+1
5112 num_conti=num_cont_hb(i)
5113 num_conti1=num_cont_hb(i+1)
5118 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5119 c & ' jj=',jj,' kk=',kk
5120 if (j1.eq.j+1 .or. j1.eq.j-1) then
5121 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5122 C The system gains extra energy.
5124 sqd1=dsqrt(d_cont(jj,i))
5125 sqd2=dsqrt(d_cont(kk,i1))
5126 sred_geom = sqd1*sqd2
5127 IF (sred_geom.lt.cutoff_corr) THEN
5128 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5130 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5131 c & ' jj=',jj,' kk=',kk
5132 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5133 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5135 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5136 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5139 cd write (iout,*) 'sred_geom=',sred_geom,
5140 cd & ' ekont=',ekont,' fprim=',fprimcont
5141 call calc_eello(i,j,i+1,j1,jj,kk)
5142 if (wcorr4.gt.0.0d0)
5143 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5144 if (wcorr5.gt.0.0d0)
5145 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5146 c print *,"wcorr5",ecorr5
5147 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5148 cd write(2,*)'ijkl',i,j,i+1,j1
5149 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5150 & .or. wturn6.eq.0.0d0))then
5151 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5152 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5153 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5154 cd & 'ecorr6=',ecorr6
5155 cd write (iout,'(4e15.5)') sred_geom,
5156 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5157 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5158 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5159 else if (wturn6.gt.0.0d0
5160 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5161 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5162 eturn6=eturn6+eello_turn6(i,jj,kk)
5163 cd write (2,*) 'multibody_eello:eturn6',eturn6
5167 else if (j1.eq.j) then
5168 C Contacts I-J and I-(J+1) occur simultaneously.
5169 C The system loses extra energy.
5170 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5175 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5176 c & ' jj=',jj,' kk=',kk
5178 C Contacts I-J and (I+1)-J occur simultaneously.
5179 C The system loses extra energy.
5180 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5187 c------------------------------------------------------------------------------
5188 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5189 implicit real*8 (a-h,o-z)
5190 include 'DIMENSIONS'
5191 include 'COMMON.IOUNITS'
5192 include 'COMMON.DERIV'
5193 include 'COMMON.INTERACT'
5194 include 'COMMON.CONTACTS'
5195 double precision gx(3),gx1(3)
5205 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5206 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5207 C Following 4 lines for diagnostics.
5212 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5214 c write (iout,*)'Contacts have occurred for peptide groups',
5215 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5216 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5217 C Calculate the multi-body contribution to energy.
5218 ecorr=ecorr+ekont*ees
5220 C Calculate multi-body contributions to the gradient.
5222 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5223 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5224 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5225 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5226 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5227 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5228 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5229 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5230 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5231 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5232 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5233 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5234 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5235 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5239 gradcorr(ll,m)=gradcorr(ll,m)+
5240 & ees*ekl*gacont_hbr(ll,jj,i)-
5241 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5242 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5247 gradcorr(ll,m)=gradcorr(ll,m)+
5248 & ees*eij*gacont_hbr(ll,kk,k)-
5249 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5250 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5257 C---------------------------------------------------------------------------
5258 subroutine dipole(i,j,jj)
5259 implicit real*8 (a-h,o-z)
5260 include 'DIMENSIONS'
5261 include 'DIMENSIONS.ZSCOPT'
5262 include 'COMMON.IOUNITS'
5263 include 'COMMON.CHAIN'
5264 include 'COMMON.FFIELD'
5265 include 'COMMON.DERIV'
5266 include 'COMMON.INTERACT'
5267 include 'COMMON.CONTACTS'
5268 include 'COMMON.TORSION'
5269 include 'COMMON.VAR'
5270 include 'COMMON.GEO'
5271 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5273 iti1 = itortyp(itype(i+1))
5274 if (j.lt.nres-1) then
5275 itj1 = itortyp(itype(j+1))
5280 dipi(iii,1)=Ub2(iii,i)
5281 dipderi(iii)=Ub2der(iii,i)
5282 dipi(iii,2)=b1(iii,iti1)
5283 dipj(iii,1)=Ub2(iii,j)
5284 dipderj(iii)=Ub2der(iii,j)
5285 dipj(iii,2)=b1(iii,itj1)
5289 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5292 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5295 if (.not.calc_grad) return
5300 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5304 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5309 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5310 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5312 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5314 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5316 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5320 C---------------------------------------------------------------------------
5321 subroutine calc_eello(i,j,k,l,jj,kk)
5323 C This subroutine computes matrices and vectors needed to calculate
5324 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5326 implicit real*8 (a-h,o-z)
5327 include 'DIMENSIONS'
5328 include 'DIMENSIONS.ZSCOPT'
5329 include 'COMMON.IOUNITS'
5330 include 'COMMON.CHAIN'
5331 include 'COMMON.DERIV'
5332 include 'COMMON.INTERACT'
5333 include 'COMMON.CONTACTS'
5334 include 'COMMON.TORSION'
5335 include 'COMMON.VAR'
5336 include 'COMMON.GEO'
5337 include 'COMMON.FFIELD'
5338 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5339 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5342 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5343 cd & ' jj=',jj,' kk=',kk
5344 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5347 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5348 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5351 call transpose2(aa1(1,1),aa1t(1,1))
5352 call transpose2(aa2(1,1),aa2t(1,1))
5355 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5356 & aa1tder(1,1,lll,kkk))
5357 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5358 & aa2tder(1,1,lll,kkk))
5362 C parallel orientation of the two CA-CA-CA frames.
5364 iti=itortyp(itype(i))
5368 itk1=itortyp(itype(k+1))
5369 itj=itortyp(itype(j))
5370 if (l.lt.nres-1) then
5371 itl1=itortyp(itype(l+1))
5375 C A1 kernel(j+1) A2T
5377 cd write (iout,'(3f10.5,5x,3f10.5)')
5378 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
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.,EUg(1,1,l),EUgder(1,1,l),
5382 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5383 C Following matrices are needed only for 6-th order cumulants
5384 IF (wcorr6.gt.0.0d0) THEN
5385 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5386 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5387 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(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.,Ug2DtEUg(1,1,l),
5390 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5391 & ADtEAderx(1,1,1,1,1,1))
5393 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5394 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5395 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5396 & ADtEA1derx(1,1,1,1,1,1))
5398 C End 6-th order cumulants
5401 cd write (2,*) 'In calc_eello6'
5403 cd write (2,*) 'iii=',iii
5405 cd write (2,*) 'kkk=',kkk
5407 cd write (2,'(3(2f10.5),5x)')
5408 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5413 call transpose2(EUgder(1,1,k),auxmat(1,1))
5414 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5415 call transpose2(EUg(1,1,k),auxmat(1,1))
5416 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5417 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5421 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5422 & EAEAderx(1,1,lll,kkk,iii,1))
5426 C A1T kernel(i+1) A2
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.,EUg(1,1,k),EUgder(1,1,k),
5429 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5430 C Following matrices are needed only for 6-th order cumulants
5431 IF (wcorr6.gt.0.0d0) THEN
5432 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5433 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5434 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5435 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5436 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5437 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5438 & ADtEAderx(1,1,1,1,1,2))
5439 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5440 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5441 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5442 & ADtEA1derx(1,1,1,1,1,2))
5444 C End 6-th order cumulants
5445 call transpose2(EUgder(1,1,l),auxmat(1,1))
5446 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5447 call transpose2(EUg(1,1,l),auxmat(1,1))
5448 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5449 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5453 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5454 & EAEAderx(1,1,lll,kkk,iii,2))
5459 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5460 C They are needed only when the fifth- or the sixth-order cumulants are
5462 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5463 call transpose2(AEA(1,1,1),auxmat(1,1))
5464 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5465 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5466 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5467 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5468 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5469 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5470 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5471 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5472 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5473 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5474 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5475 call transpose2(AEA(1,1,2),auxmat(1,1))
5476 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5477 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5478 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5479 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5480 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5481 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5482 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5483 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5484 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5485 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5486 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5487 C Calculate the Cartesian derivatives of the vectors.
5491 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5492 call matvec2(auxmat(1,1),b1(1,iti),
5493 & AEAb1derx(1,lll,kkk,iii,1,1))
5494 call matvec2(auxmat(1,1),Ub2(1,i),
5495 & AEAb2derx(1,lll,kkk,iii,1,1))
5496 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5497 & AEAb1derx(1,lll,kkk,iii,2,1))
5498 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5499 & AEAb2derx(1,lll,kkk,iii,2,1))
5500 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5501 call matvec2(auxmat(1,1),b1(1,itj),
5502 & AEAb1derx(1,lll,kkk,iii,1,2))
5503 call matvec2(auxmat(1,1),Ub2(1,j),
5504 & AEAb2derx(1,lll,kkk,iii,1,2))
5505 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5506 & AEAb1derx(1,lll,kkk,iii,2,2))
5507 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5508 & AEAb2derx(1,lll,kkk,iii,2,2))
5515 C Antiparallel orientation of the two CA-CA-CA frames.
5517 iti=itortyp(itype(i))
5521 itk1=itortyp(itype(k+1))
5522 itl=itortyp(itype(l))
5523 itj=itortyp(itype(j))
5524 if (j.lt.nres-1) then
5525 itj1=itortyp(itype(j+1))
5529 C A2 kernel(j-1)T A1T
5530 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5531 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5532 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5533 C Following matrices are needed only for 6-th order cumulants
5534 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5535 & j.eq.i+4 .and. l.eq.i+3)) THEN
5536 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5537 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5538 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5539 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5540 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5541 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5542 & ADtEAderx(1,1,1,1,1,1))
5543 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5544 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5545 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5546 & ADtEA1derx(1,1,1,1,1,1))
5548 C End 6-th order cumulants
5549 call transpose2(EUgder(1,1,k),auxmat(1,1))
5550 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5551 call transpose2(EUg(1,1,k),auxmat(1,1))
5552 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5553 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5557 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5558 & EAEAderx(1,1,lll,kkk,iii,1))
5562 C A2T kernel(i+1)T A1
5563 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5564 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5565 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5566 C Following matrices are needed only for 6-th order cumulants
5567 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5568 & j.eq.i+4 .and. l.eq.i+3)) THEN
5569 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5570 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5571 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5572 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5573 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5574 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5575 & ADtEAderx(1,1,1,1,1,2))
5576 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5577 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5578 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5579 & ADtEA1derx(1,1,1,1,1,2))
5581 C End 6-th order cumulants
5582 call transpose2(EUgder(1,1,j),auxmat(1,1))
5583 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5584 call transpose2(EUg(1,1,j),auxmat(1,1))
5585 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5586 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5590 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5591 & EAEAderx(1,1,lll,kkk,iii,2))
5596 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5597 C They are needed only when the fifth- or the sixth-order cumulants are
5599 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5600 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5601 call transpose2(AEA(1,1,1),auxmat(1,1))
5602 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5603 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5604 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5605 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5606 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5607 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5608 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5609 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5610 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5611 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5612 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5613 call transpose2(AEA(1,1,2),auxmat(1,1))
5614 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5615 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5616 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5617 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5618 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5619 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5620 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5621 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5622 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5623 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5624 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5625 C Calculate the Cartesian derivatives of the vectors.
5629 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5630 call matvec2(auxmat(1,1),b1(1,iti),
5631 & AEAb1derx(1,lll,kkk,iii,1,1))
5632 call matvec2(auxmat(1,1),Ub2(1,i),
5633 & AEAb2derx(1,lll,kkk,iii,1,1))
5634 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5635 & AEAb1derx(1,lll,kkk,iii,2,1))
5636 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5637 & AEAb2derx(1,lll,kkk,iii,2,1))
5638 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5639 call matvec2(auxmat(1,1),b1(1,itl),
5640 & AEAb1derx(1,lll,kkk,iii,1,2))
5641 call matvec2(auxmat(1,1),Ub2(1,l),
5642 & AEAb2derx(1,lll,kkk,iii,1,2))
5643 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5644 & AEAb1derx(1,lll,kkk,iii,2,2))
5645 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5646 & AEAb2derx(1,lll,kkk,iii,2,2))
5655 C---------------------------------------------------------------------------
5656 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5657 & KK,KKderg,AKA,AKAderg,AKAderx)
5661 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5662 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5663 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5668 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5670 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5673 cd if (lprn) write (2,*) 'In kernel'
5675 cd if (lprn) write (2,*) 'kkk=',kkk
5677 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5678 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5680 cd write (2,*) 'lll=',lll
5681 cd write (2,*) 'iii=1'
5683 cd write (2,'(3(2f10.5),5x)')
5684 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5687 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5688 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5690 cd write (2,*) 'lll=',lll
5691 cd write (2,*) 'iii=2'
5693 cd write (2,'(3(2f10.5),5x)')
5694 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5701 C---------------------------------------------------------------------------
5702 double precision function eello4(i,j,k,l,jj,kk)
5703 implicit real*8 (a-h,o-z)
5704 include 'DIMENSIONS'
5705 include 'DIMENSIONS.ZSCOPT'
5706 include 'COMMON.IOUNITS'
5707 include 'COMMON.CHAIN'
5708 include 'COMMON.DERIV'
5709 include 'COMMON.INTERACT'
5710 include 'COMMON.CONTACTS'
5711 include 'COMMON.TORSION'
5712 include 'COMMON.VAR'
5713 include 'COMMON.GEO'
5714 double precision pizda(2,2),ggg1(3),ggg2(3)
5715 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5719 cd print *,'eello4:',i,j,k,l,jj,kk
5720 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5721 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5722 cold eij=facont_hb(jj,i)
5723 cold ekl=facont_hb(kk,k)
5725 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5727 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5728 gcorr_loc(k-1)=gcorr_loc(k-1)
5729 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5731 gcorr_loc(l-1)=gcorr_loc(l-1)
5732 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5734 gcorr_loc(j-1)=gcorr_loc(j-1)
5735 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5740 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5741 & -EAEAderx(2,2,lll,kkk,iii,1)
5742 cd derx(lll,kkk,iii)=0.0d0
5746 cd gcorr_loc(l-1)=0.0d0
5747 cd gcorr_loc(j-1)=0.0d0
5748 cd gcorr_loc(k-1)=0.0d0
5750 cd write (iout,*)'Contacts have occurred for peptide groups',
5751 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5752 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5753 if (j.lt.nres-1) then
5760 if (l.lt.nres-1) then
5768 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5769 ggg1(ll)=eel4*g_contij(ll,1)
5770 ggg2(ll)=eel4*g_contij(ll,2)
5771 ghalf=0.5d0*ggg1(ll)
5773 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5774 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5775 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5776 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5777 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5778 ghalf=0.5d0*ggg2(ll)
5780 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5781 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5782 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5783 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5788 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5789 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5794 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5795 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5801 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5806 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5810 cd write (2,*) iii,gcorr_loc(iii)
5814 cd write (2,*) 'ekont',ekont
5815 cd write (iout,*) 'eello4',ekont*eel4
5818 C---------------------------------------------------------------------------
5819 double precision function eello5(i,j,k,l,jj,kk)
5820 implicit real*8 (a-h,o-z)
5821 include 'DIMENSIONS'
5822 include 'DIMENSIONS.ZSCOPT'
5823 include 'COMMON.IOUNITS'
5824 include 'COMMON.CHAIN'
5825 include 'COMMON.DERIV'
5826 include 'COMMON.INTERACT'
5827 include 'COMMON.CONTACTS'
5828 include 'COMMON.TORSION'
5829 include 'COMMON.VAR'
5830 include 'COMMON.GEO'
5831 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5832 double precision ggg1(3),ggg2(3)
5833 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5838 C /l\ / \ \ / \ / \ / C
5839 C / \ / \ \ / \ / \ / C
5840 C j| o |l1 | o | o| o | | o |o C
5841 C \ |/k\| |/ \| / |/ \| |/ \| C
5842 C \i/ \ / \ / / \ / \ C
5844 C (I) (II) (III) (IV) C
5846 C eello5_1 eello5_2 eello5_3 eello5_4 C
5848 C Antiparallel chains C
5851 C /j\ / \ \ / \ / \ / C
5852 C / \ / \ \ / \ / \ / C
5853 C j1| o |l | o | o| o | | o |o C
5854 C \ |/k\| |/ \| / |/ \| |/ \| C
5855 C \i/ \ / \ / / \ / \ C
5857 C (I) (II) (III) (IV) C
5859 C eello5_1 eello5_2 eello5_3 eello5_4 C
5861 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5863 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5864 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5869 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5871 itk=itortyp(itype(k))
5872 itl=itortyp(itype(l))
5873 itj=itortyp(itype(j))
5878 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5879 cd & eel5_3_num,eel5_4_num)
5883 derx(lll,kkk,iii)=0.0d0
5887 cd eij=facont_hb(jj,i)
5888 cd ekl=facont_hb(kk,k)
5890 cd write (iout,*)'Contacts have occurred for peptide groups',
5891 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5893 C Contribution from the graph I.
5894 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5895 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5896 call transpose2(EUg(1,1,k),auxmat(1,1))
5897 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5898 vv(1)=pizda(1,1)-pizda(2,2)
5899 vv(2)=pizda(1,2)+pizda(2,1)
5900 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5901 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5903 C Explicit gradient in virtual-dihedral angles.
5904 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5905 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5906 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5907 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5908 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5909 vv(1)=pizda(1,1)-pizda(2,2)
5910 vv(2)=pizda(1,2)+pizda(2,1)
5911 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5912 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5913 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5914 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5915 vv(1)=pizda(1,1)-pizda(2,2)
5916 vv(2)=pizda(1,2)+pizda(2,1)
5918 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5919 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5920 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5922 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5923 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5926 C Cartesian gradient
5930 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5932 vv(1)=pizda(1,1)-pizda(2,2)
5933 vv(2)=pizda(1,2)+pizda(2,1)
5934 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5935 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5936 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5943 C Contribution from graph II
5944 call transpose2(EE(1,1,itk),auxmat(1,1))
5945 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5946 vv(1)=pizda(1,1)+pizda(2,2)
5947 vv(2)=pizda(2,1)-pizda(1,2)
5948 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5949 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5951 C Explicit gradient in virtual-dihedral angles.
5952 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5953 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5954 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5955 vv(1)=pizda(1,1)+pizda(2,2)
5956 vv(2)=pizda(2,1)-pizda(1,2)
5958 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5959 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5960 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5962 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5963 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5964 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5966 C Cartesian gradient
5970 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5972 vv(1)=pizda(1,1)+pizda(2,2)
5973 vv(2)=pizda(2,1)-pizda(1,2)
5974 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5975 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5976 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5985 C Parallel orientation
5986 C Contribution from graph III
5987 call transpose2(EUg(1,1,l),auxmat(1,1))
5988 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5989 vv(1)=pizda(1,1)-pizda(2,2)
5990 vv(2)=pizda(1,2)+pizda(2,1)
5991 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5992 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5994 C Explicit gradient in virtual-dihedral angles.
5995 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5996 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5997 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5998 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5999 vv(1)=pizda(1,1)-pizda(2,2)
6000 vv(2)=pizda(1,2)+pizda(2,1)
6001 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6002 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6003 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6004 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6005 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6006 vv(1)=pizda(1,1)-pizda(2,2)
6007 vv(2)=pizda(1,2)+pizda(2,1)
6008 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6009 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6010 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6011 C Cartesian gradient
6015 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6017 vv(1)=pizda(1,1)-pizda(2,2)
6018 vv(2)=pizda(1,2)+pizda(2,1)
6019 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6020 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6021 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6027 C Contribution from graph IV
6029 call transpose2(EE(1,1,itl),auxmat(1,1))
6030 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6031 vv(1)=pizda(1,1)+pizda(2,2)
6032 vv(2)=pizda(2,1)-pizda(1,2)
6033 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6034 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6036 C Explicit gradient in virtual-dihedral angles.
6037 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6038 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6039 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6040 vv(1)=pizda(1,1)+pizda(2,2)
6041 vv(2)=pizda(2,1)-pizda(1,2)
6042 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6043 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6044 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6045 C Cartesian gradient
6049 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6051 vv(1)=pizda(1,1)+pizda(2,2)
6052 vv(2)=pizda(2,1)-pizda(1,2)
6053 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6054 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6055 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6061 C Antiparallel orientation
6062 C Contribution from graph III
6064 call transpose2(EUg(1,1,j),auxmat(1,1))
6065 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6066 vv(1)=pizda(1,1)-pizda(2,2)
6067 vv(2)=pizda(1,2)+pizda(2,1)
6068 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6069 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6071 C Explicit gradient in virtual-dihedral angles.
6072 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6073 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6074 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6075 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6076 vv(1)=pizda(1,1)-pizda(2,2)
6077 vv(2)=pizda(1,2)+pizda(2,1)
6078 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6079 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6081 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6082 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6083 vv(1)=pizda(1,1)-pizda(2,2)
6084 vv(2)=pizda(1,2)+pizda(2,1)
6085 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6086 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6087 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6088 C Cartesian gradient
6092 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6094 vv(1)=pizda(1,1)-pizda(2,2)
6095 vv(2)=pizda(1,2)+pizda(2,1)
6096 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6097 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6098 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6104 C Contribution from graph IV
6106 call transpose2(EE(1,1,itj),auxmat(1,1))
6107 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6108 vv(1)=pizda(1,1)+pizda(2,2)
6109 vv(2)=pizda(2,1)-pizda(1,2)
6110 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6111 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6113 C Explicit gradient in virtual-dihedral angles.
6114 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6115 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6116 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6117 vv(1)=pizda(1,1)+pizda(2,2)
6118 vv(2)=pizda(2,1)-pizda(1,2)
6119 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6120 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6121 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6122 C Cartesian gradient
6126 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6128 vv(1)=pizda(1,1)+pizda(2,2)
6129 vv(2)=pizda(2,1)-pizda(1,2)
6130 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6131 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6132 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6139 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6140 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6141 cd write (2,*) 'ijkl',i,j,k,l
6142 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6143 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6145 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6146 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6147 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6148 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6150 if (j.lt.nres-1) then
6157 if (l.lt.nres-1) then
6167 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6169 ggg1(ll)=eel5*g_contij(ll,1)
6170 ggg2(ll)=eel5*g_contij(ll,2)
6171 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6172 ghalf=0.5d0*ggg1(ll)
6174 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6175 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6176 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6177 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6178 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6179 ghalf=0.5d0*ggg2(ll)
6181 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6182 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6183 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6184 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6189 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6190 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6195 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6196 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6202 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6207 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6211 cd write (2,*) iii,g_corr5_loc(iii)
6215 cd write (2,*) 'ekont',ekont
6216 cd write (iout,*) 'eello5',ekont*eel5
6219 c--------------------------------------------------------------------------
6220 double precision function eello6(i,j,k,l,jj,kk)
6221 implicit real*8 (a-h,o-z)
6222 include 'DIMENSIONS'
6223 include 'DIMENSIONS.ZSCOPT'
6224 include 'COMMON.IOUNITS'
6225 include 'COMMON.CHAIN'
6226 include 'COMMON.DERIV'
6227 include 'COMMON.INTERACT'
6228 include 'COMMON.CONTACTS'
6229 include 'COMMON.TORSION'
6230 include 'COMMON.VAR'
6231 include 'COMMON.GEO'
6232 include 'COMMON.FFIELD'
6233 double precision ggg1(3),ggg2(3)
6234 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6239 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6247 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6248 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6252 derx(lll,kkk,iii)=0.0d0
6256 cd eij=facont_hb(jj,i)
6257 cd ekl=facont_hb(kk,k)
6263 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6264 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6265 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6266 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6267 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6268 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6270 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6271 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6272 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6273 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6274 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6275 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6279 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6281 C If turn contributions are considered, they will be handled separately.
6282 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6283 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6284 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6285 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6286 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6287 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6288 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6291 if (j.lt.nres-1) then
6298 if (l.lt.nres-1) then
6306 ggg1(ll)=eel6*g_contij(ll,1)
6307 ggg2(ll)=eel6*g_contij(ll,2)
6308 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6309 ghalf=0.5d0*ggg1(ll)
6311 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6312 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6313 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6314 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6315 ghalf=0.5d0*ggg2(ll)
6316 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6318 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6319 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6320 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6321 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6326 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6327 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6332 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6333 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6339 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6344 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6348 cd write (2,*) iii,g_corr6_loc(iii)
6352 cd write (2,*) 'ekont',ekont
6353 cd write (iout,*) 'eello6',ekont*eel6
6356 c--------------------------------------------------------------------------
6357 double precision function eello6_graph1(i,j,k,l,imat,swap)
6358 implicit real*8 (a-h,o-z)
6359 include 'DIMENSIONS'
6360 include 'DIMENSIONS.ZSCOPT'
6361 include 'COMMON.IOUNITS'
6362 include 'COMMON.CHAIN'
6363 include 'COMMON.DERIV'
6364 include 'COMMON.INTERACT'
6365 include 'COMMON.CONTACTS'
6366 include 'COMMON.TORSION'
6367 include 'COMMON.VAR'
6368 include 'COMMON.GEO'
6369 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6375 C Parallel Antiparallel C
6381 C \ j|/k\| / \ |/k\|l / C
6386 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6387 itk=itortyp(itype(k))
6388 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6389 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6390 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6391 call transpose2(EUgC(1,1,k),auxmat(1,1))
6392 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6393 vv1(1)=pizda1(1,1)-pizda1(2,2)
6394 vv1(2)=pizda1(1,2)+pizda1(2,1)
6395 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6396 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6397 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6398 s5=scalar2(vv(1),Dtobr2(1,i))
6399 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6400 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6401 if (.not. calc_grad) return
6402 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6403 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6404 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6405 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6406 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6407 & +scalar2(vv(1),Dtobr2der(1,i)))
6408 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6409 vv1(1)=pizda1(1,1)-pizda1(2,2)
6410 vv1(2)=pizda1(1,2)+pizda1(2,1)
6411 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6412 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6414 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6415 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6416 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6417 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6418 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6420 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6421 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6422 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6423 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6424 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6426 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6427 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6428 vv1(1)=pizda1(1,1)-pizda1(2,2)
6429 vv1(2)=pizda1(1,2)+pizda1(2,1)
6430 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6431 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6432 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6433 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6442 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6443 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6444 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6445 call transpose2(EUgC(1,1,k),auxmat(1,1))
6446 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6448 vv1(1)=pizda1(1,1)-pizda1(2,2)
6449 vv1(2)=pizda1(1,2)+pizda1(2,1)
6450 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6451 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6452 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6453 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6454 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6455 s5=scalar2(vv(1),Dtobr2(1,i))
6456 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6462 c----------------------------------------------------------------------------
6463 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6464 implicit real*8 (a-h,o-z)
6465 include 'DIMENSIONS'
6466 include 'DIMENSIONS.ZSCOPT'
6467 include 'COMMON.IOUNITS'
6468 include 'COMMON.CHAIN'
6469 include 'COMMON.DERIV'
6470 include 'COMMON.INTERACT'
6471 include 'COMMON.CONTACTS'
6472 include 'COMMON.TORSION'
6473 include 'COMMON.VAR'
6474 include 'COMMON.GEO'
6476 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6477 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6480 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6482 C Parallel Antiparallel C
6488 C \ j|/k\| \ |/k\|l C
6493 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6494 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6495 C AL 7/4/01 s1 would occur in the sixth-order moment,
6496 C but not in a cluster cumulant
6498 s1=dip(1,jj,i)*dip(1,kk,k)
6500 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6501 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6502 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6503 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6504 call transpose2(EUg(1,1,k),auxmat(1,1))
6505 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6506 vv(1)=pizda(1,1)-pizda(2,2)
6507 vv(2)=pizda(1,2)+pizda(2,1)
6508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6509 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6511 eello6_graph2=-(s1+s2+s3+s4)
6513 eello6_graph2=-(s2+s3+s4)
6516 if (.not. calc_grad) return
6517 C Derivatives in gamma(i-1)
6520 s1=dipderg(1,jj,i)*dip(1,kk,k)
6522 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6523 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6524 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6525 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6527 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6531 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6533 C Derivatives in gamma(k-1)
6535 s1=dip(1,jj,i)*dipderg(1,kk,k)
6537 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6538 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6539 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6540 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6541 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6542 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6543 vv(1)=pizda(1,1)-pizda(2,2)
6544 vv(2)=pizda(1,2)+pizda(2,1)
6545 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6547 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6549 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6551 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6552 C Derivatives in gamma(j-1) or gamma(l-1)
6555 s1=dipderg(3,jj,i)*dip(1,kk,k)
6557 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6558 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6559 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6560 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6561 vv(1)=pizda(1,1)-pizda(2,2)
6562 vv(2)=pizda(1,2)+pizda(2,1)
6563 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6566 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6568 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6571 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6572 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6574 C Derivatives in gamma(l-1) or gamma(j-1)
6577 s1=dip(1,jj,i)*dipderg(3,kk,k)
6579 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6580 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6581 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6582 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6583 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6584 vv(1)=pizda(1,1)-pizda(2,2)
6585 vv(2)=pizda(1,2)+pizda(2,1)
6586 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6589 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6591 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6594 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6595 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6597 C Cartesian derivatives.
6599 write (2,*) 'In eello6_graph2'
6601 write (2,*) 'iii=',iii
6603 write (2,*) 'kkk=',kkk
6605 write (2,'(3(2f10.5),5x)')
6606 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6616 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6618 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6621 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6623 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6624 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6626 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6627 call transpose2(EUg(1,1,k),auxmat(1,1))
6628 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6630 vv(1)=pizda(1,1)-pizda(2,2)
6631 vv(2)=pizda(1,2)+pizda(2,1)
6632 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6633 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6635 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6637 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6649 c----------------------------------------------------------------------------
6650 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6651 implicit real*8 (a-h,o-z)
6652 include 'DIMENSIONS'
6653 include 'DIMENSIONS.ZSCOPT'
6654 include 'COMMON.IOUNITS'
6655 include 'COMMON.CHAIN'
6656 include 'COMMON.DERIV'
6657 include 'COMMON.INTERACT'
6658 include 'COMMON.CONTACTS'
6659 include 'COMMON.TORSION'
6660 include 'COMMON.VAR'
6661 include 'COMMON.GEO'
6662 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6666 C Parallel Antiparallel C
6672 C j|/k\| / |/k\|l / C
6677 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6679 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6680 C energy moment and not to the cluster cumulant.
6681 iti=itortyp(itype(i))
6682 if (j.lt.nres-1) then
6683 itj1=itortyp(itype(j+1))
6687 itk=itortyp(itype(k))
6688 itk1=itortyp(itype(k+1))
6689 if (l.lt.nres-1) then
6690 itl1=itortyp(itype(l+1))
6695 s1=dip(4,jj,i)*dip(4,kk,k)
6697 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6698 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6699 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6700 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6701 call transpose2(EE(1,1,itk),auxmat(1,1))
6702 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6703 vv(1)=pizda(1,1)+pizda(2,2)
6704 vv(2)=pizda(2,1)-pizda(1,2)
6705 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6706 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6708 eello6_graph3=-(s1+s2+s3+s4)
6710 eello6_graph3=-(s2+s3+s4)
6713 if (.not. calc_grad) return
6714 C Derivatives in gamma(k-1)
6715 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6716 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6717 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6718 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6719 C Derivatives in gamma(l-1)
6720 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6721 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6722 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6723 vv(1)=pizda(1,1)+pizda(2,2)
6724 vv(2)=pizda(2,1)-pizda(1,2)
6725 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6726 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6727 C Cartesian derivatives.
6733 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6735 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6738 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6740 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6741 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6743 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6744 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6746 vv(1)=pizda(1,1)+pizda(2,2)
6747 vv(2)=pizda(2,1)-pizda(1,2)
6748 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6750 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6752 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6755 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6757 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6759 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6765 c----------------------------------------------------------------------------
6766 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6767 implicit real*8 (a-h,o-z)
6768 include 'DIMENSIONS'
6769 include 'DIMENSIONS.ZSCOPT'
6770 include 'COMMON.IOUNITS'
6771 include 'COMMON.CHAIN'
6772 include 'COMMON.DERIV'
6773 include 'COMMON.INTERACT'
6774 include 'COMMON.CONTACTS'
6775 include 'COMMON.TORSION'
6776 include 'COMMON.VAR'
6777 include 'COMMON.GEO'
6778 include 'COMMON.FFIELD'
6779 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6780 & auxvec1(2),auxmat1(2,2)
6782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6784 C Parallel Antiparallel C
6790 C \ j|/k\| \ |/k\|l C
6795 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6797 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6798 C energy moment and not to the cluster cumulant.
6799 cd write (2,*) 'eello_graph4: wturn6',wturn6
6800 iti=itortyp(itype(i))
6801 itj=itortyp(itype(j))
6802 if (j.lt.nres-1) then
6803 itj1=itortyp(itype(j+1))
6807 itk=itortyp(itype(k))
6808 if (k.lt.nres-1) then
6809 itk1=itortyp(itype(k+1))
6813 itl=itortyp(itype(l))
6814 if (l.lt.nres-1) then
6815 itl1=itortyp(itype(l+1))
6819 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6820 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6821 cd & ' itl',itl,' itl1',itl1
6824 s1=dip(3,jj,i)*dip(3,kk,k)
6826 s1=dip(2,jj,j)*dip(2,kk,l)
6829 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6830 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6832 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6833 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6835 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6836 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6838 call transpose2(EUg(1,1,k),auxmat(1,1))
6839 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6840 vv(1)=pizda(1,1)-pizda(2,2)
6841 vv(2)=pizda(2,1)+pizda(1,2)
6842 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6843 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6845 eello6_graph4=-(s1+s2+s3+s4)
6847 eello6_graph4=-(s2+s3+s4)
6849 if (.not. calc_grad) return
6850 C Derivatives in gamma(i-1)
6854 s1=dipderg(2,jj,i)*dip(3,kk,k)
6856 s1=dipderg(4,jj,j)*dip(2,kk,l)
6859 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6861 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6862 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6864 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6865 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6867 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6868 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6869 cd write (2,*) 'turn6 derivatives'
6871 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6873 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6877 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6879 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6883 C Derivatives in gamma(k-1)
6886 s1=dip(3,jj,i)*dipderg(2,kk,k)
6888 s1=dip(2,jj,j)*dipderg(4,kk,l)
6891 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6892 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6894 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6895 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6897 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6898 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6900 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6901 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6902 vv(1)=pizda(1,1)-pizda(2,2)
6903 vv(2)=pizda(2,1)+pizda(1,2)
6904 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6905 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6907 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6909 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6913 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6915 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6918 C Derivatives in gamma(j-1) or gamma(l-1)
6919 if (l.eq.j+1 .and. l.gt.1) then
6920 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6921 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6922 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6923 vv(1)=pizda(1,1)-pizda(2,2)
6924 vv(2)=pizda(2,1)+pizda(1,2)
6925 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6926 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6927 else if (j.gt.1) then
6928 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6929 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6930 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6931 vv(1)=pizda(1,1)-pizda(2,2)
6932 vv(2)=pizda(2,1)+pizda(1,2)
6933 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6934 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6935 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6937 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6940 C Cartesian derivatives.
6947 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6949 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6953 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6955 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6959 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6961 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6963 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6964 & b1(1,itj1),auxvec(1))
6965 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6967 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6968 & b1(1,itl1),auxvec(1))
6969 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6971 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6973 vv(1)=pizda(1,1)-pizda(2,2)
6974 vv(2)=pizda(2,1)+pizda(1,2)
6975 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6977 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6979 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6982 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6985 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6988 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6990 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6992 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6996 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6998 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7001 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7003 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7011 c----------------------------------------------------------------------------
7012 double precision function eello_turn6(i,jj,kk)
7013 implicit real*8 (a-h,o-z)
7014 include 'DIMENSIONS'
7015 include 'DIMENSIONS.ZSCOPT'
7016 include 'COMMON.IOUNITS'
7017 include 'COMMON.CHAIN'
7018 include 'COMMON.DERIV'
7019 include 'COMMON.INTERACT'
7020 include 'COMMON.CONTACTS'
7021 include 'COMMON.TORSION'
7022 include 'COMMON.VAR'
7023 include 'COMMON.GEO'
7024 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7025 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7027 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7028 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7029 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7030 C the respective energy moment and not to the cluster cumulant.
7035 iti=itortyp(itype(i))
7036 itk=itortyp(itype(k))
7037 itk1=itortyp(itype(k+1))
7038 itl=itortyp(itype(l))
7039 itj=itortyp(itype(j))
7040 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7041 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7042 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7047 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7049 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7053 derx_turn(lll,kkk,iii)=0.0d0
7060 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7062 cd write (2,*) 'eello6_5',eello6_5
7064 call transpose2(AEA(1,1,1),auxmat(1,1))
7065 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7066 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7067 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7071 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7072 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7073 s2 = scalar2(b1(1,itk),vtemp1(1))
7075 call transpose2(AEA(1,1,2),atemp(1,1))
7076 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7077 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7078 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7082 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7083 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7084 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7086 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7087 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7088 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7089 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7090 ss13 = scalar2(b1(1,itk),vtemp4(1))
7091 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7095 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7101 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7103 C Derivatives in gamma(i+2)
7105 call transpose2(AEA(1,1,1),auxmatd(1,1))
7106 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7107 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7108 call transpose2(AEAderg(1,1,2),atempd(1,1))
7109 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7110 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7114 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7115 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7116 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7122 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7123 C Derivatives in gamma(i+3)
7125 call transpose2(AEA(1,1,1),auxmatd(1,1))
7126 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7127 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7128 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7132 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7133 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7134 s2d = scalar2(b1(1,itk),vtemp1d(1))
7136 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7137 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7139 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7141 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7142 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7143 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7153 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7154 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7156 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7157 & -0.5d0*ekont*(s2d+s12d)
7159 C Derivatives in gamma(i+4)
7160 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7161 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7162 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7164 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7165 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7166 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7176 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7178 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7180 C Derivatives in gamma(i+5)
7182 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7183 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7184 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7188 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7189 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7190 s2d = scalar2(b1(1,itk),vtemp1d(1))
7192 call transpose2(AEA(1,1,2),atempd(1,1))
7193 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7194 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7198 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7199 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7201 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7202 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7203 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7213 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7214 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7216 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7217 & -0.5d0*ekont*(s2d+s12d)
7219 C Cartesian derivatives
7224 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7225 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7226 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7230 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7231 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7233 s2d = scalar2(b1(1,itk),vtemp1d(1))
7235 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7236 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7237 s8d = -(atempd(1,1)+atempd(2,2))*
7238 & scalar2(cc(1,1,itl),vtemp2(1))
7242 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7244 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7245 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7252 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7255 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7259 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7260 & - 0.5d0*(s8d+s12d)
7262 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7271 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7273 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7274 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7275 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7276 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7277 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7279 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7280 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7281 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7285 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7286 cd & 16*eel_turn6_num
7288 if (j.lt.nres-1) then
7295 if (l.lt.nres-1) then
7303 ggg1(ll)=eel_turn6*g_contij(ll,1)
7304 ggg2(ll)=eel_turn6*g_contij(ll,2)
7305 ghalf=0.5d0*ggg1(ll)
7307 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7308 & +ekont*derx_turn(ll,2,1)
7309 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7310 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7311 & +ekont*derx_turn(ll,4,1)
7312 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7313 ghalf=0.5d0*ggg2(ll)
7315 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7316 & +ekont*derx_turn(ll,2,2)
7317 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7318 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7319 & +ekont*derx_turn(ll,4,2)
7320 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7325 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7330 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7336 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7341 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7345 cd write (2,*) iii,g_corr6_loc(iii)
7348 eello_turn6=ekont*eel_turn6
7349 cd write (2,*) 'ekont',ekont
7350 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7353 crc-------------------------------------------------
7354 SUBROUTINE MATVEC2(A1,V1,V2)
7355 implicit real*8 (a-h,o-z)
7356 include 'DIMENSIONS'
7357 DIMENSION A1(2,2),V1(2),V2(2)
7361 c 3 VI=VI+A1(I,K)*V1(K)
7365 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7366 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7371 C---------------------------------------
7372 SUBROUTINE MATMAT2(A1,A2,A3)
7373 implicit real*8 (a-h,o-z)
7374 include 'DIMENSIONS'
7375 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7376 c DIMENSION AI3(2,2)
7380 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7386 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7387 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7388 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7389 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7397 c-------------------------------------------------------------------------
7398 double precision function scalar2(u,v)
7400 double precision u(2),v(2)
7403 scalar2=u(1)*v(1)+u(2)*v(2)
7407 C-----------------------------------------------------------------------------
7409 subroutine transpose2(a,at)
7411 double precision a(2,2),at(2,2)
7418 c--------------------------------------------------------------------------
7419 subroutine transpose(n,a,at)
7422 double precision a(n,n),at(n,n)
7430 C---------------------------------------------------------------------------
7431 subroutine prodmat3(a1,a2,kk,transp,prod)
7434 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7436 crc double precision auxmat(2,2),prod_(2,2)
7439 crc call transpose2(kk(1,1),auxmat(1,1))
7440 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7441 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7443 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7444 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7445 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7446 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7447 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7448 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7449 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7450 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7453 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7454 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7456 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7457 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7458 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7459 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7460 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7461 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7462 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7463 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7466 c call transpose2(a2(1,1),a2t(1,1))
7469 crc print *,((prod_(i,j),i=1,2),j=1,2)
7470 crc print *,((prod(i,j),i=1,2),j=1,2)
7474 C-----------------------------------------------------------------------------
7475 double precision function scalar(u,v)
7477 double precision u(3),v(3)