1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 & +wsccor*fact(1)*gsccor_loc(i)
236 C------------------------------------------------------------------------
237 subroutine enerprint(energia,fact)
238 implicit real*8 (a-h,o-z)
240 include 'DIMENSIONS.ZSCOPT'
241 include 'COMMON.IOUNITS'
242 include 'COMMON.FFIELD'
243 include 'COMMON.SBRIDGE'
244 double precision energia(0:max_ene),fact(6)
246 evdw=energia(1)+fact(6)*energia(21)
248 evdw2=energia(2)+energia(17)
260 eello_turn3=energia(8)
261 eello_turn4=energia(9)
262 eello_turn6=energia(10)
269 edihcnstr=energia(20)
272 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
274 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
275 & etors_d,wtor_d*fact(2),ehpb,wstrain,
276 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
277 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
278 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
279 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
280 10 format (/'Virtual-chain energies:'//
281 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
282 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
283 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
284 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
285 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
286 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
287 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
288 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
289 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
290 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
291 & ' (SS bridges & dist. cnstr.)'/
292 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
296 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
297 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
298 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
299 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
300 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
301 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
302 & 'ETOT= ',1pE16.6,' (total)')
304 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
305 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
306 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
307 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
308 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
309 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
310 & edihcnstr,ebr*nss,etot
311 10 format (/'Virtual-chain energies:'//
312 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
313 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
314 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
315 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
316 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
317 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
318 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
319 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
320 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
321 & ' (SS bridges & dist. cnstr.)'/
322 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
326 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
327 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
328 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
329 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
330 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
331 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
332 & 'ETOT= ',1pE16.6,' (total)')
336 C-----------------------------------------------------------------------
337 subroutine elj(evdw,evdw_t)
339 C This subroutine calculates the interaction energy of nonbonded side chains
340 C assuming the LJ potential of interaction.
342 implicit real*8 (a-h,o-z)
344 include 'DIMENSIONS.ZSCOPT'
345 include "DIMENSIONS.COMPAR"
346 parameter (accur=1.0d-10)
349 include 'COMMON.LOCAL'
350 include 'COMMON.CHAIN'
351 include 'COMMON.DERIV'
352 include 'COMMON.INTERACT'
353 include 'COMMON.TORSION'
354 include 'COMMON.ENEPS'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
365 eneps_temp(j,i)=0.0d0
379 C Calculate SC interaction energy.
382 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
383 cd & 'iend=',iend(i,iint)
384 do j=istart(i,iint),iend(i,iint)
389 C Change 12/1/95 to calculate four-body interactions
390 rij=xj*xj+yj*yj+zj*zj
392 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
393 eps0ij=eps(itypi,itypj)
395 e1=fac*fac*aa(itypi,itypj)
396 e2=fac*bb(itypi,itypj)
398 ij=icant(itypi,itypj)
399 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
400 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
401 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
402 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
403 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
404 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
405 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
406 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
407 if (bb(itypi,itypj).gt.0.0d0) then
414 C Calculate the components of the gradient in DC and X
416 fac=-rrij*(e1+evdwij)
421 gvdwx(k,i)=gvdwx(k,i)-gg(k)
422 gvdwx(k,j)=gvdwx(k,j)+gg(k)
426 gvdwc(l,k)=gvdwc(l,k)+gg(l)
431 C 12/1/95, revised on 5/20/97
433 C Calculate the contact function. The ith column of the array JCONT will
434 C contain the numbers of atoms that make contacts with the atom I (of numbers
435 C greater than I). The arrays FACONT and GACONT will contain the values of
436 C the contact function and its derivative.
438 C Uncomment next line, if the correlation interactions include EVDW explicitly.
439 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
440 C Uncomment next line, if the correlation interactions are contact function only
441 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
443 sigij=sigma(itypi,itypj)
444 r0ij=rs0(itypi,itypj)
446 C Check whether the SC's are not too far to make a contact.
449 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
450 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
452 if (fcont.gt.0.0D0) then
453 C If the SC-SC distance if close to sigma, apply spline.
454 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
455 cAdam & fcont1,fprimcont1)
456 cAdam fcont1=1.0d0-fcont1
457 cAdam if (fcont1.gt.0.0d0) then
458 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
459 cAdam fcont=fcont*fcont1
461 C Uncomment following 4 lines to have the geometric average of the epsilon0's
462 cga eps0ij=1.0d0/dsqrt(eps0ij)
464 cga gg(k)=gg(k)*eps0ij
466 cga eps0ij=-evdwij*eps0ij
467 C Uncomment for AL's type of SC correlation interactions.
469 num_conti=num_conti+1
471 facont(num_conti,i)=fcont*eps0ij
472 fprimcont=eps0ij*fprimcont/rij
474 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
475 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
476 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
477 C Uncomment following 3 lines for Skolnick's type of SC correlation.
478 gacont(1,num_conti,i)=-fprimcont*xj
479 gacont(2,num_conti,i)=-fprimcont*yj
480 gacont(3,num_conti,i)=-fprimcont*zj
481 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
482 cd write (iout,'(2i3,3f10.5)')
483 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
489 num_cont(i)=num_conti
494 gvdwc(j,i)=expon*gvdwc(j,i)
495 gvdwx(j,i)=expon*gvdwx(j,i)
499 C******************************************************************************
503 C To save time, the factor of EXPON has been extracted from ALL components
504 C of GVDWC and GRADX. Remember to multiply them by this factor before further
507 C******************************************************************************
510 C-----------------------------------------------------------------------------
511 subroutine eljk(evdw,evdw_t)
513 C This subroutine calculates the interaction energy of nonbonded side chains
514 C assuming the LJK potential of interaction.
516 implicit real*8 (a-h,o-z)
518 include 'DIMENSIONS.ZSCOPT'
519 include "DIMENSIONS.COMPAR"
522 include 'COMMON.LOCAL'
523 include 'COMMON.CHAIN'
524 include 'COMMON.DERIV'
525 include 'COMMON.INTERACT'
526 include 'COMMON.ENEPS'
527 include 'COMMON.IOUNITS'
528 include 'COMMON.NAMES'
533 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
536 eneps_temp(j,i)=0.0d0
548 C Calculate SC interaction energy.
551 do j=istart(i,iint),iend(i,iint)
556 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
558 e_augm=augm(itypi,itypj)*fac_augm
561 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
562 fac=r_shift_inv**expon
563 e1=fac*fac*aa(itypi,itypj)
564 e2=fac*bb(itypi,itypj)
566 ij=icant(itypi,itypj)
567 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
568 & /dabs(eps(itypi,itypj))
569 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
570 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
571 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
572 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
573 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
574 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
575 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
576 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
577 if (bb(itypi,itypj).gt.0.0d0) then
584 C Calculate the components of the gradient in DC and X
586 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
591 gvdwx(k,i)=gvdwx(k,i)-gg(k)
592 gvdwx(k,j)=gvdwx(k,j)+gg(k)
596 gvdwc(l,k)=gvdwc(l,k)+gg(l)
606 gvdwc(j,i)=expon*gvdwc(j,i)
607 gvdwx(j,i)=expon*gvdwx(j,i)
613 C-----------------------------------------------------------------------------
614 subroutine ebp(evdw,evdw_t)
616 C This subroutine calculates the interaction energy of nonbonded side chains
617 C assuming the Berne-Pechukas potential of interaction.
619 implicit real*8 (a-h,o-z)
621 include 'DIMENSIONS.ZSCOPT'
622 include "DIMENSIONS.COMPAR"
625 include 'COMMON.LOCAL'
626 include 'COMMON.CHAIN'
627 include 'COMMON.DERIV'
628 include 'COMMON.NAMES'
629 include 'COMMON.INTERACT'
630 include 'COMMON.ENEPS'
631 include 'COMMON.IOUNITS'
632 include 'COMMON.CALC'
634 c double precision rrsave(maxdim)
640 eneps_temp(j,i)=0.0d0
645 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
646 c if (icall.eq.0) then
658 dxi=dc_norm(1,nres+i)
659 dyi=dc_norm(2,nres+i)
660 dzi=dc_norm(3,nres+i)
661 dsci_inv=vbld_inv(i+nres)
663 C Calculate SC interaction energy.
666 do j=istart(i,iint),iend(i,iint)
669 dscj_inv=vbld_inv(j+nres)
670 chi1=chi(itypi,itypj)
671 chi2=chi(itypj,itypi)
678 alf12=0.5D0*(alf1+alf2)
679 C For diagnostics only!!!
692 dxj=dc_norm(1,nres+j)
693 dyj=dc_norm(2,nres+j)
694 dzj=dc_norm(3,nres+j)
695 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
696 cd if (icall.eq.0) then
702 C Calculate the angle-dependent terms of energy & contributions to derivatives.
704 C Calculate whole angle-dependent part of epsilon and contributions
706 fac=(rrij*sigsq)**expon2
707 e1=fac*fac*aa(itypi,itypj)
708 e2=fac*bb(itypi,itypj)
709 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
710 eps2der=evdwij*eps3rt
711 eps3der=evdwij*eps2rt
712 evdwij=evdwij*eps2rt*eps3rt
713 ij=icant(itypi,itypj)
714 aux=eps1*eps2rt**2*eps3rt**2
715 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
716 & /dabs(eps(itypi,itypj))
717 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
718 if (bb(itypi,itypj).gt.0.0d0) then
725 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
726 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
727 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
728 cd & restyp(itypi),i,restyp(itypj),j,
729 cd & epsi,sigm,chi1,chi2,chip1,chip2,
730 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
731 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
734 C Calculate gradient components.
735 e1=e1*eps1*eps2rt**2*eps3rt**2
736 fac=-expon*(e1+evdwij)
739 C Calculate radial part of the gradient
743 C Calculate the angular part of the gradient and sum add the contributions
744 C to the appropriate components of the Cartesian gradient.
753 C-----------------------------------------------------------------------------
754 subroutine egb(evdw,evdw_t)
756 C This subroutine calculates the interaction energy of nonbonded side chains
757 C assuming the Gay-Berne potential of interaction.
759 implicit real*8 (a-h,o-z)
761 include 'DIMENSIONS.ZSCOPT'
762 include "DIMENSIONS.COMPAR"
765 include 'COMMON.LOCAL'
766 include 'COMMON.CHAIN'
767 include 'COMMON.DERIV'
768 include 'COMMON.NAMES'
769 include 'COMMON.INTERACT'
770 include 'COMMON.ENEPS'
771 include 'COMMON.IOUNITS'
772 include 'COMMON.CALC'
779 eneps_temp(j,i)=0.0d0
782 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
786 c if (icall.gt.0) lprn=.true.
794 dxi=dc_norm(1,nres+i)
795 dyi=dc_norm(2,nres+i)
796 dzi=dc_norm(3,nres+i)
797 dsci_inv=vbld_inv(i+nres)
799 C Calculate SC interaction energy.
802 do j=istart(i,iint),iend(i,iint)
805 dscj_inv=vbld_inv(j+nres)
806 sig0ij=sigma(itypi,itypj)
807 chi1=chi(itypi,itypj)
808 chi2=chi(itypj,itypi)
815 alf12=0.5D0*(alf1+alf2)
816 C For diagnostics only!!!
829 dxj=dc_norm(1,nres+j)
830 dyj=dc_norm(2,nres+j)
831 dzj=dc_norm(3,nres+j)
832 c write (iout,*) i,j,xj,yj,zj
833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
835 C Calculate angle-dependent terms of energy and contributions to their
839 sig=sig0ij*dsqrt(sigsq)
840 rij_shift=1.0D0/rij-sig+sig0ij
841 C I hate to put IF's in the loops, but here don't have another choice!!!!
842 if (rij_shift.le.0.0D0) then
847 c---------------------------------------------------------------
848 rij_shift=1.0D0/rij_shift
850 e1=fac*fac*aa(itypi,itypj)
851 e2=fac*bb(itypi,itypj)
852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
853 eps2der=evdwij*eps3rt
854 eps3der=evdwij*eps2rt
855 evdwij=evdwij*eps2rt*eps3rt
856 if (bb(itypi,itypj).gt.0) then
861 ij=icant(itypi,itypj)
862 aux=eps1*eps2rt**2*eps3rt**2
863 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
864 & /dabs(eps(itypi,itypj))
865 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
866 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
867 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
868 c & aux*e2/eps(itypi,itypj)
870 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
871 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
872 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
873 & restyp(itypi),i,restyp(itypj),j,
874 & epsi,sigm,chi1,chi2,chip1,chip2,
875 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
876 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
880 C Calculate gradient components.
881 e1=e1*eps1*eps2rt**2*eps3rt**2
882 fac=-expon*(e1+evdwij)*rij_shift
885 C Calculate the radial part of the gradient
889 C Calculate angular part of the gradient.
897 C-----------------------------------------------------------------------------
898 subroutine egbv(evdw,evdw_t)
900 C This subroutine calculates the interaction energy of nonbonded side chains
901 C assuming the Gay-Berne-Vorobjev potential of interaction.
903 implicit real*8 (a-h,o-z)
905 include 'DIMENSIONS.ZSCOPT'
906 include "DIMENSIONS.COMPAR"
909 include 'COMMON.LOCAL'
910 include 'COMMON.CHAIN'
911 include 'COMMON.DERIV'
912 include 'COMMON.NAMES'
913 include 'COMMON.INTERACT'
914 include 'COMMON.ENEPS'
915 include 'COMMON.IOUNITS'
916 include 'COMMON.CALC'
923 eneps_temp(j,i)=0.0d0
928 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
931 c if (icall.gt.0) lprn=.true.
939 dxi=dc_norm(1,nres+i)
940 dyi=dc_norm(2,nres+i)
941 dzi=dc_norm(3,nres+i)
942 dsci_inv=vbld_inv(i+nres)
944 C Calculate SC interaction energy.
947 do j=istart(i,iint),iend(i,iint)
950 dscj_inv=vbld_inv(j+nres)
951 sig0ij=sigma(itypi,itypj)
953 chi1=chi(itypi,itypj)
954 chi2=chi(itypj,itypi)
961 alf12=0.5D0*(alf1+alf2)
962 C For diagnostics only!!!
975 dxj=dc_norm(1,nres+j)
976 dyj=dc_norm(2,nres+j)
977 dzj=dc_norm(3,nres+j)
978 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
980 C Calculate angle-dependent terms of energy and contributions to their
984 sig=sig0ij*dsqrt(sigsq)
985 rij_shift=1.0D0/rij-sig+r0ij
986 C I hate to put IF's in the loops, but here don't have another choice!!!!
987 if (rij_shift.le.0.0D0) then
992 c---------------------------------------------------------------
993 rij_shift=1.0D0/rij_shift
995 e1=fac*fac*aa(itypi,itypj)
996 e2=fac*bb(itypi,itypj)
997 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
998 eps2der=evdwij*eps3rt
999 eps3der=evdwij*eps2rt
1000 fac_augm=rrij**expon
1001 e_augm=augm(itypi,itypj)*fac_augm
1002 evdwij=evdwij*eps2rt*eps3rt
1003 if (bb(itypi,itypj).gt.0.0d0) then
1004 evdw=evdw+evdwij+e_augm
1006 evdw_t=evdw_t+evdwij+e_augm
1008 ij=icant(itypi,itypj)
1009 aux=eps1*eps2rt**2*eps3rt**2
1010 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1011 & /dabs(eps(itypi,itypj))
1012 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1013 c eneps_temp(ij)=eneps_temp(ij)
1014 c & +(evdwij+e_augm)/eps(itypi,itypj)
1016 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1017 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1018 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1019 c & restyp(itypi),i,restyp(itypj),j,
1020 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1021 c & chi1,chi2,chip1,chip2,
1022 c & eps1,eps2rt**2,eps3rt**2,
1023 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1027 C Calculate gradient components.
1028 e1=e1*eps1*eps2rt**2*eps3rt**2
1029 fac=-expon*(e1+evdwij)*rij_shift
1031 fac=rij*fac-2*expon*rrij*e_augm
1032 C Calculate the radial part of the gradient
1036 C Calculate angular part of the gradient.
1044 C-----------------------------------------------------------------------------
1045 subroutine sc_angular
1046 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1047 C om12. Called by ebp, egb, and egbv.
1049 include 'COMMON.CALC'
1053 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1054 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1055 om12=dxi*dxj+dyi*dyj+dzi*dzj
1057 C Calculate eps1(om12) and its derivative in om12
1058 faceps1=1.0D0-om12*chiom12
1059 faceps1_inv=1.0D0/faceps1
1060 eps1=dsqrt(faceps1_inv)
1061 C Following variable is eps1*deps1/dom12
1062 eps1_om12=faceps1_inv*chiom12
1063 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1068 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1069 sigsq=1.0D0-facsig*faceps1_inv
1070 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1071 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1072 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1073 C Calculate eps2 and its derivatives in om1, om2, and om12.
1076 chipom12=chip12*om12
1077 facp=1.0D0-om12*chipom12
1079 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1080 C Following variable is the square root of eps2
1081 eps2rt=1.0D0-facp1*facp_inv
1082 C Following three variables are the derivatives of the square root of eps
1083 C in om1, om2, and om12.
1084 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1085 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1086 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1087 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1088 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1089 C Calculate whole angle-dependent part of epsilon and contributions
1090 C to its derivatives
1093 C----------------------------------------------------------------------------
1095 implicit real*8 (a-h,o-z)
1096 include 'DIMENSIONS'
1097 include 'DIMENSIONS.ZSCOPT'
1098 include 'COMMON.CHAIN'
1099 include 'COMMON.DERIV'
1100 include 'COMMON.CALC'
1101 double precision dcosom1(3),dcosom2(3)
1102 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1103 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1104 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1105 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1107 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1108 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1111 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1114 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1115 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1116 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1117 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1118 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1119 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1122 C Calculate the components of the gradient in DC and X
1126 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1131 c------------------------------------------------------------------------------
1132 subroutine vec_and_deriv
1133 implicit real*8 (a-h,o-z)
1134 include 'DIMENSIONS'
1135 include 'DIMENSIONS.ZSCOPT'
1136 include 'COMMON.IOUNITS'
1137 include 'COMMON.GEO'
1138 include 'COMMON.VAR'
1139 include 'COMMON.LOCAL'
1140 include 'COMMON.CHAIN'
1141 include 'COMMON.VECTORS'
1142 include 'COMMON.DERIV'
1143 include 'COMMON.INTERACT'
1144 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1145 C Compute the local reference systems. For reference system (i), the
1146 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1147 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1149 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1150 if (i.eq.nres-1) then
1151 C Case of the last full residue
1152 C Compute the Z-axis
1153 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1154 costh=dcos(pi-theta(nres))
1155 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1160 C Compute the derivatives of uz
1162 uzder(2,1,1)=-dc_norm(3,i-1)
1163 uzder(3,1,1)= dc_norm(2,i-1)
1164 uzder(1,2,1)= dc_norm(3,i-1)
1166 uzder(3,2,1)=-dc_norm(1,i-1)
1167 uzder(1,3,1)=-dc_norm(2,i-1)
1168 uzder(2,3,1)= dc_norm(1,i-1)
1171 uzder(2,1,2)= dc_norm(3,i)
1172 uzder(3,1,2)=-dc_norm(2,i)
1173 uzder(1,2,2)=-dc_norm(3,i)
1175 uzder(3,2,2)= dc_norm(1,i)
1176 uzder(1,3,2)= dc_norm(2,i)
1177 uzder(2,3,2)=-dc_norm(1,i)
1180 C Compute the Y-axis
1183 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1186 C Compute the derivatives of uy
1189 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1190 & -dc_norm(k,i)*dc_norm(j,i-1)
1191 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1193 uyder(j,j,1)=uyder(j,j,1)-costh
1194 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1199 uygrad(l,k,j,i)=uyder(l,k,j)
1200 uzgrad(l,k,j,i)=uzder(l,k,j)
1204 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1205 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1206 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1207 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1211 C Compute the Z-axis
1212 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1213 costh=dcos(pi-theta(i+2))
1214 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1219 C Compute the derivatives of uz
1221 uzder(2,1,1)=-dc_norm(3,i+1)
1222 uzder(3,1,1)= dc_norm(2,i+1)
1223 uzder(1,2,1)= dc_norm(3,i+1)
1225 uzder(3,2,1)=-dc_norm(1,i+1)
1226 uzder(1,3,1)=-dc_norm(2,i+1)
1227 uzder(2,3,1)= dc_norm(1,i+1)
1230 uzder(2,1,2)= dc_norm(3,i)
1231 uzder(3,1,2)=-dc_norm(2,i)
1232 uzder(1,2,2)=-dc_norm(3,i)
1234 uzder(3,2,2)= dc_norm(1,i)
1235 uzder(1,3,2)= dc_norm(2,i)
1236 uzder(2,3,2)=-dc_norm(1,i)
1239 C Compute the Y-axis
1242 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1245 C Compute the derivatives of uy
1248 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1249 & -dc_norm(k,i)*dc_norm(j,i+1)
1250 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1252 uyder(j,j,1)=uyder(j,j,1)-costh
1253 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1258 uygrad(l,k,j,i)=uyder(l,k,j)
1259 uzgrad(l,k,j,i)=uzder(l,k,j)
1263 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1264 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1265 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1266 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1272 vbld_inv_temp(1)=vbld_inv(i+1)
1273 if (i.lt.nres-1) then
1274 vbld_inv_temp(2)=vbld_inv(i+2)
1276 vbld_inv_temp(2)=vbld_inv(i)
1281 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1282 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1290 C-----------------------------------------------------------------------------
1291 subroutine vec_and_deriv_test
1292 implicit real*8 (a-h,o-z)
1293 include 'DIMENSIONS'
1294 include 'DIMENSIONS.ZSCOPT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.GEO'
1297 include 'COMMON.VAR'
1298 include 'COMMON.LOCAL'
1299 include 'COMMON.CHAIN'
1300 include 'COMMON.VECTORS'
1301 dimension uyder(3,3,2),uzder(3,3,2)
1302 C Compute the local reference systems. For reference system (i), the
1303 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1304 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1306 if (i.eq.nres-1) then
1307 C Case of the last full residue
1308 C Compute the Z-axis
1309 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1310 costh=dcos(pi-theta(nres))
1311 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1312 c write (iout,*) 'fac',fac,
1313 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1314 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1318 C Compute the derivatives of uz
1320 uzder(2,1,1)=-dc_norm(3,i-1)
1321 uzder(3,1,1)= dc_norm(2,i-1)
1322 uzder(1,2,1)= dc_norm(3,i-1)
1324 uzder(3,2,1)=-dc_norm(1,i-1)
1325 uzder(1,3,1)=-dc_norm(2,i-1)
1326 uzder(2,3,1)= dc_norm(1,i-1)
1329 uzder(2,1,2)= dc_norm(3,i)
1330 uzder(3,1,2)=-dc_norm(2,i)
1331 uzder(1,2,2)=-dc_norm(3,i)
1333 uzder(3,2,2)= dc_norm(1,i)
1334 uzder(1,3,2)= dc_norm(2,i)
1335 uzder(2,3,2)=-dc_norm(1,i)
1337 C Compute the Y-axis
1339 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1342 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1343 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1344 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1346 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1349 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1350 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1353 c write (iout,*) 'facy',facy,
1354 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1355 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1357 uy(k,i)=facy*uy(k,i)
1359 C Compute the derivatives of uy
1362 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1363 & -dc_norm(k,i)*dc_norm(j,i-1)
1364 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1366 c uyder(j,j,1)=uyder(j,j,1)-costh
1367 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1368 uyder(j,j,1)=uyder(j,j,1)
1369 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1370 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1376 uygrad(l,k,j,i)=uyder(l,k,j)
1377 uzgrad(l,k,j,i)=uzder(l,k,j)
1381 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1382 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1383 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1384 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1387 C Compute the Z-axis
1388 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1389 costh=dcos(pi-theta(i+2))
1390 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1391 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1395 C Compute the derivatives of uz
1397 uzder(2,1,1)=-dc_norm(3,i+1)
1398 uzder(3,1,1)= dc_norm(2,i+1)
1399 uzder(1,2,1)= dc_norm(3,i+1)
1401 uzder(3,2,1)=-dc_norm(1,i+1)
1402 uzder(1,3,1)=-dc_norm(2,i+1)
1403 uzder(2,3,1)= dc_norm(1,i+1)
1406 uzder(2,1,2)= dc_norm(3,i)
1407 uzder(3,1,2)=-dc_norm(2,i)
1408 uzder(1,2,2)=-dc_norm(3,i)
1410 uzder(3,2,2)= dc_norm(1,i)
1411 uzder(1,3,2)= dc_norm(2,i)
1412 uzder(2,3,2)=-dc_norm(1,i)
1414 C Compute the Y-axis
1416 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1417 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1418 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1420 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1423 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1424 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1427 c write (iout,*) 'facy',facy,
1428 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1429 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1431 uy(k,i)=facy*uy(k,i)
1433 C Compute the derivatives of uy
1436 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1437 & -dc_norm(k,i)*dc_norm(j,i+1)
1438 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1440 c uyder(j,j,1)=uyder(j,j,1)-costh
1441 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1442 uyder(j,j,1)=uyder(j,j,1)
1443 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1444 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1450 uygrad(l,k,j,i)=uyder(l,k,j)
1451 uzgrad(l,k,j,i)=uzder(l,k,j)
1455 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1456 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1457 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1458 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1465 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1466 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1473 C-----------------------------------------------------------------------------
1474 subroutine check_vecgrad
1475 implicit real*8 (a-h,o-z)
1476 include 'DIMENSIONS'
1477 include 'DIMENSIONS.ZSCOPT'
1478 include 'COMMON.IOUNITS'
1479 include 'COMMON.GEO'
1480 include 'COMMON.VAR'
1481 include 'COMMON.LOCAL'
1482 include 'COMMON.CHAIN'
1483 include 'COMMON.VECTORS'
1484 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1485 dimension uyt(3,maxres),uzt(3,maxres)
1486 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1487 double precision delta /1.0d-7/
1490 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1491 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1492 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1493 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1494 cd & (dc_norm(if90,i),if90=1,3)
1495 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1496 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1497 cd write(iout,'(a)')
1503 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1504 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1517 cd write (iout,*) 'i=',i
1519 erij(k)=dc_norm(k,i)
1523 dc_norm(k,i)=erij(k)
1525 dc_norm(j,i)=dc_norm(j,i)+delta
1526 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1528 c dc_norm(k,i)=dc_norm(k,i)/fac
1530 c write (iout,*) (dc_norm(k,i),k=1,3)
1531 c write (iout,*) (erij(k),k=1,3)
1534 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1535 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1536 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1537 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1539 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1540 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1541 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1544 dc_norm(k,i)=erij(k)
1547 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1548 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1549 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1550 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1551 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1552 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1553 cd write (iout,'(a)')
1558 C--------------------------------------------------------------------------
1559 subroutine set_matrices
1560 implicit real*8 (a-h,o-z)
1561 include 'DIMENSIONS'
1562 include 'DIMENSIONS.ZSCOPT'
1563 include 'COMMON.IOUNITS'
1564 include 'COMMON.GEO'
1565 include 'COMMON.VAR'
1566 include 'COMMON.LOCAL'
1567 include 'COMMON.CHAIN'
1568 include 'COMMON.DERIV'
1569 include 'COMMON.INTERACT'
1570 include 'COMMON.CONTACTS'
1571 include 'COMMON.TORSION'
1572 include 'COMMON.VECTORS'
1573 include 'COMMON.FFIELD'
1574 double precision auxvec(2),auxmat(2,2)
1576 C Compute the virtual-bond-torsional-angle dependent quantities needed
1577 C to calculate the el-loc multibody terms of various order.
1580 if (i .lt. nres+1) then
1617 if (i .gt. 3 .and. i .lt. nres+1) then
1618 obrot_der(1,i-2)=-sin1
1619 obrot_der(2,i-2)= cos1
1620 Ugder(1,1,i-2)= sin1
1621 Ugder(1,2,i-2)=-cos1
1622 Ugder(2,1,i-2)=-cos1
1623 Ugder(2,2,i-2)=-sin1
1626 obrot2_der(1,i-2)=-dwasin2
1627 obrot2_der(2,i-2)= dwacos2
1628 Ug2der(1,1,i-2)= dwasin2
1629 Ug2der(1,2,i-2)=-dwacos2
1630 Ug2der(2,1,i-2)=-dwacos2
1631 Ug2der(2,2,i-2)=-dwasin2
1633 obrot_der(1,i-2)=0.0d0
1634 obrot_der(2,i-2)=0.0d0
1635 Ugder(1,1,i-2)=0.0d0
1636 Ugder(1,2,i-2)=0.0d0
1637 Ugder(2,1,i-2)=0.0d0
1638 Ugder(2,2,i-2)=0.0d0
1639 obrot2_der(1,i-2)=0.0d0
1640 obrot2_der(2,i-2)=0.0d0
1641 Ug2der(1,1,i-2)=0.0d0
1642 Ug2der(1,2,i-2)=0.0d0
1643 Ug2der(2,1,i-2)=0.0d0
1644 Ug2der(2,2,i-2)=0.0d0
1646 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1647 iti = itortyp(itype(i-2))
1651 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1652 iti1 = itortyp(itype(i-1))
1656 cd write (iout,*) '*******i',i,' iti1',iti
1657 cd write (iout,*) 'b1',b1(:,iti)
1658 cd write (iout,*) 'b2',b2(:,iti)
1659 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1660 if (i .gt. iatel_s+2) then
1661 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1662 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1663 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1664 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1665 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1666 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1667 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1677 DtUg2(l,k,i-2)=0.0d0
1681 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1682 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1683 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1684 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1685 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1686 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1687 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1689 muder(k,i-2)=Ub2der(k,i-2)
1691 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1692 iti1 = itortyp(itype(i-1))
1697 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1699 C Vectors and matrices dependent on a single virtual-bond dihedral.
1700 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1701 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1702 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1703 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1704 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1705 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1706 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1707 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1708 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1709 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1710 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1712 C Matrices dependent on two consecutive virtual-bond dihedrals.
1713 C The order of matrices is from left to right.
1715 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1716 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1717 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1718 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1719 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1720 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1721 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1722 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1725 cd iti = itortyp(itype(i))
1728 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1729 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1734 C--------------------------------------------------------------------------
1735 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1737 C This subroutine calculates the average interaction energy and its gradient
1738 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1739 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1740 C The potential depends both on the distance of peptide-group centers and on
1741 C the orientation of the CA-CA virtual bonds.
1743 implicit real*8 (a-h,o-z)
1744 include 'DIMENSIONS'
1745 include 'DIMENSIONS.ZSCOPT'
1746 include 'COMMON.CONTROL'
1747 include 'COMMON.IOUNITS'
1748 include 'COMMON.GEO'
1749 include 'COMMON.VAR'
1750 include 'COMMON.LOCAL'
1751 include 'COMMON.CHAIN'
1752 include 'COMMON.DERIV'
1753 include 'COMMON.INTERACT'
1754 include 'COMMON.CONTACTS'
1755 include 'COMMON.TORSION'
1756 include 'COMMON.VECTORS'
1757 include 'COMMON.FFIELD'
1758 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1759 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1760 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1761 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1762 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1763 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1764 double precision scal_el /0.5d0/
1766 C 13-go grudnia roku pamietnego...
1767 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1768 & 0.0d0,1.0d0,0.0d0,
1769 & 0.0d0,0.0d0,1.0d0/
1770 cd write(iout,*) 'In EELEC'
1772 cd write(iout,*) 'Type',i
1773 cd write(iout,*) 'B1',B1(:,i)
1774 cd write(iout,*) 'B2',B2(:,i)
1775 cd write(iout,*) 'CC',CC(:,:,i)
1776 cd write(iout,*) 'DD',DD(:,:,i)
1777 cd write(iout,*) 'EE',EE(:,:,i)
1779 cd call check_vecgrad
1781 if (icheckgrad.eq.1) then
1783 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1785 dc_norm(k,i)=dc(k,i)*fac
1787 c write (iout,*) 'i',i,' fac',fac
1790 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1792 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1793 cd if (wel_loc.gt.0.0d0) then
1794 if (icheckgrad.eq.1) then
1795 call vec_and_deriv_test
1802 cd write (iout,*) 'i=',i
1804 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1807 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1808 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1821 cd print '(a)','Enter EELEC'
1822 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1824 gel_loc_loc(i)=0.0d0
1827 do i=iatel_s,iatel_e
1828 if (itel(i).eq.0) goto 1215
1832 dx_normi=dc_norm(1,i)
1833 dy_normi=dc_norm(2,i)
1834 dz_normi=dc_norm(3,i)
1835 xmedi=c(1,i)+0.5d0*dxi
1836 ymedi=c(2,i)+0.5d0*dyi
1837 zmedi=c(3,i)+0.5d0*dzi
1839 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1840 do j=ielstart(i),ielend(i)
1841 if (itel(j).eq.0) goto 1216
1845 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1846 aaa=app(iteli,itelj)
1847 bbb=bpp(iteli,itelj)
1848 C Diagnostics only!!!
1854 ael6i=ael6(iteli,itelj)
1855 ael3i=ael3(iteli,itelj)
1859 dx_normj=dc_norm(1,j)
1860 dy_normj=dc_norm(2,j)
1861 dz_normj=dc_norm(3,j)
1862 xj=c(1,j)+0.5D0*dxj-xmedi
1863 yj=c(2,j)+0.5D0*dyj-ymedi
1864 zj=c(3,j)+0.5D0*dzj-zmedi
1865 rij=xj*xj+yj*yj+zj*zj
1871 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1872 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1873 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1874 fac=cosa-3.0D0*cosb*cosg
1876 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1877 if (j.eq.i+2) ev1=scal_el*ev1
1882 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1885 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1886 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1887 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1890 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1891 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1892 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1893 cd & xmedi,ymedi,zmedi,xj,yj,zj
1895 C Calculate contributions to the Cartesian gradient.
1898 facvdw=-6*rrmij*(ev1+evdwij)
1899 facel=-3*rrmij*(el1+eesij)
1906 * Radial derivatives. First process both termini of the fragment (i,j)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 gelc(k,j)=gelc(k,j)+ghalf
1917 * Loop over residues i+1 thru j-1.
1921 gelc(l,k)=gelc(l,k)+ggg(l)
1929 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1930 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1933 * Loop over residues i+1 thru j-1.
1937 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1944 fac=-3*rrmij*(facvdw+facvdw+facel)
1950 * Radial derivatives. First process both termini of the fragment (i,j)
1957 gelc(k,i)=gelc(k,i)+ghalf
1958 gelc(k,j)=gelc(k,j)+ghalf
1961 * Loop over residues i+1 thru j-1.
1965 gelc(l,k)=gelc(l,k)+ggg(l)
1972 ecosa=2.0D0*fac3*fac1+fac4
1975 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1976 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1978 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1979 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1981 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1982 cd & (dcosg(k),k=1,3)
1984 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1988 gelc(k,i)=gelc(k,i)+ghalf
1989 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1990 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1991 gelc(k,j)=gelc(k,j)+ghalf
1992 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1993 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1997 gelc(l,k)=gelc(l,k)+ggg(l)
2002 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2003 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2004 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2006 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2007 C energy of a peptide unit is assumed in the form of a second-order
2008 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2009 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2010 C are computed for EVERY pair of non-contiguous peptide groups.
2012 if (j.lt.nres-1) then
2023 muij(kkk)=mu(k,i)*mu(l,j)
2026 cd write (iout,*) 'EELEC: i',i,' j',j
2027 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2028 cd write(iout,*) 'muij',muij
2029 ury=scalar(uy(1,i),erij)
2030 urz=scalar(uz(1,i),erij)
2031 vry=scalar(uy(1,j),erij)
2032 vrz=scalar(uz(1,j),erij)
2033 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2034 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2035 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2036 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2037 C For diagnostics only
2042 fac=dsqrt(-ael6i)*r3ij
2043 cd write (2,*) 'fac=',fac
2044 C For diagnostics only
2050 cd write (iout,'(4i5,4f10.5)')
2051 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2052 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2053 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2054 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2055 cd write (iout,'(4f10.5)')
2056 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2057 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2058 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2059 cd write (iout,'(2i3,9f10.5/)') i,j,
2060 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2062 C Derivatives of the elements of A in virtual-bond vectors
2063 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2070 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2071 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2072 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2073 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2074 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2075 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2076 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2077 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2078 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2079 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2080 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2081 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2091 C Compute radial contributions to the gradient
2113 C Add the contributions coming from er
2116 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2117 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2118 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2119 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2122 C Derivatives in DC(i)
2123 ghalf1=0.5d0*agg(k,1)
2124 ghalf2=0.5d0*agg(k,2)
2125 ghalf3=0.5d0*agg(k,3)
2126 ghalf4=0.5d0*agg(k,4)
2127 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2128 & -3.0d0*uryg(k,2)*vry)+ghalf1
2129 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2130 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2131 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2132 & -3.0d0*urzg(k,2)*vry)+ghalf3
2133 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2134 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2135 C Derivatives in DC(i+1)
2136 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2137 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2138 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2139 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2140 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2141 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2142 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2143 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2144 C Derivatives in DC(j)
2145 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2146 & -3.0d0*vryg(k,2)*ury)+ghalf1
2147 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2148 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2149 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2150 & -3.0d0*vryg(k,2)*urz)+ghalf3
2151 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2152 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2153 C Derivatives in DC(j+1) or DC(nres-1)
2154 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2155 & -3.0d0*vryg(k,3)*ury)
2156 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2157 & -3.0d0*vrzg(k,3)*ury)
2158 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2159 & -3.0d0*vryg(k,3)*urz)
2160 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2161 & -3.0d0*vrzg(k,3)*urz)
2166 C Derivatives in DC(i+1)
2167 cd aggi1(k,1)=agg(k,1)
2168 cd aggi1(k,2)=agg(k,2)
2169 cd aggi1(k,3)=agg(k,3)
2170 cd aggi1(k,4)=agg(k,4)
2171 C Derivatives in DC(j)
2176 C Derivatives in DC(j+1)
2181 if (j.eq.nres-1 .and. i.lt.j-2) then
2183 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2184 cd aggj1(k,l)=agg(k,l)
2190 C Check the loc-el terms by numerical integration
2200 aggi(k,l)=-aggi(k,l)
2201 aggi1(k,l)=-aggi1(k,l)
2202 aggj(k,l)=-aggj(k,l)
2203 aggj1(k,l)=-aggj1(k,l)
2206 if (j.lt.nres-1) then
2212 aggi(k,l)=-aggi(k,l)
2213 aggi1(k,l)=-aggi1(k,l)
2214 aggj(k,l)=-aggj(k,l)
2215 aggj1(k,l)=-aggj1(k,l)
2226 aggi(k,l)=-aggi(k,l)
2227 aggi1(k,l)=-aggi1(k,l)
2228 aggj(k,l)=-aggj(k,l)
2229 aggj1(k,l)=-aggj1(k,l)
2235 IF (wel_loc.gt.0.0d0) THEN
2236 C Contribution to the local-electrostatic energy coming from the i-j pair
2237 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2239 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2240 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2241 eel_loc=eel_loc+eel_loc_ij
2242 C Partial derivatives in virtual-bond dihedral angles gamma
2245 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2246 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2247 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2248 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2249 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2250 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2251 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2252 cd write(iout,*) 'agg ',agg
2253 cd write(iout,*) 'aggi ',aggi
2254 cd write(iout,*) 'aggi1',aggi1
2255 cd write(iout,*) 'aggj ',aggj
2256 cd write(iout,*) 'aggj1',aggj1
2258 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2260 ggg(l)=agg(l,1)*muij(1)+
2261 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2265 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2268 C Remaining derivatives of eello
2270 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2271 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2272 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2273 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2274 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2275 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2276 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2277 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2281 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2282 C Contributions from turns
2287 call eturn34(i,j,eello_turn3,eello_turn4)
2289 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2290 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2292 C Calculate the contact function. The ith column of the array JCONT will
2293 C contain the numbers of atoms that make contacts with the atom I (of numbers
2294 C greater than I). The arrays FACONT and GACONT will contain the values of
2295 C the contact function and its derivative.
2296 c r0ij=1.02D0*rpp(iteli,itelj)
2297 c r0ij=1.11D0*rpp(iteli,itelj)
2298 r0ij=2.20D0*rpp(iteli,itelj)
2299 c r0ij=1.55D0*rpp(iteli,itelj)
2300 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2301 if (fcont.gt.0.0D0) then
2302 num_conti=num_conti+1
2303 if (num_conti.gt.maxconts) then
2304 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2305 & ' will skip next contacts for this conf.'
2307 jcont_hb(num_conti,i)=j
2308 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2309 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2310 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2312 d_cont(num_conti,i)=rij
2313 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2314 C --- Electrostatic-interaction matrix ---
2315 a_chuj(1,1,num_conti,i)=a22
2316 a_chuj(1,2,num_conti,i)=a23
2317 a_chuj(2,1,num_conti,i)=a32
2318 a_chuj(2,2,num_conti,i)=a33
2319 C --- Gradient of rij
2321 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2324 c a_chuj(1,1,num_conti,i)=-0.61d0
2325 c a_chuj(1,2,num_conti,i)= 0.4d0
2326 c a_chuj(2,1,num_conti,i)= 0.65d0
2327 c a_chuj(2,2,num_conti,i)= 0.50d0
2328 c else if (i.eq.2) then
2329 c a_chuj(1,1,num_conti,i)= 0.0d0
2330 c a_chuj(1,2,num_conti,i)= 0.0d0
2331 c a_chuj(2,1,num_conti,i)= 0.0d0
2332 c a_chuj(2,2,num_conti,i)= 0.0d0
2334 C --- and its gradients
2335 cd write (iout,*) 'i',i,' j',j
2337 cd write (iout,*) 'iii 1 kkk',kkk
2338 cd write (iout,*) agg(kkk,:)
2341 cd write (iout,*) 'iii 2 kkk',kkk
2342 cd write (iout,*) aggi(kkk,:)
2345 cd write (iout,*) 'iii 3 kkk',kkk
2346 cd write (iout,*) aggi1(kkk,:)
2349 cd write (iout,*) 'iii 4 kkk',kkk
2350 cd write (iout,*) aggj(kkk,:)
2353 cd write (iout,*) 'iii 5 kkk',kkk
2354 cd write (iout,*) aggj1(kkk,:)
2361 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2362 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2363 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2364 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2365 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2367 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2373 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2374 C Calculate contact energies
2376 wij=cosa-3.0D0*cosb*cosg
2379 c fac3=dsqrt(-ael6i)/r0ij**3
2380 fac3=dsqrt(-ael6i)*r3ij
2381 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2382 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2384 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2385 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2386 C Diagnostics. Comment out or remove after debugging!
2387 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2388 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2389 c ees0m(num_conti,i)=0.0D0
2391 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2392 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2393 facont_hb(num_conti,i)=fcont
2395 C Angular derivatives of the contact function
2396 ees0pij1=fac3/ees0pij
2397 ees0mij1=fac3/ees0mij
2398 fac3p=-3.0D0*fac3*rrmij
2399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2408 ecosap=ecosa1+ecosa2
2409 ecosbp=ecosb1+ecosb2
2410 ecosgp=ecosg1+ecosg2
2411 ecosam=ecosa1-ecosa2
2412 ecosbm=ecosb1-ecosb2
2413 ecosgm=ecosg1-ecosg2
2422 fprimcont=fprimcont/rij
2423 cd facont_hb(num_conti,i)=1.0D0
2424 C Following line is for diagnostics.
2427 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2428 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2431 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2432 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2434 gggp(1)=gggp(1)+ees0pijp*xj
2435 gggp(2)=gggp(2)+ees0pijp*yj
2436 gggp(3)=gggp(3)+ees0pijp*zj
2437 gggm(1)=gggm(1)+ees0mijp*xj
2438 gggm(2)=gggm(2)+ees0mijp*yj
2439 gggm(3)=gggm(3)+ees0mijp*zj
2440 C Derivatives due to the contact function
2441 gacont_hbr(1,num_conti,i)=fprimcont*xj
2442 gacont_hbr(2,num_conti,i)=fprimcont*yj
2443 gacont_hbr(3,num_conti,i)=fprimcont*zj
2445 ghalfp=0.5D0*gggp(k)
2446 ghalfm=0.5D0*gggm(k)
2447 gacontp_hb1(k,num_conti,i)=ghalfp
2448 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2449 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2450 gacontp_hb2(k,num_conti,i)=ghalfp
2451 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2452 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2453 gacontp_hb3(k,num_conti,i)=gggp(k)
2454 gacontm_hb1(k,num_conti,i)=ghalfm
2455 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2456 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2457 gacontm_hb2(k,num_conti,i)=ghalfm
2458 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2459 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2460 gacontm_hb3(k,num_conti,i)=gggm(k)
2463 C Diagnostics. Comment out or remove after debugging!
2465 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2466 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2467 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2468 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2469 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2470 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2473 endif ! num_conti.le.maxconts
2478 num_cont_hb(i)=num_conti
2482 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2483 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2485 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2486 ccc eel_loc=eel_loc+eello_turn3
2489 C-----------------------------------------------------------------------------
2490 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2491 C Third- and fourth-order contributions from turns
2492 implicit real*8 (a-h,o-z)
2493 include 'DIMENSIONS'
2494 include 'DIMENSIONS.ZSCOPT'
2495 include 'COMMON.IOUNITS'
2496 include 'COMMON.GEO'
2497 include 'COMMON.VAR'
2498 include 'COMMON.LOCAL'
2499 include 'COMMON.CHAIN'
2500 include 'COMMON.DERIV'
2501 include 'COMMON.INTERACT'
2502 include 'COMMON.CONTACTS'
2503 include 'COMMON.TORSION'
2504 include 'COMMON.VECTORS'
2505 include 'COMMON.FFIELD'
2507 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2508 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2509 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2510 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2511 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2512 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2516 C Third-order contributions
2523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2524 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2525 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2526 call transpose2(auxmat(1,1),auxmat1(1,1))
2527 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2528 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2529 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2530 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2531 cd & ' eello_turn3_num',4*eello_turn3_num
2533 C Derivatives in gamma(i)
2534 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2535 call transpose2(auxmat2(1,1),pizda(1,1))
2536 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2537 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2538 C Derivatives in gamma(i+1)
2539 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2540 call transpose2(auxmat2(1,1),pizda(1,1))
2541 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2542 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2543 & +0.5d0*(pizda(1,1)+pizda(2,2))
2544 C Cartesian derivatives
2546 a_temp(1,1)=aggi(l,1)
2547 a_temp(1,2)=aggi(l,2)
2548 a_temp(2,1)=aggi(l,3)
2549 a_temp(2,2)=aggi(l,4)
2550 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2551 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2552 & +0.5d0*(pizda(1,1)+pizda(2,2))
2553 a_temp(1,1)=aggi1(l,1)
2554 a_temp(1,2)=aggi1(l,2)
2555 a_temp(2,1)=aggi1(l,3)
2556 a_temp(2,2)=aggi1(l,4)
2557 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2558 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2559 & +0.5d0*(pizda(1,1)+pizda(2,2))
2560 a_temp(1,1)=aggj(l,1)
2561 a_temp(1,2)=aggj(l,2)
2562 a_temp(2,1)=aggj(l,3)
2563 a_temp(2,2)=aggj(l,4)
2564 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2565 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2566 & +0.5d0*(pizda(1,1)+pizda(2,2))
2567 a_temp(1,1)=aggj1(l,1)
2568 a_temp(1,2)=aggj1(l,2)
2569 a_temp(2,1)=aggj1(l,3)
2570 a_temp(2,2)=aggj1(l,4)
2571 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2572 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2573 & +0.5d0*(pizda(1,1)+pizda(2,2))
2576 else if (j.eq.i+3) then
2577 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2579 C Fourth-order contributions
2587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2588 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2589 iti1=itortyp(itype(i+1))
2590 iti2=itortyp(itype(i+2))
2591 iti3=itortyp(itype(i+3))
2592 call transpose2(EUg(1,1,i+1),e1t(1,1))
2593 call transpose2(Eug(1,1,i+2),e2t(1,1))
2594 call transpose2(Eug(1,1,i+3),e3t(1,1))
2595 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2596 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2597 s1=scalar2(b1(1,iti2),auxvec(1))
2598 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2599 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2600 s2=scalar2(b1(1,iti1),auxvec(1))
2601 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2602 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2603 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2604 eello_turn4=eello_turn4-(s1+s2+s3)
2605 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2606 cd & ' eello_turn4_num',8*eello_turn4_num
2607 C Derivatives in gamma(i)
2609 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2610 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2611 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2612 s1=scalar2(b1(1,iti2),auxvec(1))
2613 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2614 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2615 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2616 C Derivatives in gamma(i+1)
2617 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2618 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2619 s2=scalar2(b1(1,iti1),auxvec(1))
2620 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2621 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2622 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2623 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2624 C Derivatives in gamma(i+2)
2625 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2626 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2627 s1=scalar2(b1(1,iti2),auxvec(1))
2628 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2629 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2630 s2=scalar2(b1(1,iti1),auxvec(1))
2631 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2632 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2635 C Cartesian derivatives
2636 C Derivatives of this turn contributions in DC(i+2)
2637 if (j.lt.nres-1) then
2639 a_temp(1,1)=agg(l,1)
2640 a_temp(1,2)=agg(l,2)
2641 a_temp(2,1)=agg(l,3)
2642 a_temp(2,2)=agg(l,4)
2643 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2644 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2645 s1=scalar2(b1(1,iti2),auxvec(1))
2646 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2647 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2648 s2=scalar2(b1(1,iti1),auxvec(1))
2649 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2650 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2653 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2656 C Remaining derivatives of this turn contribution
2658 a_temp(1,1)=aggi(l,1)
2659 a_temp(1,2)=aggi(l,2)
2660 a_temp(2,1)=aggi(l,3)
2661 a_temp(2,2)=aggi(l,4)
2662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2664 s1=scalar2(b1(1,iti2),auxvec(1))
2665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2667 s2=scalar2(b1(1,iti1),auxvec(1))
2668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2671 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2672 a_temp(1,1)=aggi1(l,1)
2673 a_temp(1,2)=aggi1(l,2)
2674 a_temp(2,1)=aggi1(l,3)
2675 a_temp(2,2)=aggi1(l,4)
2676 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2677 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2678 s1=scalar2(b1(1,iti2),auxvec(1))
2679 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2680 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2681 s2=scalar2(b1(1,iti1),auxvec(1))
2682 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2683 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2684 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2685 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2686 a_temp(1,1)=aggj(l,1)
2687 a_temp(1,2)=aggj(l,2)
2688 a_temp(2,1)=aggj(l,3)
2689 a_temp(2,2)=aggj(l,4)
2690 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2691 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2692 s1=scalar2(b1(1,iti2),auxvec(1))
2693 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2694 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2695 s2=scalar2(b1(1,iti1),auxvec(1))
2696 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2697 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2698 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2699 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2700 a_temp(1,1)=aggj1(l,1)
2701 a_temp(1,2)=aggj1(l,2)
2702 a_temp(2,1)=aggj1(l,3)
2703 a_temp(2,2)=aggj1(l,4)
2704 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2705 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2706 s1=scalar2(b1(1,iti2),auxvec(1))
2707 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2708 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2709 s2=scalar2(b1(1,iti1),auxvec(1))
2710 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2711 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2712 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2713 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2719 C-----------------------------------------------------------------------------
2720 subroutine vecpr(u,v,w)
2721 implicit real*8(a-h,o-z)
2722 dimension u(3),v(3),w(3)
2723 w(1)=u(2)*v(3)-u(3)*v(2)
2724 w(2)=-u(1)*v(3)+u(3)*v(1)
2725 w(3)=u(1)*v(2)-u(2)*v(1)
2728 C-----------------------------------------------------------------------------
2729 subroutine unormderiv(u,ugrad,unorm,ungrad)
2730 C This subroutine computes the derivatives of a normalized vector u, given
2731 C the derivatives computed without normalization conditions, ugrad. Returns
2734 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2735 double precision vec(3)
2736 double precision scalar
2738 c write (2,*) 'ugrad',ugrad
2741 vec(i)=scalar(ugrad(1,i),u(1))
2743 c write (2,*) 'vec',vec
2746 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2749 c write (2,*) 'ungrad',ungrad
2752 C-----------------------------------------------------------------------------
2753 subroutine escp(evdw2,evdw2_14)
2755 C This subroutine calculates the excluded-volume interaction energy between
2756 C peptide-group centers and side chains and its gradient in virtual-bond and
2757 C side-chain vectors.
2759 implicit real*8 (a-h,o-z)
2760 include 'DIMENSIONS'
2761 include 'DIMENSIONS.ZSCOPT'
2762 include 'COMMON.GEO'
2763 include 'COMMON.VAR'
2764 include 'COMMON.LOCAL'
2765 include 'COMMON.CHAIN'
2766 include 'COMMON.DERIV'
2767 include 'COMMON.INTERACT'
2768 include 'COMMON.FFIELD'
2769 include 'COMMON.IOUNITS'
2773 cd print '(a)','Enter ESCP'
2774 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2775 c & ' scal14',scal14
2776 do i=iatscp_s,iatscp_e
2778 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2779 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2780 if (iteli.eq.0) goto 1225
2781 xi=0.5D0*(c(1,i)+c(1,i+1))
2782 yi=0.5D0*(c(2,i)+c(2,i+1))
2783 zi=0.5D0*(c(3,i)+c(3,i+1))
2785 do iint=1,nscp_gr(i)
2787 do j=iscpstart(i,iint),iscpend(i,iint)
2789 C Uncomment following three lines for SC-p interactions
2793 C Uncomment following three lines for Ca-p interactions
2797 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2799 e1=fac*fac*aad(itypj,iteli)
2800 e2=fac*bad(itypj,iteli)
2801 if (iabs(j-i) .le. 2) then
2804 evdw2_14=evdw2_14+e1+e2
2807 c write (iout,*) i,j,evdwij
2811 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2813 fac=-(evdwij+e1)*rrij
2818 cd write (iout,*) 'j<i'
2819 C Uncomment following three lines for SC-p interactions
2821 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2824 cd write (iout,*) 'j>i'
2827 C Uncomment following line for SC-p interactions
2828 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2832 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2836 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2837 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2840 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2850 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2851 gradx_scp(j,i)=expon*gradx_scp(j,i)
2854 C******************************************************************************
2858 C To save time the factor EXPON has been extracted from ALL components
2859 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2862 C******************************************************************************
2865 C--------------------------------------------------------------------------
2866 subroutine edis(ehpb)
2868 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2870 implicit real*8 (a-h,o-z)
2871 include 'DIMENSIONS'
2872 include 'COMMON.SBRIDGE'
2873 include 'COMMON.CHAIN'
2874 include 'COMMON.DERIV'
2875 include 'COMMON.VAR'
2876 include 'COMMON.INTERACT'
2877 include 'COMMON.IOUNITS'
2880 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2881 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2882 if (link_end.eq.0) return
2883 do i=link_start,link_end
2884 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2885 C CA-CA distance used in regularization of structure.
2888 C iii and jjj point to the residues for which the distance is assigned.
2889 if (ii.gt.nres) then
2896 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2897 c & dhpb(i),dhpb1(i),forcon(i)
2898 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2899 C distance and angle dependent SS bond potential.
2900 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2901 call ssbond_ene(iii,jjj,eij)
2903 cd write (iout,*) "eij",eij
2904 else if (ii.gt.nres .and. jj.gt.nres) then
2905 c Restraints from contact prediction
2907 if (dhpb1(i).gt.0.0d0) then
2908 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2909 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2910 c write (iout,*) "beta nmr",
2911 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2915 C Get the force constant corresponding to this distance.
2917 C Calculate the contribution to energy.
2918 ehpb=ehpb+waga*rdis*rdis
2919 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2921 C Evaluate gradient.
2926 ggg(j)=fac*(c(j,jj)-c(j,ii))
2929 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2930 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2933 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2934 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2937 C Calculate the distance between the two points and its difference from the
2940 if (dhpb1(i).gt.0.0d0) then
2941 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2942 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2943 c write (iout,*) "alph nmr",
2944 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2947 C Get the force constant corresponding to this distance.
2949 C Calculate the contribution to energy.
2950 ehpb=ehpb+waga*rdis*rdis
2951 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2953 C Evaluate gradient.
2957 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2958 cd & ' waga=',waga,' fac=',fac
2960 ggg(j)=fac*(c(j,jj)-c(j,ii))
2962 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2963 C If this is a SC-SC distance, we need to calculate the contributions to the
2964 C Cartesian gradient in the SC vectors (ghpbx).
2967 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2968 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2972 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2973 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2980 C--------------------------------------------------------------------------
2981 subroutine ssbond_ene(i,j,eij)
2983 C Calculate the distance and angle dependent SS-bond potential energy
2984 C using a free-energy function derived based on RHF/6-31G** ab initio
2985 C calculations of diethyl disulfide.
2987 C A. Liwo and U. Kozlowska, 11/24/03
2989 implicit real*8 (a-h,o-z)
2990 include 'DIMENSIONS'
2991 include 'DIMENSIONS.ZSCOPT'
2992 include 'COMMON.SBRIDGE'
2993 include 'COMMON.CHAIN'
2994 include 'COMMON.DERIV'
2995 include 'COMMON.LOCAL'
2996 include 'COMMON.INTERACT'
2997 include 'COMMON.VAR'
2998 include 'COMMON.IOUNITS'
2999 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3004 dxi=dc_norm(1,nres+i)
3005 dyi=dc_norm(2,nres+i)
3006 dzi=dc_norm(3,nres+i)
3007 dsci_inv=dsc_inv(itypi)
3009 dscj_inv=dsc_inv(itypj)
3013 dxj=dc_norm(1,nres+j)
3014 dyj=dc_norm(2,nres+j)
3015 dzj=dc_norm(3,nres+j)
3016 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3021 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3022 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3023 om12=dxi*dxj+dyi*dyj+dzi*dzj
3025 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3026 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3032 deltat12=om2-om1+2.0d0
3034 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3035 & +akct*deltad*deltat12
3036 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3037 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3038 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3039 c & " deltat12",deltat12," eij",eij
3040 ed=2*akcm*deltad+akct*deltat12
3042 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3043 eom1=-2*akth*deltat1-pom1-om2*pom2
3044 eom2= 2*akth*deltat2+pom1-om1*pom2
3047 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3050 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3051 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3052 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3053 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3056 C Calculate the components of the gradient in DC and X
3060 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3065 C--------------------------------------------------------------------------
3066 subroutine ebond(estr)
3068 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3070 implicit real*8 (a-h,o-z)
3071 include 'DIMENSIONS'
3072 include 'DIMENSIONS.ZSCOPT'
3073 include 'COMMON.LOCAL'
3074 include 'COMMON.GEO'
3075 include 'COMMON.INTERACT'
3076 include 'COMMON.DERIV'
3077 include 'COMMON.VAR'
3078 include 'COMMON.CHAIN'
3079 include 'COMMON.IOUNITS'
3080 include 'COMMON.NAMES'
3081 include 'COMMON.FFIELD'
3082 include 'COMMON.CONTROL'
3083 double precision u(3),ud(3)
3086 diff = vbld(i)-vbldp0
3087 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3090 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3095 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3102 diff=vbld(i+nres)-vbldsc0(1,iti)
3103 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3104 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3105 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3107 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3111 diff=vbld(i+nres)-vbldsc0(j,iti)
3112 ud(j)=aksc(j,iti)*diff
3113 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3127 uprod2=uprod2*u(k)*u(k)
3131 usumsqder=usumsqder+ud(j)*uprod2
3133 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3134 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3135 estr=estr+uprod/usum
3137 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3145 C--------------------------------------------------------------------------
3146 subroutine ebend(etheta)
3148 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3149 C angles gamma and its derivatives in consecutive thetas and gammas.
3151 implicit real*8 (a-h,o-z)
3152 include 'DIMENSIONS'
3153 include 'DIMENSIONS.ZSCOPT'
3154 include 'COMMON.LOCAL'
3155 include 'COMMON.GEO'
3156 include 'COMMON.INTERACT'
3157 include 'COMMON.DERIV'
3158 include 'COMMON.VAR'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.IOUNITS'
3161 include 'COMMON.NAMES'
3162 include 'COMMON.FFIELD'
3163 common /calcthet/ term1,term2,termm,diffak,ratak,
3164 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3165 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3166 double precision y(2),z(2)
3168 time11=dexp(-2*time)
3171 c write (iout,*) "nres",nres
3172 c write (*,'(a,i2)') 'EBEND ICG=',icg
3173 c write (iout,*) ithet_start,ithet_end
3174 do i=ithet_start,ithet_end
3175 C Zero the energy function and its derivative at 0 or pi.
3176 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3178 c if (i.gt.ithet_start .and.
3179 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3180 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3188 c if (i.lt.nres .and. itel(i).ne.0) then
3200 call proc_proc(phii,icrc)
3201 if (icrc.eq.1) phii=150.0
3215 call proc_proc(phii1,icrc)
3216 if (icrc.eq.1) phii1=150.0
3228 C Calculate the "mean" value of theta from the part of the distribution
3229 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3230 C In following comments this theta will be referred to as t_c.
3231 thet_pred_mean=0.0d0
3235 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3237 c write (iout,*) "thet_pred_mean",thet_pred_mean
3238 dthett=thet_pred_mean*ssd
3239 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3240 c write (iout,*) "thet_pred_mean",thet_pred_mean
3241 C Derivatives of the "mean" values in gamma1 and gamma2.
3242 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3243 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3244 if (theta(i).gt.pi-delta) then
3245 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3247 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3248 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3249 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3251 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3253 else if (theta(i).lt.delta) then
3254 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3255 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3256 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3258 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3259 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3262 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3265 etheta=etheta+ethetai
3266 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3267 c & rad2deg*phii,rad2deg*phii1,ethetai
3268 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3269 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3270 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3273 C Ufff.... We've done all this!!!
3276 C---------------------------------------------------------------------------
3277 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3279 implicit real*8 (a-h,o-z)
3280 include 'DIMENSIONS'
3281 include 'COMMON.LOCAL'
3282 include 'COMMON.IOUNITS'
3283 common /calcthet/ term1,term2,termm,diffak,ratak,
3284 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3285 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3286 C Calculate the contributions to both Gaussian lobes.
3287 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3288 C The "polynomial part" of the "standard deviation" of this part of
3292 sig=sig*thet_pred_mean+polthet(j,it)
3294 C Derivative of the "interior part" of the "standard deviation of the"
3295 C gamma-dependent Gaussian lobe in t_c.
3296 sigtc=3*polthet(3,it)
3298 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3301 C Set the parameters of both Gaussian lobes of the distribution.
3302 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3303 fac=sig*sig+sigc0(it)
3306 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3307 sigsqtc=-4.0D0*sigcsq*sigtc
3308 c print *,i,sig,sigtc,sigsqtc
3309 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3310 sigtc=-sigtc/(fac*fac)
3311 C Following variable is sigma(t_c)**(-2)
3312 sigcsq=sigcsq*sigcsq
3314 sig0inv=1.0D0/sig0i**2
3315 delthec=thetai-thet_pred_mean
3316 delthe0=thetai-theta0i
3317 term1=-0.5D0*sigcsq*delthec*delthec
3318 term2=-0.5D0*sig0inv*delthe0*delthe0
3319 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3320 C NaNs in taking the logarithm. We extract the largest exponent which is added
3321 C to the energy (this being the log of the distribution) at the end of energy
3322 C term evaluation for this virtual-bond angle.
3323 if (term1.gt.term2) then
3325 term2=dexp(term2-termm)
3329 term1=dexp(term1-termm)
3332 C The ratio between the gamma-independent and gamma-dependent lobes of
3333 C the distribution is a Gaussian function of thet_pred_mean too.
3334 diffak=gthet(2,it)-thet_pred_mean
3335 ratak=diffak/gthet(3,it)**2
3336 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3337 C Let's differentiate it in thet_pred_mean NOW.
3339 C Now put together the distribution terms to make complete distribution.
3340 termexp=term1+ak*term2
3341 termpre=sigc+ak*sig0i
3342 C Contribution of the bending energy from this theta is just the -log of
3343 C the sum of the contributions from the two lobes and the pre-exponential
3344 C factor. Simple enough, isn't it?
3345 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3346 C NOW the derivatives!!!
3347 C 6/6/97 Take into account the deformation.
3348 E_theta=(delthec*sigcsq*term1
3349 & +ak*delthe0*sig0inv*term2)/termexp
3350 E_tc=((sigtc+aktc*sig0i)/termpre
3351 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3352 & aktc*term2)/termexp)
3355 c-----------------------------------------------------------------------------
3356 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3357 implicit real*8 (a-h,o-z)
3358 include 'DIMENSIONS'
3359 include 'COMMON.LOCAL'
3360 include 'COMMON.IOUNITS'
3361 common /calcthet/ term1,term2,termm,diffak,ratak,
3362 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3363 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3364 delthec=thetai-thet_pred_mean
3365 delthe0=thetai-theta0i
3366 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3367 t3 = thetai-thet_pred_mean
3371 t14 = t12+t6*sigsqtc
3373 t21 = thetai-theta0i
3379 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3380 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3381 & *(-t12*t9-ak*sig0inv*t27)
3385 C--------------------------------------------------------------------------
3386 subroutine ebend(etheta)
3388 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3389 C angles gamma and its derivatives in consecutive thetas and gammas.
3390 C ab initio-derived potentials from
3391 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3393 implicit real*8 (a-h,o-z)
3394 include 'DIMENSIONS'
3395 include 'DIMENSIONS.ZSCOPT'
3396 include 'COMMON.LOCAL'
3397 include 'COMMON.GEO'
3398 include 'COMMON.INTERACT'
3399 include 'COMMON.DERIV'
3400 include 'COMMON.VAR'
3401 include 'COMMON.CHAIN'
3402 include 'COMMON.IOUNITS'
3403 include 'COMMON.NAMES'
3404 include 'COMMON.FFIELD'
3405 include 'COMMON.CONTROL'
3406 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3407 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3408 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3409 & sinph1ph2(maxdouble,maxdouble)
3410 logical lprn /.false./, lprn1 /.false./
3412 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3413 do i=ithet_start,ithet_end
3417 theti2=0.5d0*theta(i)
3418 ityp2=ithetyp(itype(i-1))
3420 coskt(k)=dcos(k*theti2)
3421 sinkt(k)=dsin(k*theti2)
3426 if (phii.ne.phii) phii=150.0
3430 ityp1=ithetyp(itype(i-2))
3432 cosph1(k)=dcos(k*phii)
3433 sinph1(k)=dsin(k*phii)
3446 if (phii1.ne.phii1) phii1=150.0
3451 ityp3=ithetyp(itype(i))
3453 cosph2(k)=dcos(k*phii1)
3454 sinph2(k)=dsin(k*phii1)
3464 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3465 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3467 ethetai=aa0thet(ityp1,ityp2,ityp3)
3470 ccl=cosph1(l)*cosph2(k-l)
3471 ssl=sinph1(l)*sinph2(k-l)
3472 scl=sinph1(l)*cosph2(k-l)
3473 csl=cosph1(l)*sinph2(k-l)
3474 cosph1ph2(l,k)=ccl-ssl
3475 cosph1ph2(k,l)=ccl+ssl
3476 sinph1ph2(l,k)=scl+csl
3477 sinph1ph2(k,l)=scl-csl
3481 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3482 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3483 write (iout,*) "coskt and sinkt"
3485 write (iout,*) k,coskt(k),sinkt(k)
3489 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3490 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3493 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3494 & " ethetai",ethetai
3497 write (iout,*) "cosph and sinph"
3499 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3501 write (iout,*) "cosph1ph2 and sinph2ph2"
3504 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3505 & sinph1ph2(l,k),sinph1ph2(k,l)
3508 write(iout,*) "ethetai",ethetai
3512 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3513 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3514 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3515 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3516 ethetai=ethetai+sinkt(m)*aux
3517 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3518 dephii=dephii+k*sinkt(m)*(
3519 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3520 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3521 dephii1=dephii1+k*sinkt(m)*(
3522 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3523 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3525 & write (iout,*) "m",m," k",k," bbthet",
3526 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3527 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3528 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3529 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3533 & write(iout,*) "ethetai",ethetai
3537 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3538 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3539 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3540 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3541 ethetai=ethetai+sinkt(m)*aux
3542 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3543 dephii=dephii+l*sinkt(m)*(
3544 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3545 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3546 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3547 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3548 dephii1=dephii1+(k-l)*sinkt(m)*(
3549 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3550 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3551 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3552 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3554 write (iout,*) "m",m," k",k," l",l," ffthet",
3555 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3556 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3557 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3558 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3559 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3560 & cosph1ph2(k,l)*sinkt(m),
3561 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3567 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3568 & i,theta(i)*rad2deg,phii*rad2deg,
3569 & phii1*rad2deg,ethetai
3570 etheta=etheta+ethetai
3571 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3572 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3573 gloc(nphi+i-2,icg)=wang*dethetai
3579 c-----------------------------------------------------------------------------
3580 subroutine esc(escloc)
3581 C Calculate the local energy of a side chain and its derivatives in the
3582 C corresponding virtual-bond valence angles THETA and the spherical angles
3584 implicit real*8 (a-h,o-z)
3585 include 'DIMENSIONS'
3586 include 'DIMENSIONS.ZSCOPT'
3587 include 'COMMON.GEO'
3588 include 'COMMON.LOCAL'
3589 include 'COMMON.VAR'
3590 include 'COMMON.INTERACT'
3591 include 'COMMON.DERIV'
3592 include 'COMMON.CHAIN'
3593 include 'COMMON.IOUNITS'
3594 include 'COMMON.NAMES'
3595 include 'COMMON.FFIELD'
3596 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3597 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3598 common /sccalc/ time11,time12,time112,theti,it,nlobit
3601 c write (iout,'(a)') 'ESC'
3602 do i=loc_start,loc_end
3604 if (it.eq.10) goto 1
3606 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3607 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3608 theti=theta(i+1)-pipol
3612 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3614 if (x(2).gt.pi-delta) then
3618 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3620 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3621 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3623 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3624 & ddersc0(1),dersc(1))
3625 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3626 & ddersc0(3),dersc(3))
3628 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3630 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3631 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3632 & dersc0(2),esclocbi,dersc02)
3633 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3635 call splinthet(x(2),0.5d0*delta,ss,ssd)
3640 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3642 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3643 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3645 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3647 c write (iout,*) escloci
3648 else if (x(2).lt.delta) then
3652 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3654 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3655 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3657 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3658 & ddersc0(1),dersc(1))
3659 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3660 & ddersc0(3),dersc(3))
3662 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3664 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3665 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3666 & dersc0(2),esclocbi,dersc02)
3667 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3672 call splinthet(x(2),0.5d0*delta,ss,ssd)
3674 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3676 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3677 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3679 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3680 c write (iout,*) escloci
3682 call enesc(x,escloci,dersc,ddummy,.false.)
3685 escloc=escloc+escloci
3686 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3688 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3690 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3691 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3696 C---------------------------------------------------------------------------
3697 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3698 implicit real*8 (a-h,o-z)
3699 include 'DIMENSIONS'
3700 include 'COMMON.GEO'
3701 include 'COMMON.LOCAL'
3702 include 'COMMON.IOUNITS'
3703 common /sccalc/ time11,time12,time112,theti,it,nlobit
3704 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3705 double precision contr(maxlob,-1:1)
3707 c write (iout,*) 'it=',it,' nlobit=',nlobit
3711 if (mixed) ddersc(j)=0.0d0
3715 C Because of periodicity of the dependence of the SC energy in omega we have
3716 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3717 C To avoid underflows, first compute & store the exponents.
3725 z(k)=x(k)-censc(k,j,it)
3730 Axk=Axk+gaussc(l,k,j,it)*z(l)
3736 expfac=expfac+Ax(k,j,iii)*z(k)
3744 C As in the case of ebend, we want to avoid underflows in exponentiation and
3745 C subsequent NaNs and INFs in energy calculation.
3746 C Find the largest exponent
3750 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3754 cd print *,'it=',it,' emin=',emin
3756 C Compute the contribution to SC energy and derivatives
3760 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3761 cd print *,'j=',j,' expfac=',expfac
3762 escloc_i=escloc_i+expfac
3764 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3768 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3769 & +gaussc(k,2,j,it))*expfac
3776 dersc(1)=dersc(1)/cos(theti)**2
3777 ddersc(1)=ddersc(1)/cos(theti)**2
3780 escloci=-(dlog(escloc_i)-emin)
3782 dersc(j)=dersc(j)/escloc_i
3786 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3791 C------------------------------------------------------------------------------
3792 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3793 implicit real*8 (a-h,o-z)
3794 include 'DIMENSIONS'
3795 include 'COMMON.GEO'
3796 include 'COMMON.LOCAL'
3797 include 'COMMON.IOUNITS'
3798 common /sccalc/ time11,time12,time112,theti,it,nlobit
3799 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3800 double precision contr(maxlob)
3811 z(k)=x(k)-censc(k,j,it)
3817 Axk=Axk+gaussc(l,k,j,it)*z(l)
3823 expfac=expfac+Ax(k,j)*z(k)
3828 C As in the case of ebend, we want to avoid underflows in exponentiation and
3829 C subsequent NaNs and INFs in energy calculation.
3830 C Find the largest exponent
3833 if (emin.gt.contr(j)) emin=contr(j)
3837 C Compute the contribution to SC energy and derivatives
3841 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3842 escloc_i=escloc_i+expfac
3844 dersc(k)=dersc(k)+Ax(k,j)*expfac
3846 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3847 & +gaussc(1,2,j,it))*expfac
3851 dersc(1)=dersc(1)/cos(theti)**2
3852 dersc12=dersc12/cos(theti)**2
3853 escloci=-(dlog(escloc_i)-emin)
3855 dersc(j)=dersc(j)/escloc_i
3857 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3861 c----------------------------------------------------------------------------------
3862 subroutine esc(escloc)
3863 C Calculate the local energy of a side chain and its derivatives in the
3864 C corresponding virtual-bond valence angles THETA and the spherical angles
3865 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3866 C added by Urszula Kozlowska. 07/11/2007
3868 implicit real*8 (a-h,o-z)
3869 include 'DIMENSIONS'
3870 include 'DIMENSIONS.ZSCOPT'
3871 include 'COMMON.GEO'
3872 include 'COMMON.LOCAL'
3873 include 'COMMON.VAR'
3874 include 'COMMON.SCROT'
3875 include 'COMMON.INTERACT'
3876 include 'COMMON.DERIV'
3877 include 'COMMON.CHAIN'
3878 include 'COMMON.IOUNITS'
3879 include 'COMMON.NAMES'
3880 include 'COMMON.FFIELD'
3881 include 'COMMON.CONTROL'
3882 include 'COMMON.VECTORS'
3883 double precision x_prime(3),y_prime(3),z_prime(3)
3884 & , sumene,dsc_i,dp2_i,x(65),
3885 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3886 & de_dxx,de_dyy,de_dzz,de_dt
3887 double precision s1_t,s1_6_t,s2_t,s2_6_t
3889 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3890 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3891 & dt_dCi(3),dt_dCi1(3)
3892 common /sccalc/ time11,time12,time112,theti,it,nlobit
3895 do i=loc_start,loc_end
3896 costtab(i+1) =dcos(theta(i+1))
3897 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3898 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3899 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3900 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3901 cosfac=dsqrt(cosfac2)
3902 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3903 sinfac=dsqrt(sinfac2)
3905 if (it.eq.10) goto 1
3907 C Compute the axes of tghe local cartesian coordinates system; store in
3908 c x_prime, y_prime and z_prime
3915 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3916 C & dc_norm(3,i+nres)
3918 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3919 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3922 z_prime(j) = -uz(j,i-1)
3925 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3926 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3927 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3928 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3929 c & " xy",scalar(x_prime(1),y_prime(1)),
3930 c & " xz",scalar(x_prime(1),z_prime(1)),
3931 c & " yy",scalar(y_prime(1),y_prime(1)),
3932 c & " yz",scalar(y_prime(1),z_prime(1)),
3933 c & " zz",scalar(z_prime(1),z_prime(1))
3935 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3936 C to local coordinate system. Store in xx, yy, zz.
3942 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3943 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3944 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3951 C Compute the energy of the ith side cbain
3953 c write (2,*) "xx",xx," yy",yy," zz",zz
3956 x(j) = sc_parmin(j,it)
3959 Cc diagnostics - remove later
3961 yy1 = dsin(alph(2))*dcos(omeg(2))
3962 zz1 = -dsin(alph(2))*dsin(omeg(2))
3963 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3964 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3966 C," --- ", xx_w,yy_w,zz_w
3969 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3970 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3972 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3973 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3975 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3976 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3977 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3978 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3979 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3981 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3982 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3983 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3984 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3985 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3987 dsc_i = 0.743d0+x(61)
3989 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3990 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3991 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3992 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3993 s1=(1+x(63))/(0.1d0 + dscp1)
3994 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3995 s2=(1+x(65))/(0.1d0 + dscp2)
3996 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3997 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3998 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3999 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4001 c & dscp1,dscp2,sumene
4002 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4003 escloc = escloc + sumene
4004 c write (2,*) "escloc",escloc
4005 if (.not. calc_grad) goto 1
4008 C This section to check the numerical derivatives of the energy of ith side
4009 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4010 C #define DEBUG in the code to turn it on.
4012 write (2,*) "sumene =",sumene
4016 write (2,*) xx,yy,zz
4017 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4018 de_dxx_num=(sumenep-sumene)/aincr
4020 write (2,*) "xx+ sumene from enesc=",sumenep
4023 write (2,*) xx,yy,zz
4024 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4025 de_dyy_num=(sumenep-sumene)/aincr
4027 write (2,*) "yy+ sumene from enesc=",sumenep
4030 write (2,*) xx,yy,zz
4031 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4032 de_dzz_num=(sumenep-sumene)/aincr
4034 write (2,*) "zz+ sumene from enesc=",sumenep
4035 costsave=cost2tab(i+1)
4036 sintsave=sint2tab(i+1)
4037 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4038 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4039 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4040 de_dt_num=(sumenep-sumene)/aincr
4041 write (2,*) " t+ sumene from enesc=",sumenep
4042 cost2tab(i+1)=costsave
4043 sint2tab(i+1)=sintsave
4044 C End of diagnostics section.
4047 C Compute the gradient of esc
4049 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4050 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4051 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4052 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4053 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4054 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4055 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4056 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4057 pom1=(sumene3*sint2tab(i+1)+sumene1)
4058 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4059 pom2=(sumene4*cost2tab(i+1)+sumene2)
4060 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4061 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4062 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4063 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4065 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4066 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4067 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4069 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4070 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4071 & +(pom1+pom2)*pom_dx
4073 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4076 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4077 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4078 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4080 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4081 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4082 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4083 & +x(59)*zz**2 +x(60)*xx*zz
4084 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4085 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4086 & +(pom1-pom2)*pom_dy
4088 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4091 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4092 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4093 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4094 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4095 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4096 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4097 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4098 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4100 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4103 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4104 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4105 & +pom1*pom_dt1+pom2*pom_dt2
4107 write(2,*), "de_dt = ", de_dt,de_dt_num
4111 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4112 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4113 cosfac2xx=cosfac2*xx
4114 sinfac2yy=sinfac2*yy
4116 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4118 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4120 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4121 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4122 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4123 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4124 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4125 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4126 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4127 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4128 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4129 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4133 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4134 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4137 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4138 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4139 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4141 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4142 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4146 dXX_Ctab(k,i)=dXX_Ci(k)
4147 dXX_C1tab(k,i)=dXX_Ci1(k)
4148 dYY_Ctab(k,i)=dYY_Ci(k)
4149 dYY_C1tab(k,i)=dYY_Ci1(k)
4150 dZZ_Ctab(k,i)=dZZ_Ci(k)
4151 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4152 dXX_XYZtab(k,i)=dXX_XYZ(k)
4153 dYY_XYZtab(k,i)=dYY_XYZ(k)
4154 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4158 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4159 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4160 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4161 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4162 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4164 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4165 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4166 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4167 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4168 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4169 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4170 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4171 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4173 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4174 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4176 C to check gradient call subroutine check_grad
4183 c------------------------------------------------------------------------------
4184 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4186 C This procedure calculates two-body contact function g(rij) and its derivative:
4189 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4192 C where x=(rij-r0ij)/delta
4194 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4197 double precision rij,r0ij,eps0ij,fcont,fprimcont
4198 double precision x,x2,x4,delta
4202 if (x.lt.-1.0D0) then
4205 else if (x.le.1.0D0) then
4208 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4209 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4216 c------------------------------------------------------------------------------
4217 subroutine splinthet(theti,delta,ss,ssder)
4218 implicit real*8 (a-h,o-z)
4219 include 'DIMENSIONS'
4220 include 'DIMENSIONS.ZSCOPT'
4221 include 'COMMON.VAR'
4222 include 'COMMON.GEO'
4225 if (theti.gt.pipol) then
4226 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4228 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4233 c------------------------------------------------------------------------------
4234 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4236 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4237 double precision ksi,ksi2,ksi3,a1,a2,a3
4238 a1=fprim0*delta/(f1-f0)
4244 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4245 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4248 c------------------------------------------------------------------------------
4249 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4251 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4252 double precision ksi,ksi2,ksi3,a1,a2,a3
4257 a2=3*(f1x-f0x)-2*fprim0x*delta
4258 a3=fprim0x*delta-2*(f1x-f0x)
4259 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4262 C-----------------------------------------------------------------------------
4264 C-----------------------------------------------------------------------------
4265 subroutine etor(etors,edihcnstr,fact)
4266 implicit real*8 (a-h,o-z)
4267 include 'DIMENSIONS'
4268 include 'DIMENSIONS.ZSCOPT'
4269 include 'COMMON.VAR'
4270 include 'COMMON.GEO'
4271 include 'COMMON.LOCAL'
4272 include 'COMMON.TORSION'
4273 include 'COMMON.INTERACT'
4274 include 'COMMON.DERIV'
4275 include 'COMMON.CHAIN'
4276 include 'COMMON.NAMES'
4277 include 'COMMON.IOUNITS'
4278 include 'COMMON.FFIELD'
4279 include 'COMMON.TORCNSTR'
4281 C Set lprn=.true. for debugging
4285 do i=iphi_start,iphi_end
4286 itori=itortyp(itype(i-2))
4287 itori1=itortyp(itype(i-1))
4290 C Proline-Proline pair is a special case...
4291 if (itori.eq.3 .and. itori1.eq.3) then
4292 if (phii.gt.-dwapi3) then
4294 fac=1.0D0/(1.0D0-cosphi)
4295 etorsi=v1(1,3,3)*fac
4296 etorsi=etorsi+etorsi
4297 etors=etors+etorsi-v1(1,3,3)
4298 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4301 v1ij=v1(j+1,itori,itori1)
4302 v2ij=v2(j+1,itori,itori1)
4305 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4306 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4310 v1ij=v1(j,itori,itori1)
4311 v2ij=v2(j,itori,itori1)
4314 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4315 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4319 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4320 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4321 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4322 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4323 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4325 ! 6/20/98 - dihedral angle constraints
4328 itori=idih_constr(i)
4331 if (difi.gt.drange(i)) then
4333 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4334 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4335 else if (difi.lt.-drange(i)) then
4337 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4338 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4340 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4341 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4343 ! write (iout,*) 'edihcnstr',edihcnstr
4346 c------------------------------------------------------------------------------
4348 subroutine etor(etors,edihcnstr,fact)
4349 implicit real*8 (a-h,o-z)
4350 include 'DIMENSIONS'
4351 include 'DIMENSIONS.ZSCOPT'
4352 include 'COMMON.VAR'
4353 include 'COMMON.GEO'
4354 include 'COMMON.LOCAL'
4355 include 'COMMON.TORSION'
4356 include 'COMMON.INTERACT'
4357 include 'COMMON.DERIV'
4358 include 'COMMON.CHAIN'
4359 include 'COMMON.NAMES'
4360 include 'COMMON.IOUNITS'
4361 include 'COMMON.FFIELD'
4362 include 'COMMON.TORCNSTR'
4364 C Set lprn=.true. for debugging
4368 do i=iphi_start,iphi_end
4369 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4370 itori=itortyp(itype(i-2))
4371 itori1=itortyp(itype(i-1))
4374 C Regular cosine and sine terms
4375 do j=1,nterm(itori,itori1)
4376 v1ij=v1(j,itori,itori1)
4377 v2ij=v2(j,itori,itori1)
4380 etors=etors+v1ij*cosphi+v2ij*sinphi
4381 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4385 C E = SUM ----------------------------------- - v1
4386 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4388 cosphi=dcos(0.5d0*phii)
4389 sinphi=dsin(0.5d0*phii)
4390 do j=1,nlor(itori,itori1)
4391 vl1ij=vlor1(j,itori,itori1)
4392 vl2ij=vlor2(j,itori,itori1)
4393 vl3ij=vlor3(j,itori,itori1)
4394 pom=vl2ij*cosphi+vl3ij*sinphi
4395 pom1=1.0d0/(pom*pom+1.0d0)
4396 etors=etors+vl1ij*pom1
4398 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4400 C Subtract the constant term
4401 etors=etors-v0(itori,itori1)
4403 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4404 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4405 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4406 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4407 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4410 ! 6/20/98 - dihedral angle constraints
4413 itori=idih_constr(i)
4415 difi=pinorm(phii-phi0(i))
4417 if (difi.gt.drange(i)) then
4419 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4420 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4421 edihi=0.25d0*ftors*difi**4
4422 else if (difi.lt.-drange(i)) then
4424 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4425 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4426 edihi=0.25d0*ftors*difi**4
4430 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4432 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4433 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4435 ! write (iout,*) 'edihcnstr',edihcnstr
4438 c----------------------------------------------------------------------------
4439 subroutine etor_d(etors_d,fact2)
4440 C 6/23/01 Compute double torsional energy
4441 implicit real*8 (a-h,o-z)
4442 include 'DIMENSIONS'
4443 include 'DIMENSIONS.ZSCOPT'
4444 include 'COMMON.VAR'
4445 include 'COMMON.GEO'
4446 include 'COMMON.LOCAL'
4447 include 'COMMON.TORSION'
4448 include 'COMMON.INTERACT'
4449 include 'COMMON.DERIV'
4450 include 'COMMON.CHAIN'
4451 include 'COMMON.NAMES'
4452 include 'COMMON.IOUNITS'
4453 include 'COMMON.FFIELD'
4454 include 'COMMON.TORCNSTR'
4456 C Set lprn=.true. for debugging
4460 do i=iphi_start,iphi_end-1
4461 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4463 itori=itortyp(itype(i-2))
4464 itori1=itortyp(itype(i-1))
4465 itori2=itortyp(itype(i))
4470 C Regular cosine and sine terms
4471 do j=1,ntermd_1(itori,itori1,itori2)
4472 v1cij=v1c(1,j,itori,itori1,itori2)
4473 v1sij=v1s(1,j,itori,itori1,itori2)
4474 v2cij=v1c(2,j,itori,itori1,itori2)
4475 v2sij=v1s(2,j,itori,itori1,itori2)
4476 cosphi1=dcos(j*phii)
4477 sinphi1=dsin(j*phii)
4478 cosphi2=dcos(j*phii1)
4479 sinphi2=dsin(j*phii1)
4480 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4481 & v2cij*cosphi2+v2sij*sinphi2
4482 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4483 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4485 do k=2,ntermd_2(itori,itori1,itori2)
4487 v1cdij = v2c(k,l,itori,itori1,itori2)
4488 v2cdij = v2c(l,k,itori,itori1,itori2)
4489 v1sdij = v2s(k,l,itori,itori1,itori2)
4490 v2sdij = v2s(l,k,itori,itori1,itori2)
4491 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4492 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4493 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4494 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4495 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4496 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4497 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4498 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4499 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4500 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4503 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4504 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4510 c------------------------------------------------------------------------------
4511 subroutine eback_sc_corr(esccor)
4512 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4513 c conformational states; temporarily implemented as differences
4514 c between UNRES torsional potentials (dependent on three types of
4515 c residues) and the torsional potentials dependent on all 20 types
4516 c of residues computed from AM1 energy surfaces of terminally-blocked
4517 c amino-acid residues.
4518 implicit real*8 (a-h,o-z)
4519 include 'DIMENSIONS'
4520 include 'DIMENSIONS.ZSCOPT'
4521 include 'COMMON.VAR'
4522 include 'COMMON.GEO'
4523 include 'COMMON.LOCAL'
4524 include 'COMMON.TORSION'
4525 include 'COMMON.SCCOR'
4526 include 'COMMON.INTERACT'
4527 include 'COMMON.DERIV'
4528 include 'COMMON.CHAIN'
4529 include 'COMMON.NAMES'
4530 include 'COMMON.IOUNITS'
4531 include 'COMMON.FFIELD'
4532 include 'COMMON.CONTROL'
4534 C Set lprn=.true. for debugging
4537 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4539 do i=itau_start,itau_end
4541 isccori=isccortyp(itype(i-2))
4542 isccori1=isccortyp(itype(i-1))
4544 cccc Added 9 May 2012
4545 cc Tauangle is torsional engle depending on the value of first digit
4546 c(see comment below)
4547 cc Omicron is flat angle depending on the value of first digit
4548 c(see comment below)
4551 do intertyp=1,3 !intertyp
4552 cc Added 09 May 2012 (Adasko)
4553 cc Intertyp means interaction type of backbone mainchain correlation:
4554 c 1 = SC...Ca...Ca...Ca
4555 c 2 = Ca...Ca...Ca...SC
4556 c 3 = SC...Ca...Ca...SCi
4558 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4559 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4560 & (itype(i-1).eq.21)))
4561 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4562 & .or.(itype(i-2).eq.21)))
4563 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4564 & (itype(i-1).eq.21)))) cycle
4565 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4566 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4568 do j=1,nterm_sccor(isccori,isccori1)
4569 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4570 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4571 cosphi=dcos(j*tauangle(intertyp,i))
4572 sinphi=dsin(j*tauangle(intertyp,i))
4573 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4574 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4576 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4577 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4578 c &gloc_sc(intertyp,i-3,icg)
4580 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4581 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4582 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4583 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4584 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4588 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4592 c------------------------------------------------------------------------------
4593 subroutine multibody(ecorr)
4594 C This subroutine calculates multi-body contributions to energy following
4595 C the idea of Skolnick et al. If side chains I and J make a contact and
4596 C at the same time side chains I+1 and J+1 make a contact, an extra
4597 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4598 implicit real*8 (a-h,o-z)
4599 include 'DIMENSIONS'
4600 include 'COMMON.IOUNITS'
4601 include 'COMMON.DERIV'
4602 include 'COMMON.INTERACT'
4603 include 'COMMON.CONTACTS'
4604 double precision gx(3),gx1(3)
4607 C Set lprn=.true. for debugging
4611 write (iout,'(a)') 'Contact function values:'
4613 write (iout,'(i2,20(1x,i2,f10.5))')
4614 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4629 num_conti=num_cont(i)
4630 num_conti1=num_cont(i1)
4635 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4636 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4637 cd & ' ishift=',ishift
4638 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4639 C The system gains extra energy.
4640 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4641 endif ! j1==j+-ishift
4650 c------------------------------------------------------------------------------
4651 double precision function esccorr(i,j,k,l,jj,kk)
4652 implicit real*8 (a-h,o-z)
4653 include 'DIMENSIONS'
4654 include 'COMMON.IOUNITS'
4655 include 'COMMON.DERIV'
4656 include 'COMMON.INTERACT'
4657 include 'COMMON.CONTACTS'
4658 double precision gx(3),gx1(3)
4663 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4664 C Calculate the multi-body contribution to energy.
4665 C Calculate multi-body contributions to the gradient.
4666 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4667 cd & k,l,(gacont(m,kk,k),m=1,3)
4669 gx(m) =ekl*gacont(m,jj,i)
4670 gx1(m)=eij*gacont(m,kk,k)
4671 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4672 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4673 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4674 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4678 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4683 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4689 c------------------------------------------------------------------------------
4691 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4692 implicit real*8 (a-h,o-z)
4693 include 'DIMENSIONS'
4694 integer dimen1,dimen2,atom,indx
4695 double precision buffer(dimen1,dimen2)
4696 double precision zapas
4697 common /contacts_hb/ zapas(3,20,maxres,7),
4698 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4699 & num_cont_hb(maxres),jcont_hb(20,maxres)
4700 num_kont=num_cont_hb(atom)
4704 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4707 buffer(i,indx+22)=facont_hb(i,atom)
4708 buffer(i,indx+23)=ees0p(i,atom)
4709 buffer(i,indx+24)=ees0m(i,atom)
4710 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4712 buffer(1,indx+26)=dfloat(num_kont)
4715 c------------------------------------------------------------------------------
4716 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4717 implicit real*8 (a-h,o-z)
4718 include 'DIMENSIONS'
4719 integer dimen1,dimen2,atom,indx
4720 double precision buffer(dimen1,dimen2)
4721 double precision zapas
4722 common /contacts_hb/ zapas(3,20,maxres,7),
4723 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4724 & num_cont_hb(maxres),jcont_hb(20,maxres)
4725 num_kont=buffer(1,indx+26)
4726 num_kont_old=num_cont_hb(atom)
4727 num_cont_hb(atom)=num_kont+num_kont_old
4732 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4735 facont_hb(ii,atom)=buffer(i,indx+22)
4736 ees0p(ii,atom)=buffer(i,indx+23)
4737 ees0m(ii,atom)=buffer(i,indx+24)
4738 jcont_hb(ii,atom)=buffer(i,indx+25)
4742 c------------------------------------------------------------------------------
4744 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4745 C This subroutine calculates multi-body contributions to hydrogen-bonding
4746 implicit real*8 (a-h,o-z)
4747 include 'DIMENSIONS'
4748 include 'DIMENSIONS.ZSCOPT'
4749 include 'COMMON.IOUNITS'
4751 include 'COMMON.INFO'
4753 include 'COMMON.FFIELD'
4754 include 'COMMON.DERIV'
4755 include 'COMMON.INTERACT'
4756 include 'COMMON.CONTACTS'
4758 parameter (max_cont=maxconts)
4759 parameter (max_dim=2*(8*3+2))
4760 parameter (msglen1=max_cont*max_dim*4)
4761 parameter (msglen2=2*msglen1)
4762 integer source,CorrelType,CorrelID,Error
4763 double precision buffer(max_cont,max_dim)
4765 double precision gx(3),gx1(3)
4768 C Set lprn=.true. for debugging
4773 if (fgProcs.le.1) goto 30
4775 write (iout,'(a)') 'Contact function values:'
4777 write (iout,'(2i3,50(1x,i2,f5.2))')
4778 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4779 & j=1,num_cont_hb(i))
4782 C Caution! Following code assumes that electrostatic interactions concerning
4783 C a given atom are split among at most two processors!
4793 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4796 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4797 if (MyRank.gt.0) then
4798 C Send correlation contributions to the preceding processor
4800 nn=num_cont_hb(iatel_s)
4801 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4802 cd write (iout,*) 'The BUFFER array:'
4804 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4806 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4808 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4809 C Clear the contacts of the atom passed to the neighboring processor
4810 nn=num_cont_hb(iatel_s+1)
4812 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4814 num_cont_hb(iatel_s)=0
4816 cd write (iout,*) 'Processor ',MyID,MyRank,
4817 cd & ' is sending correlation contribution to processor',MyID-1,
4818 cd & ' msglen=',msglen
4819 cd write (*,*) 'Processor ',MyID,MyRank,
4820 cd & ' is sending correlation contribution to processor',MyID-1,
4821 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4822 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4823 cd write (iout,*) 'Processor ',MyID,
4824 cd & ' has sent correlation contribution to processor',MyID-1,
4825 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4826 cd write (*,*) 'Processor ',MyID,
4827 cd & ' has sent correlation contribution to processor',MyID-1,
4828 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4830 endif ! (MyRank.gt.0)
4834 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4835 if (MyRank.lt.fgProcs-1) then
4836 C Receive correlation contributions from the next processor
4838 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4839 cd write (iout,*) 'Processor',MyID,
4840 cd & ' is receiving correlation contribution from processor',MyID+1,
4841 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4842 cd write (*,*) 'Processor',MyID,
4843 cd & ' is receiving correlation contribution from processor',MyID+1,
4844 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4846 do while (nbytes.le.0)
4847 call mp_probe(MyID+1,CorrelType,nbytes)
4849 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4850 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4851 cd write (iout,*) 'Processor',MyID,
4852 cd & ' has received correlation contribution from processor',MyID+1,
4853 cd & ' msglen=',msglen,' nbytes=',nbytes
4854 cd write (iout,*) 'The received BUFFER array:'
4856 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4858 if (msglen.eq.msglen1) then
4859 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4860 else if (msglen.eq.msglen2) then
4861 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4862 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4865 & 'ERROR!!!! message length changed while processing correlations.'
4867 & 'ERROR!!!! message length changed while processing correlations.'
4868 call mp_stopall(Error)
4869 endif ! msglen.eq.msglen1
4870 endif ! MyRank.lt.fgProcs-1
4877 write (iout,'(a)') 'Contact function values:'
4879 write (iout,'(2i3,50(1x,i2,f5.2))')
4880 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4881 & j=1,num_cont_hb(i))
4885 C Remove the loop below after debugging !!!
4892 C Calculate the local-electrostatic correlation terms
4893 do i=iatel_s,iatel_e+1
4895 num_conti=num_cont_hb(i)
4896 num_conti1=num_cont_hb(i+1)
4901 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4902 c & ' jj=',jj,' kk=',kk
4903 if (j1.eq.j+1 .or. j1.eq.j-1) then
4904 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4905 C The system gains extra energy.
4906 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4908 else if (j1.eq.j) then
4909 C Contacts I-J and I-(J+1) occur simultaneously.
4910 C The system loses extra energy.
4911 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4916 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4917 c & ' jj=',jj,' kk=',kk
4919 C Contacts I-J and (I+1)-J occur simultaneously.
4920 C The system loses extra energy.
4921 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4928 c------------------------------------------------------------------------------
4929 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4931 C This subroutine calculates multi-body contributions to hydrogen-bonding
4932 implicit real*8 (a-h,o-z)
4933 include 'DIMENSIONS'
4934 include 'DIMENSIONS.ZSCOPT'
4935 include 'COMMON.IOUNITS'
4937 include 'COMMON.INFO'
4939 include 'COMMON.FFIELD'
4940 include 'COMMON.DERIV'
4941 include 'COMMON.INTERACT'
4942 include 'COMMON.CONTACTS'
4944 parameter (max_cont=maxconts)
4945 parameter (max_dim=2*(8*3+2))
4946 parameter (msglen1=max_cont*max_dim*4)
4947 parameter (msglen2=2*msglen1)
4948 integer source,CorrelType,CorrelID,Error
4949 double precision buffer(max_cont,max_dim)
4951 double precision gx(3),gx1(3)
4954 C Set lprn=.true. for debugging
4960 if (fgProcs.le.1) goto 30
4962 write (iout,'(a)') 'Contact function values:'
4964 write (iout,'(2i3,50(1x,i2,f5.2))')
4965 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4966 & j=1,num_cont_hb(i))
4969 C Caution! Following code assumes that electrostatic interactions concerning
4970 C a given atom are split among at most two processors!
4980 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4983 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4984 if (MyRank.gt.0) then
4985 C Send correlation contributions to the preceding processor
4987 nn=num_cont_hb(iatel_s)
4988 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4989 cd write (iout,*) 'The BUFFER array:'
4991 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4993 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4995 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4996 C Clear the contacts of the atom passed to the neighboring processor
4997 nn=num_cont_hb(iatel_s+1)
4999 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5001 num_cont_hb(iatel_s)=0
5003 cd write (iout,*) 'Processor ',MyID,MyRank,
5004 cd & ' is sending correlation contribution to processor',MyID-1,
5005 cd & ' msglen=',msglen
5006 cd write (*,*) 'Processor ',MyID,MyRank,
5007 cd & ' is sending correlation contribution to processor',MyID-1,
5008 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5009 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5010 cd write (iout,*) 'Processor ',MyID,
5011 cd & ' has sent correlation contribution to processor',MyID-1,
5012 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5013 cd write (*,*) 'Processor ',MyID,
5014 cd & ' has sent correlation contribution to processor',MyID-1,
5015 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5017 endif ! (MyRank.gt.0)
5021 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5022 if (MyRank.lt.fgProcs-1) then
5023 C Receive correlation contributions from the next processor
5025 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5026 cd write (iout,*) 'Processor',MyID,
5027 cd & ' is receiving correlation contribution from processor',MyID+1,
5028 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5029 cd write (*,*) 'Processor',MyID,
5030 cd & ' is receiving correlation contribution from processor',MyID+1,
5031 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5033 do while (nbytes.le.0)
5034 call mp_probe(MyID+1,CorrelType,nbytes)
5036 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5037 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5038 cd write (iout,*) 'Processor',MyID,
5039 cd & ' has received correlation contribution from processor',MyID+1,
5040 cd & ' msglen=',msglen,' nbytes=',nbytes
5041 cd write (iout,*) 'The received BUFFER array:'
5043 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5045 if (msglen.eq.msglen1) then
5046 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5047 else if (msglen.eq.msglen2) then
5048 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5049 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5052 & 'ERROR!!!! message length changed while processing correlations.'
5054 & 'ERROR!!!! message length changed while processing correlations.'
5055 call mp_stopall(Error)
5056 endif ! msglen.eq.msglen1
5057 endif ! MyRank.lt.fgProcs-1
5064 write (iout,'(a)') 'Contact function values:'
5066 write (iout,'(2i3,50(1x,i2,f5.2))')
5067 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5068 & j=1,num_cont_hb(i))
5074 C Remove the loop below after debugging !!!
5081 C Calculate the dipole-dipole interaction energies
5082 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5083 do i=iatel_s,iatel_e+1
5084 num_conti=num_cont_hb(i)
5091 C Calculate the local-electrostatic correlation terms
5092 do i=iatel_s,iatel_e+1
5094 num_conti=num_cont_hb(i)
5095 num_conti1=num_cont_hb(i+1)
5100 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5101 c & ' jj=',jj,' kk=',kk
5102 if (j1.eq.j+1 .or. j1.eq.j-1) then
5103 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5104 C The system gains extra energy.
5106 sqd1=dsqrt(d_cont(jj,i))
5107 sqd2=dsqrt(d_cont(kk,i1))
5108 sred_geom = sqd1*sqd2
5109 IF (sred_geom.lt.cutoff_corr) THEN
5110 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5112 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5113 c & ' jj=',jj,' kk=',kk
5114 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5115 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5117 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5118 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5121 cd write (iout,*) 'sred_geom=',sred_geom,
5122 cd & ' ekont=',ekont,' fprim=',fprimcont
5123 call calc_eello(i,j,i+1,j1,jj,kk)
5124 if (wcorr4.gt.0.0d0)
5125 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5126 if (wcorr5.gt.0.0d0)
5127 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5128 c print *,"wcorr5",ecorr5
5129 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5130 cd write(2,*)'ijkl',i,j,i+1,j1
5131 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5132 & .or. wturn6.eq.0.0d0))then
5133 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5134 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5135 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5136 cd & 'ecorr6=',ecorr6
5137 cd write (iout,'(4e15.5)') sred_geom,
5138 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5139 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5140 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5141 else if (wturn6.gt.0.0d0
5142 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5143 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5144 eturn6=eturn6+eello_turn6(i,jj,kk)
5145 cd write (2,*) 'multibody_eello:eturn6',eturn6
5149 else if (j1.eq.j) then
5150 C Contacts I-J and I-(J+1) occur simultaneously.
5151 C The system loses extra energy.
5152 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5157 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5158 c & ' jj=',jj,' kk=',kk
5160 C Contacts I-J and (I+1)-J occur simultaneously.
5161 C The system loses extra energy.
5162 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5169 c------------------------------------------------------------------------------
5170 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5171 implicit real*8 (a-h,o-z)
5172 include 'DIMENSIONS'
5173 include 'COMMON.IOUNITS'
5174 include 'COMMON.DERIV'
5175 include 'COMMON.INTERACT'
5176 include 'COMMON.CONTACTS'
5177 double precision gx(3),gx1(3)
5187 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5188 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5189 C Following 4 lines for diagnostics.
5194 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5196 c write (iout,*)'Contacts have occurred for peptide groups',
5197 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5198 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5199 C Calculate the multi-body contribution to energy.
5200 ecorr=ecorr+ekont*ees
5202 C Calculate multi-body contributions to the gradient.
5204 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5205 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5206 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5207 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5208 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5209 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5210 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5211 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5212 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5213 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5214 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5215 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5216 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5217 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5221 gradcorr(ll,m)=gradcorr(ll,m)+
5222 & ees*ekl*gacont_hbr(ll,jj,i)-
5223 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5224 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5229 gradcorr(ll,m)=gradcorr(ll,m)+
5230 & ees*eij*gacont_hbr(ll,kk,k)-
5231 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5232 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5239 C---------------------------------------------------------------------------
5240 subroutine dipole(i,j,jj)
5241 implicit real*8 (a-h,o-z)
5242 include 'DIMENSIONS'
5243 include 'DIMENSIONS.ZSCOPT'
5244 include 'COMMON.IOUNITS'
5245 include 'COMMON.CHAIN'
5246 include 'COMMON.FFIELD'
5247 include 'COMMON.DERIV'
5248 include 'COMMON.INTERACT'
5249 include 'COMMON.CONTACTS'
5250 include 'COMMON.TORSION'
5251 include 'COMMON.VAR'
5252 include 'COMMON.GEO'
5253 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5255 iti1 = itortyp(itype(i+1))
5256 if (j.lt.nres-1) then
5257 itj1 = itortyp(itype(j+1))
5262 dipi(iii,1)=Ub2(iii,i)
5263 dipderi(iii)=Ub2der(iii,i)
5264 dipi(iii,2)=b1(iii,iti1)
5265 dipj(iii,1)=Ub2(iii,j)
5266 dipderj(iii)=Ub2der(iii,j)
5267 dipj(iii,2)=b1(iii,itj1)
5271 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5274 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5277 if (.not.calc_grad) return
5282 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5286 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5291 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5292 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5294 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5296 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5298 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5302 C---------------------------------------------------------------------------
5303 subroutine calc_eello(i,j,k,l,jj,kk)
5305 C This subroutine computes matrices and vectors needed to calculate
5306 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5308 implicit real*8 (a-h,o-z)
5309 include 'DIMENSIONS'
5310 include 'DIMENSIONS.ZSCOPT'
5311 include 'COMMON.IOUNITS'
5312 include 'COMMON.CHAIN'
5313 include 'COMMON.DERIV'
5314 include 'COMMON.INTERACT'
5315 include 'COMMON.CONTACTS'
5316 include 'COMMON.TORSION'
5317 include 'COMMON.VAR'
5318 include 'COMMON.GEO'
5319 include 'COMMON.FFIELD'
5320 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5321 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5324 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5325 cd & ' jj=',jj,' kk=',kk
5326 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5329 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5330 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5333 call transpose2(aa1(1,1),aa1t(1,1))
5334 call transpose2(aa2(1,1),aa2t(1,1))
5337 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5338 & aa1tder(1,1,lll,kkk))
5339 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5340 & aa2tder(1,1,lll,kkk))
5344 C parallel orientation of the two CA-CA-CA frames.
5346 iti=itortyp(itype(i))
5350 itk1=itortyp(itype(k+1))
5351 itj=itortyp(itype(j))
5352 if (l.lt.nres-1) then
5353 itl1=itortyp(itype(l+1))
5357 C A1 kernel(j+1) A2T
5359 cd write (iout,'(3f10.5,5x,3f10.5)')
5360 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5362 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5363 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5364 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5365 C Following matrices are needed only for 6-th order cumulants
5366 IF (wcorr6.gt.0.0d0) THEN
5367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5368 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5369 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5370 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5371 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5372 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5373 & ADtEAderx(1,1,1,1,1,1))
5375 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5376 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5377 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5378 & ADtEA1derx(1,1,1,1,1,1))
5380 C End 6-th order cumulants
5383 cd write (2,*) 'In calc_eello6'
5385 cd write (2,*) 'iii=',iii
5387 cd write (2,*) 'kkk=',kkk
5389 cd write (2,'(3(2f10.5),5x)')
5390 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5395 call transpose2(EUgder(1,1,k),auxmat(1,1))
5396 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5397 call transpose2(EUg(1,1,k),auxmat(1,1))
5398 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5399 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5403 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5404 & EAEAderx(1,1,lll,kkk,iii,1))
5408 C A1T kernel(i+1) A2
5409 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5410 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5411 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5412 C Following matrices are needed only for 6-th order cumulants
5413 IF (wcorr6.gt.0.0d0) THEN
5414 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5415 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5416 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5417 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5418 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5419 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5420 & ADtEAderx(1,1,1,1,1,2))
5421 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5422 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5423 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5424 & ADtEA1derx(1,1,1,1,1,2))
5426 C End 6-th order cumulants
5427 call transpose2(EUgder(1,1,l),auxmat(1,1))
5428 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5429 call transpose2(EUg(1,1,l),auxmat(1,1))
5430 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5431 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5435 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5436 & EAEAderx(1,1,lll,kkk,iii,2))
5441 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5442 C They are needed only when the fifth- or the sixth-order cumulants are
5444 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5445 call transpose2(AEA(1,1,1),auxmat(1,1))
5446 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5447 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5448 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5449 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5450 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5451 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5452 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5453 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5454 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5455 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5456 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5457 call transpose2(AEA(1,1,2),auxmat(1,1))
5458 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5459 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5460 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5461 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5462 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5463 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5464 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5465 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5466 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5467 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5468 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5469 C Calculate the Cartesian derivatives of the vectors.
5473 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5474 call matvec2(auxmat(1,1),b1(1,iti),
5475 & AEAb1derx(1,lll,kkk,iii,1,1))
5476 call matvec2(auxmat(1,1),Ub2(1,i),
5477 & AEAb2derx(1,lll,kkk,iii,1,1))
5478 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5479 & AEAb1derx(1,lll,kkk,iii,2,1))
5480 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5481 & AEAb2derx(1,lll,kkk,iii,2,1))
5482 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5483 call matvec2(auxmat(1,1),b1(1,itj),
5484 & AEAb1derx(1,lll,kkk,iii,1,2))
5485 call matvec2(auxmat(1,1),Ub2(1,j),
5486 & AEAb2derx(1,lll,kkk,iii,1,2))
5487 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5488 & AEAb1derx(1,lll,kkk,iii,2,2))
5489 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5490 & AEAb2derx(1,lll,kkk,iii,2,2))
5497 C Antiparallel orientation of the two CA-CA-CA frames.
5499 iti=itortyp(itype(i))
5503 itk1=itortyp(itype(k+1))
5504 itl=itortyp(itype(l))
5505 itj=itortyp(itype(j))
5506 if (j.lt.nres-1) then
5507 itj1=itortyp(itype(j+1))
5511 C A2 kernel(j-1)T A1T
5512 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5513 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5514 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5515 C Following matrices are needed only for 6-th order cumulants
5516 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5517 & j.eq.i+4 .and. l.eq.i+3)) THEN
5518 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5519 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5520 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5521 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5522 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5523 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5524 & ADtEAderx(1,1,1,1,1,1))
5525 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5526 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5527 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5528 & ADtEA1derx(1,1,1,1,1,1))
5530 C End 6-th order cumulants
5531 call transpose2(EUgder(1,1,k),auxmat(1,1))
5532 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5533 call transpose2(EUg(1,1,k),auxmat(1,1))
5534 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5535 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5539 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5540 & EAEAderx(1,1,lll,kkk,iii,1))
5544 C A2T kernel(i+1)T A1
5545 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5546 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5547 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5548 C Following matrices are needed only for 6-th order cumulants
5549 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5550 & j.eq.i+4 .and. l.eq.i+3)) THEN
5551 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5552 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5553 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5554 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5555 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5556 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5557 & ADtEAderx(1,1,1,1,1,2))
5558 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5559 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5560 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5561 & ADtEA1derx(1,1,1,1,1,2))
5563 C End 6-th order cumulants
5564 call transpose2(EUgder(1,1,j),auxmat(1,1))
5565 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5566 call transpose2(EUg(1,1,j),auxmat(1,1))
5567 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5568 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5572 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5573 & EAEAderx(1,1,lll,kkk,iii,2))
5578 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5579 C They are needed only when the fifth- or the sixth-order cumulants are
5581 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5582 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5583 call transpose2(AEA(1,1,1),auxmat(1,1))
5584 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5585 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5586 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5587 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5588 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5589 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5590 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5591 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5592 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5593 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5594 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5595 call transpose2(AEA(1,1,2),auxmat(1,1))
5596 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5597 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5598 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5599 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5600 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5601 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5602 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5603 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5604 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5605 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5606 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5607 C Calculate the Cartesian derivatives of the vectors.
5611 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5612 call matvec2(auxmat(1,1),b1(1,iti),
5613 & AEAb1derx(1,lll,kkk,iii,1,1))
5614 call matvec2(auxmat(1,1),Ub2(1,i),
5615 & AEAb2derx(1,lll,kkk,iii,1,1))
5616 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5617 & AEAb1derx(1,lll,kkk,iii,2,1))
5618 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5619 & AEAb2derx(1,lll,kkk,iii,2,1))
5620 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5621 call matvec2(auxmat(1,1),b1(1,itl),
5622 & AEAb1derx(1,lll,kkk,iii,1,2))
5623 call matvec2(auxmat(1,1),Ub2(1,l),
5624 & AEAb2derx(1,lll,kkk,iii,1,2))
5625 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5626 & AEAb1derx(1,lll,kkk,iii,2,2))
5627 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5628 & AEAb2derx(1,lll,kkk,iii,2,2))
5637 C---------------------------------------------------------------------------
5638 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5639 & KK,KKderg,AKA,AKAderg,AKAderx)
5643 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5644 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5645 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5650 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5652 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5655 cd if (lprn) write (2,*) 'In kernel'
5657 cd if (lprn) write (2,*) 'kkk=',kkk
5659 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5660 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5662 cd write (2,*) 'lll=',lll
5663 cd write (2,*) 'iii=1'
5665 cd write (2,'(3(2f10.5),5x)')
5666 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5669 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5670 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5672 cd write (2,*) 'lll=',lll
5673 cd write (2,*) 'iii=2'
5675 cd write (2,'(3(2f10.5),5x)')
5676 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5683 C---------------------------------------------------------------------------
5684 double precision function eello4(i,j,k,l,jj,kk)
5685 implicit real*8 (a-h,o-z)
5686 include 'DIMENSIONS'
5687 include 'DIMENSIONS.ZSCOPT'
5688 include 'COMMON.IOUNITS'
5689 include 'COMMON.CHAIN'
5690 include 'COMMON.DERIV'
5691 include 'COMMON.INTERACT'
5692 include 'COMMON.CONTACTS'
5693 include 'COMMON.TORSION'
5694 include 'COMMON.VAR'
5695 include 'COMMON.GEO'
5696 double precision pizda(2,2),ggg1(3),ggg2(3)
5697 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5701 cd print *,'eello4:',i,j,k,l,jj,kk
5702 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5703 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5704 cold eij=facont_hb(jj,i)
5705 cold ekl=facont_hb(kk,k)
5707 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5709 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5710 gcorr_loc(k-1)=gcorr_loc(k-1)
5711 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5713 gcorr_loc(l-1)=gcorr_loc(l-1)
5714 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5716 gcorr_loc(j-1)=gcorr_loc(j-1)
5717 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5722 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5723 & -EAEAderx(2,2,lll,kkk,iii,1)
5724 cd derx(lll,kkk,iii)=0.0d0
5728 cd gcorr_loc(l-1)=0.0d0
5729 cd gcorr_loc(j-1)=0.0d0
5730 cd gcorr_loc(k-1)=0.0d0
5732 cd write (iout,*)'Contacts have occurred for peptide groups',
5733 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5734 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5735 if (j.lt.nres-1) then
5742 if (l.lt.nres-1) then
5750 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5751 ggg1(ll)=eel4*g_contij(ll,1)
5752 ggg2(ll)=eel4*g_contij(ll,2)
5753 ghalf=0.5d0*ggg1(ll)
5755 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5756 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5757 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5758 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5759 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5760 ghalf=0.5d0*ggg2(ll)
5762 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5763 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5764 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5765 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5770 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5771 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5776 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5777 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5783 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5788 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5792 cd write (2,*) iii,gcorr_loc(iii)
5796 cd write (2,*) 'ekont',ekont
5797 cd write (iout,*) 'eello4',ekont*eel4
5800 C---------------------------------------------------------------------------
5801 double precision function eello5(i,j,k,l,jj,kk)
5802 implicit real*8 (a-h,o-z)
5803 include 'DIMENSIONS'
5804 include 'DIMENSIONS.ZSCOPT'
5805 include 'COMMON.IOUNITS'
5806 include 'COMMON.CHAIN'
5807 include 'COMMON.DERIV'
5808 include 'COMMON.INTERACT'
5809 include 'COMMON.CONTACTS'
5810 include 'COMMON.TORSION'
5811 include 'COMMON.VAR'
5812 include 'COMMON.GEO'
5813 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5814 double precision ggg1(3),ggg2(3)
5815 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5820 C /l\ / \ \ / \ / \ / C
5821 C / \ / \ \ / \ / \ / C
5822 C j| o |l1 | o | o| o | | o |o C
5823 C \ |/k\| |/ \| / |/ \| |/ \| C
5824 C \i/ \ / \ / / \ / \ C
5826 C (I) (II) (III) (IV) C
5828 C eello5_1 eello5_2 eello5_3 eello5_4 C
5830 C Antiparallel chains C
5833 C /j\ / \ \ / \ / \ / C
5834 C / \ / \ \ / \ / \ / C
5835 C j1| o |l | o | o| o | | o |o C
5836 C \ |/k\| |/ \| / |/ \| |/ \| C
5837 C \i/ \ / \ / / \ / \ C
5839 C (I) (II) (III) (IV) C
5841 C eello5_1 eello5_2 eello5_3 eello5_4 C
5843 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5846 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5851 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5853 itk=itortyp(itype(k))
5854 itl=itortyp(itype(l))
5855 itj=itortyp(itype(j))
5860 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5861 cd & eel5_3_num,eel5_4_num)
5865 derx(lll,kkk,iii)=0.0d0
5869 cd eij=facont_hb(jj,i)
5870 cd ekl=facont_hb(kk,k)
5872 cd write (iout,*)'Contacts have occurred for peptide groups',
5873 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5875 C Contribution from the graph I.
5876 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5877 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5878 call transpose2(EUg(1,1,k),auxmat(1,1))
5879 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5880 vv(1)=pizda(1,1)-pizda(2,2)
5881 vv(2)=pizda(1,2)+pizda(2,1)
5882 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5883 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5885 C Explicit gradient in virtual-dihedral angles.
5886 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5887 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5888 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5889 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5890 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5891 vv(1)=pizda(1,1)-pizda(2,2)
5892 vv(2)=pizda(1,2)+pizda(2,1)
5893 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5894 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5895 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5896 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5897 vv(1)=pizda(1,1)-pizda(2,2)
5898 vv(2)=pizda(1,2)+pizda(2,1)
5900 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5901 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5902 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5904 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5905 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5906 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5908 C Cartesian gradient
5912 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5914 vv(1)=pizda(1,1)-pizda(2,2)
5915 vv(2)=pizda(1,2)+pizda(2,1)
5916 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5917 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5918 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5925 C Contribution from graph II
5926 call transpose2(EE(1,1,itk),auxmat(1,1))
5927 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5928 vv(1)=pizda(1,1)+pizda(2,2)
5929 vv(2)=pizda(2,1)-pizda(1,2)
5930 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5931 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5933 C Explicit gradient in virtual-dihedral angles.
5934 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5935 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5936 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5937 vv(1)=pizda(1,1)+pizda(2,2)
5938 vv(2)=pizda(2,1)-pizda(1,2)
5940 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5941 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5942 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5944 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5945 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5946 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5948 C Cartesian gradient
5952 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5954 vv(1)=pizda(1,1)+pizda(2,2)
5955 vv(2)=pizda(2,1)-pizda(1,2)
5956 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5957 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5958 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5967 C Parallel orientation
5968 C Contribution from graph III
5969 call transpose2(EUg(1,1,l),auxmat(1,1))
5970 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5971 vv(1)=pizda(1,1)-pizda(2,2)
5972 vv(2)=pizda(1,2)+pizda(2,1)
5973 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5974 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5976 C Explicit gradient in virtual-dihedral angles.
5977 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5978 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5979 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5980 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5981 vv(1)=pizda(1,1)-pizda(2,2)
5982 vv(2)=pizda(1,2)+pizda(2,1)
5983 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5984 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5985 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5986 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5987 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5988 vv(1)=pizda(1,1)-pizda(2,2)
5989 vv(2)=pizda(1,2)+pizda(2,1)
5990 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5991 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5992 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5993 C Cartesian gradient
5997 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5999 vv(1)=pizda(1,1)-pizda(2,2)
6000 vv(2)=pizda(1,2)+pizda(2,1)
6001 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6002 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6003 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6009 C Contribution from graph IV
6011 call transpose2(EE(1,1,itl),auxmat(1,1))
6012 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6013 vv(1)=pizda(1,1)+pizda(2,2)
6014 vv(2)=pizda(2,1)-pizda(1,2)
6015 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6016 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6018 C Explicit gradient in virtual-dihedral angles.
6019 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6020 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6021 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6022 vv(1)=pizda(1,1)+pizda(2,2)
6023 vv(2)=pizda(2,1)-pizda(1,2)
6024 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6025 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6026 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6027 C Cartesian gradient
6031 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6033 vv(1)=pizda(1,1)+pizda(2,2)
6034 vv(2)=pizda(2,1)-pizda(1,2)
6035 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6036 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6037 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6043 C Antiparallel orientation
6044 C Contribution from graph III
6046 call transpose2(EUg(1,1,j),auxmat(1,1))
6047 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6048 vv(1)=pizda(1,1)-pizda(2,2)
6049 vv(2)=pizda(1,2)+pizda(2,1)
6050 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6051 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6053 C Explicit gradient in virtual-dihedral angles.
6054 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6055 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6056 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6057 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6058 vv(1)=pizda(1,1)-pizda(2,2)
6059 vv(2)=pizda(1,2)+pizda(2,1)
6060 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6061 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6062 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6063 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6064 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6065 vv(1)=pizda(1,1)-pizda(2,2)
6066 vv(2)=pizda(1,2)+pizda(2,1)
6067 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6068 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6069 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6070 C Cartesian gradient
6074 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6076 vv(1)=pizda(1,1)-pizda(2,2)
6077 vv(2)=pizda(1,2)+pizda(2,1)
6078 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6079 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6086 C Contribution from graph IV
6088 call transpose2(EE(1,1,itj),auxmat(1,1))
6089 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6090 vv(1)=pizda(1,1)+pizda(2,2)
6091 vv(2)=pizda(2,1)-pizda(1,2)
6092 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6093 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6095 C Explicit gradient in virtual-dihedral angles.
6096 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6097 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6098 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6099 vv(1)=pizda(1,1)+pizda(2,2)
6100 vv(2)=pizda(2,1)-pizda(1,2)
6101 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6102 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6103 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6104 C Cartesian gradient
6108 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6110 vv(1)=pizda(1,1)+pizda(2,2)
6111 vv(2)=pizda(2,1)-pizda(1,2)
6112 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6113 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6114 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6121 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6122 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6123 cd write (2,*) 'ijkl',i,j,k,l
6124 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6125 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6127 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6128 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6129 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6130 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6132 if (j.lt.nres-1) then
6139 if (l.lt.nres-1) then
6149 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6151 ggg1(ll)=eel5*g_contij(ll,1)
6152 ggg2(ll)=eel5*g_contij(ll,2)
6153 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6154 ghalf=0.5d0*ggg1(ll)
6156 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6157 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6158 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6159 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6160 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6161 ghalf=0.5d0*ggg2(ll)
6163 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6164 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6165 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6166 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6171 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6172 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6177 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6178 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6184 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6189 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6193 cd write (2,*) iii,g_corr5_loc(iii)
6197 cd write (2,*) 'ekont',ekont
6198 cd write (iout,*) 'eello5',ekont*eel5
6201 c--------------------------------------------------------------------------
6202 double precision function eello6(i,j,k,l,jj,kk)
6203 implicit real*8 (a-h,o-z)
6204 include 'DIMENSIONS'
6205 include 'DIMENSIONS.ZSCOPT'
6206 include 'COMMON.IOUNITS'
6207 include 'COMMON.CHAIN'
6208 include 'COMMON.DERIV'
6209 include 'COMMON.INTERACT'
6210 include 'COMMON.CONTACTS'
6211 include 'COMMON.TORSION'
6212 include 'COMMON.VAR'
6213 include 'COMMON.GEO'
6214 include 'COMMON.FFIELD'
6215 double precision ggg1(3),ggg2(3)
6216 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6221 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6229 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6230 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6234 derx(lll,kkk,iii)=0.0d0
6238 cd eij=facont_hb(jj,i)
6239 cd ekl=facont_hb(kk,k)
6245 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6246 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6247 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6248 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6249 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6250 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6252 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6253 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6254 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6255 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6256 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6257 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6261 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6263 C If turn contributions are considered, they will be handled separately.
6264 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6265 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6266 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6267 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6268 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6269 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6270 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6273 if (j.lt.nres-1) then
6280 if (l.lt.nres-1) then
6288 ggg1(ll)=eel6*g_contij(ll,1)
6289 ggg2(ll)=eel6*g_contij(ll,2)
6290 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6291 ghalf=0.5d0*ggg1(ll)
6293 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6294 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6295 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6296 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6297 ghalf=0.5d0*ggg2(ll)
6298 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6300 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6301 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6302 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6303 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6308 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6309 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6314 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6315 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6321 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6326 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6330 cd write (2,*) iii,g_corr6_loc(iii)
6334 cd write (2,*) 'ekont',ekont
6335 cd write (iout,*) 'eello6',ekont*eel6
6338 c--------------------------------------------------------------------------
6339 double precision function eello6_graph1(i,j,k,l,imat,swap)
6340 implicit real*8 (a-h,o-z)
6341 include 'DIMENSIONS'
6342 include 'DIMENSIONS.ZSCOPT'
6343 include 'COMMON.IOUNITS'
6344 include 'COMMON.CHAIN'
6345 include 'COMMON.DERIV'
6346 include 'COMMON.INTERACT'
6347 include 'COMMON.CONTACTS'
6348 include 'COMMON.TORSION'
6349 include 'COMMON.VAR'
6350 include 'COMMON.GEO'
6351 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6355 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6357 C Parallel Antiparallel C
6363 C \ j|/k\| / \ |/k\|l / C
6368 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6369 itk=itortyp(itype(k))
6370 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6371 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6372 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6373 call transpose2(EUgC(1,1,k),auxmat(1,1))
6374 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6375 vv1(1)=pizda1(1,1)-pizda1(2,2)
6376 vv1(2)=pizda1(1,2)+pizda1(2,1)
6377 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6378 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6379 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6380 s5=scalar2(vv(1),Dtobr2(1,i))
6381 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6382 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6383 if (.not. calc_grad) return
6384 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6385 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6386 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6387 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6388 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6389 & +scalar2(vv(1),Dtobr2der(1,i)))
6390 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6391 vv1(1)=pizda1(1,1)-pizda1(2,2)
6392 vv1(2)=pizda1(1,2)+pizda1(2,1)
6393 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6394 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6396 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6397 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6398 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6399 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6400 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6402 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6403 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6404 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6405 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6406 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6408 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6409 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6410 vv1(1)=pizda1(1,1)-pizda1(2,2)
6411 vv1(2)=pizda1(1,2)+pizda1(2,1)
6412 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6413 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6414 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6415 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6424 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6425 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6426 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6427 call transpose2(EUgC(1,1,k),auxmat(1,1))
6428 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6430 vv1(1)=pizda1(1,1)-pizda1(2,2)
6431 vv1(2)=pizda1(1,2)+pizda1(2,1)
6432 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6433 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6434 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6435 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6436 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6437 s5=scalar2(vv(1),Dtobr2(1,i))
6438 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6444 c----------------------------------------------------------------------------
6445 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6446 implicit real*8 (a-h,o-z)
6447 include 'DIMENSIONS'
6448 include 'DIMENSIONS.ZSCOPT'
6449 include 'COMMON.IOUNITS'
6450 include 'COMMON.CHAIN'
6451 include 'COMMON.DERIV'
6452 include 'COMMON.INTERACT'
6453 include 'COMMON.CONTACTS'
6454 include 'COMMON.TORSION'
6455 include 'COMMON.VAR'
6456 include 'COMMON.GEO'
6458 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6459 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6462 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6464 C Parallel Antiparallel C
6470 C \ j|/k\| \ |/k\|l C
6475 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6476 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6477 C AL 7/4/01 s1 would occur in the sixth-order moment,
6478 C but not in a cluster cumulant
6480 s1=dip(1,jj,i)*dip(1,kk,k)
6482 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6483 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6484 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6485 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6486 call transpose2(EUg(1,1,k),auxmat(1,1))
6487 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6488 vv(1)=pizda(1,1)-pizda(2,2)
6489 vv(2)=pizda(1,2)+pizda(2,1)
6490 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6491 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6493 eello6_graph2=-(s1+s2+s3+s4)
6495 eello6_graph2=-(s2+s3+s4)
6498 if (.not. calc_grad) return
6499 C Derivatives in gamma(i-1)
6502 s1=dipderg(1,jj,i)*dip(1,kk,k)
6504 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6505 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6506 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6507 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6509 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6511 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6513 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6515 C Derivatives in gamma(k-1)
6517 s1=dip(1,jj,i)*dipderg(1,kk,k)
6519 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6521 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6522 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6523 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6524 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6525 vv(1)=pizda(1,1)-pizda(2,2)
6526 vv(2)=pizda(1,2)+pizda(2,1)
6527 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6529 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6531 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6533 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6534 C Derivatives in gamma(j-1) or gamma(l-1)
6537 s1=dipderg(3,jj,i)*dip(1,kk,k)
6539 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6540 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6541 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6542 call matmat2(ADtEA1derg(1,1,1,1),auxmat(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))
6548 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6553 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6554 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6556 C Derivatives in gamma(l-1) or gamma(j-1)
6559 s1=dip(1,jj,i)*dipderg(3,kk,k)
6561 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6562 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6563 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6564 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6565 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6566 vv(1)=pizda(1,1)-pizda(2,2)
6567 vv(2)=pizda(1,2)+pizda(2,1)
6568 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6571 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6573 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6576 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6577 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6579 C Cartesian derivatives.
6581 write (2,*) 'In eello6_graph2'
6583 write (2,*) 'iii=',iii
6585 write (2,*) 'kkk=',kkk
6587 write (2,'(3(2f10.5),5x)')
6588 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6598 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6600 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6603 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6605 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6606 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6608 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6609 call transpose2(EUg(1,1,k),auxmat(1,1))
6610 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6612 vv(1)=pizda(1,1)-pizda(2,2)
6613 vv(2)=pizda(1,2)+pizda(2,1)
6614 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6615 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6617 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6619 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6622 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6624 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6631 c----------------------------------------------------------------------------
6632 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6633 implicit real*8 (a-h,o-z)
6634 include 'DIMENSIONS'
6635 include 'DIMENSIONS.ZSCOPT'
6636 include 'COMMON.IOUNITS'
6637 include 'COMMON.CHAIN'
6638 include 'COMMON.DERIV'
6639 include 'COMMON.INTERACT'
6640 include 'COMMON.CONTACTS'
6641 include 'COMMON.TORSION'
6642 include 'COMMON.VAR'
6643 include 'COMMON.GEO'
6644 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6646 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6648 C Parallel Antiparallel C
6654 C j|/k\| / |/k\|l / C
6659 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6661 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6662 C energy moment and not to the cluster cumulant.
6663 iti=itortyp(itype(i))
6664 if (j.lt.nres-1) then
6665 itj1=itortyp(itype(j+1))
6669 itk=itortyp(itype(k))
6670 itk1=itortyp(itype(k+1))
6671 if (l.lt.nres-1) then
6672 itl1=itortyp(itype(l+1))
6677 s1=dip(4,jj,i)*dip(4,kk,k)
6679 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6680 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6681 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6682 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6683 call transpose2(EE(1,1,itk),auxmat(1,1))
6684 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6685 vv(1)=pizda(1,1)+pizda(2,2)
6686 vv(2)=pizda(2,1)-pizda(1,2)
6687 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6688 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6690 eello6_graph3=-(s1+s2+s3+s4)
6692 eello6_graph3=-(s2+s3+s4)
6695 if (.not. calc_grad) return
6696 C Derivatives in gamma(k-1)
6697 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6698 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6699 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6700 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6701 C Derivatives in gamma(l-1)
6702 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6703 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6704 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6705 vv(1)=pizda(1,1)+pizda(2,2)
6706 vv(2)=pizda(2,1)-pizda(1,2)
6707 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6708 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6709 C Cartesian derivatives.
6715 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6717 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6720 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6722 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6723 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6725 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6726 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6728 vv(1)=pizda(1,1)+pizda(2,2)
6729 vv(2)=pizda(2,1)-pizda(1,2)
6730 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6732 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6734 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6737 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6739 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6741 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6747 c----------------------------------------------------------------------------
6748 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6749 implicit real*8 (a-h,o-z)
6750 include 'DIMENSIONS'
6751 include 'DIMENSIONS.ZSCOPT'
6752 include 'COMMON.IOUNITS'
6753 include 'COMMON.CHAIN'
6754 include 'COMMON.DERIV'
6755 include 'COMMON.INTERACT'
6756 include 'COMMON.CONTACTS'
6757 include 'COMMON.TORSION'
6758 include 'COMMON.VAR'
6759 include 'COMMON.GEO'
6760 include 'COMMON.FFIELD'
6761 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6762 & auxvec1(2),auxmat1(2,2)
6764 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6766 C Parallel Antiparallel C
6772 C \ j|/k\| \ |/k\|l C
6777 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6779 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6780 C energy moment and not to the cluster cumulant.
6781 cd write (2,*) 'eello_graph4: wturn6',wturn6
6782 iti=itortyp(itype(i))
6783 itj=itortyp(itype(j))
6784 if (j.lt.nres-1) then
6785 itj1=itortyp(itype(j+1))
6789 itk=itortyp(itype(k))
6790 if (k.lt.nres-1) then
6791 itk1=itortyp(itype(k+1))
6795 itl=itortyp(itype(l))
6796 if (l.lt.nres-1) then
6797 itl1=itortyp(itype(l+1))
6801 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6802 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6803 cd & ' itl',itl,' itl1',itl1
6806 s1=dip(3,jj,i)*dip(3,kk,k)
6808 s1=dip(2,jj,j)*dip(2,kk,l)
6811 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6812 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6814 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6815 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6817 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6818 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6820 call transpose2(EUg(1,1,k),auxmat(1,1))
6821 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6822 vv(1)=pizda(1,1)-pizda(2,2)
6823 vv(2)=pizda(2,1)+pizda(1,2)
6824 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6825 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6827 eello6_graph4=-(s1+s2+s3+s4)
6829 eello6_graph4=-(s2+s3+s4)
6831 if (.not. calc_grad) return
6832 C Derivatives in gamma(i-1)
6836 s1=dipderg(2,jj,i)*dip(3,kk,k)
6838 s1=dipderg(4,jj,j)*dip(2,kk,l)
6841 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6843 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6844 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6846 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6847 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6849 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6850 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6851 cd write (2,*) 'turn6 derivatives'
6853 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6855 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6859 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6861 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6865 C Derivatives in gamma(k-1)
6868 s1=dip(3,jj,i)*dipderg(2,kk,k)
6870 s1=dip(2,jj,j)*dipderg(4,kk,l)
6873 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6874 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6876 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6877 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6879 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6880 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6882 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6883 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6884 vv(1)=pizda(1,1)-pizda(2,2)
6885 vv(2)=pizda(2,1)+pizda(1,2)
6886 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6887 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6889 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6891 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6895 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6897 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6900 C Derivatives in gamma(j-1) or gamma(l-1)
6901 if (l.eq.j+1 .and. l.gt.1) then
6902 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6903 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6904 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6905 vv(1)=pizda(1,1)-pizda(2,2)
6906 vv(2)=pizda(2,1)+pizda(1,2)
6907 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6908 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6909 else if (j.gt.1) then
6910 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6911 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6912 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6913 vv(1)=pizda(1,1)-pizda(2,2)
6914 vv(2)=pizda(2,1)+pizda(1,2)
6915 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6916 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6917 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6919 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6922 C Cartesian derivatives.
6929 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6931 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6935 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6937 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6941 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6943 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6945 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6946 & b1(1,itj1),auxvec(1))
6947 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6949 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6950 & b1(1,itl1),auxvec(1))
6951 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6953 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6955 vv(1)=pizda(1,1)-pizda(2,2)
6956 vv(2)=pizda(2,1)+pizda(1,2)
6957 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6959 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6961 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6964 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6967 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6970 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6972 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6974 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6978 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6980 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6983 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6985 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6993 c----------------------------------------------------------------------------
6994 double precision function eello_turn6(i,jj,kk)
6995 implicit real*8 (a-h,o-z)
6996 include 'DIMENSIONS'
6997 include 'DIMENSIONS.ZSCOPT'
6998 include 'COMMON.IOUNITS'
6999 include 'COMMON.CHAIN'
7000 include 'COMMON.DERIV'
7001 include 'COMMON.INTERACT'
7002 include 'COMMON.CONTACTS'
7003 include 'COMMON.TORSION'
7004 include 'COMMON.VAR'
7005 include 'COMMON.GEO'
7006 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7007 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7009 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7010 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7011 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7012 C the respective energy moment and not to the cluster cumulant.
7017 iti=itortyp(itype(i))
7018 itk=itortyp(itype(k))
7019 itk1=itortyp(itype(k+1))
7020 itl=itortyp(itype(l))
7021 itj=itortyp(itype(j))
7022 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7023 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7024 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7029 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7031 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7035 derx_turn(lll,kkk,iii)=0.0d0
7042 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7044 cd write (2,*) 'eello6_5',eello6_5
7046 call transpose2(AEA(1,1,1),auxmat(1,1))
7047 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7048 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7049 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7053 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7054 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7055 s2 = scalar2(b1(1,itk),vtemp1(1))
7057 call transpose2(AEA(1,1,2),atemp(1,1))
7058 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7059 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7060 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7064 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7065 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7066 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7068 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7069 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7070 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7071 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7072 ss13 = scalar2(b1(1,itk),vtemp4(1))
7073 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7077 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7083 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7085 C Derivatives in gamma(i+2)
7087 call transpose2(AEA(1,1,1),auxmatd(1,1))
7088 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7089 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7090 call transpose2(AEAderg(1,1,2),atempd(1,1))
7091 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7092 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7096 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7097 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7098 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7104 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7105 C Derivatives in gamma(i+3)
7107 call transpose2(AEA(1,1,1),auxmatd(1,1))
7108 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7109 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7110 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7114 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7115 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7116 s2d = scalar2(b1(1,itk),vtemp1d(1))
7118 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7119 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7121 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7123 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7124 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7125 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7135 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7136 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7138 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7139 & -0.5d0*ekont*(s2d+s12d)
7141 C Derivatives in gamma(i+4)
7142 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7143 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7144 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7146 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7147 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7148 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7158 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7160 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7162 C Derivatives in gamma(i+5)
7164 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7165 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7166 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7170 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7171 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7172 s2d = scalar2(b1(1,itk),vtemp1d(1))
7174 call transpose2(AEA(1,1,2),atempd(1,1))
7175 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7176 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7180 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7181 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7183 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7184 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7185 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7195 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7196 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7198 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7199 & -0.5d0*ekont*(s2d+s12d)
7201 C Cartesian derivatives
7206 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7207 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7208 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7212 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7213 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7215 s2d = scalar2(b1(1,itk),vtemp1d(1))
7217 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7218 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7219 s8d = -(atempd(1,1)+atempd(2,2))*
7220 & scalar2(cc(1,1,itl),vtemp2(1))
7224 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7226 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7227 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7234 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7237 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7241 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7242 & - 0.5d0*(s8d+s12d)
7244 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7253 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7255 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7256 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7257 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7258 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7259 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7261 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7262 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7263 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7267 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7268 cd & 16*eel_turn6_num
7270 if (j.lt.nres-1) then
7277 if (l.lt.nres-1) then
7285 ggg1(ll)=eel_turn6*g_contij(ll,1)
7286 ggg2(ll)=eel_turn6*g_contij(ll,2)
7287 ghalf=0.5d0*ggg1(ll)
7289 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7290 & +ekont*derx_turn(ll,2,1)
7291 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7292 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7293 & +ekont*derx_turn(ll,4,1)
7294 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7295 ghalf=0.5d0*ggg2(ll)
7297 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7298 & +ekont*derx_turn(ll,2,2)
7299 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7300 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7301 & +ekont*derx_turn(ll,4,2)
7302 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7307 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7312 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7318 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7323 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7327 cd write (2,*) iii,g_corr6_loc(iii)
7330 eello_turn6=ekont*eel_turn6
7331 cd write (2,*) 'ekont',ekont
7332 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7335 crc-------------------------------------------------
7336 SUBROUTINE MATVEC2(A1,V1,V2)
7337 implicit real*8 (a-h,o-z)
7338 include 'DIMENSIONS'
7339 DIMENSION A1(2,2),V1(2),V2(2)
7343 c 3 VI=VI+A1(I,K)*V1(K)
7347 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7348 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7353 C---------------------------------------
7354 SUBROUTINE MATMAT2(A1,A2,A3)
7355 implicit real*8 (a-h,o-z)
7356 include 'DIMENSIONS'
7357 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7358 c DIMENSION AI3(2,2)
7362 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7368 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7369 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7370 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7371 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7379 c-------------------------------------------------------------------------
7380 double precision function scalar2(u,v)
7382 double precision u(2),v(2)
7385 scalar2=u(1)*v(1)+u(2)*v(2)
7389 C-----------------------------------------------------------------------------
7391 subroutine transpose2(a,at)
7393 double precision a(2,2),at(2,2)
7400 c--------------------------------------------------------------------------
7401 subroutine transpose(n,a,at)
7404 double precision a(n,n),at(n,n)
7412 C---------------------------------------------------------------------------
7413 subroutine prodmat3(a1,a2,kk,transp,prod)
7416 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7418 crc double precision auxmat(2,2),prod_(2,2)
7421 crc call transpose2(kk(1,1),auxmat(1,1))
7422 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7423 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7425 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7426 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7427 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7428 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7429 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7430 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7431 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7432 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7435 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7436 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7438 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7439 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7440 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7441 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7442 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7443 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7444 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7445 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7448 c call transpose2(a2(1,1),a2t(1,1))
7451 crc print *,((prod_(i,j),i=1,2),j=1,2)
7452 crc print *,((prod(i,j),i=1,2),j=1,2)
7456 C-----------------------------------------------------------------------------
7457 double precision function scalar(u,v)
7459 double precision u(3),v(3)