1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
11 cMS$ATTRIBUTES C :: proc_proc
14 include 'COMMON.IOUNITS'
15 double precision energia(0:max_ene),energia1(0:max_ene+1)
21 include 'COMMON.FFIELD'
22 include 'COMMON.DERIV'
23 include 'COMMON.INTERACT'
24 include 'COMMON.SBRIDGE'
25 include 'COMMON.CHAIN'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
64 C Calculate the disulfide-bridge and other energy and the contributions
65 C from other distance constraints.
66 cd print *,'Calling EHPB'
68 cd print *,'EHPB exitted succesfully.'
70 C Calculate the virtual-bond-angle energy.
73 cd print *,'Bend energy finished.'
75 C Calculate the SC local energy.
78 cd print *,'SCLOC energy finished.'
80 C Calculate the virtual-bond torsional energy.
82 cd print *,'nterm=',nterm
83 call etor(etors,edihcnstr,fact(1))
85 C 6/23/01 Calculate double-torsional energy
87 call etor_d(etors_d,fact(2))
89 C 21/5/07 Calculate local sicdechain correlation energy
91 call eback_sc_corr(esccor)
93 C 12/1/95 Multi-body terms
97 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
98 & .or. wturn6.gt.0.0d0) then
99 c print *,"calling multibody_eello"
100 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
101 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
102 c print *,ecorr,ecorr5,ecorr6,eturn6
109 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
110 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
112 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
113 if (constr_homology.ge.1) then
114 call e_modeller(ehomology_constr)
116 ehomology_constr=0.0d0
119 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
120 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
122 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
124 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
125 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
126 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
127 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
128 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
129 & +wbond*estr+wsccor*fact(1)*esccor
131 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
132 & +welec*fact(1)*(ees+evdw1)
133 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
134 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
135 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
136 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
137 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
138 & +wbond*estr+wsccor*fact(1)*esccor
143 energia(2)=evdw2-evdw2_14
160 energia(8)=eello_turn3
161 energia(9)=eello_turn4
170 energia(20)=edihcnstr
172 energia(22)=ehomology_constr
176 if (isnan(etot).ne.0) energia(0)=1.0d+99
178 if (isnan(etot)) energia(0)=1.0d+99
183 idumm=proc_proc(etot,i)
185 call proc_proc(etot,i)
187 if(i.eq.1)energia(0)=1.0d+99
194 call enerprint(energia,fact)
199 C Sum up the components of the Cartesian gradient.
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
207 & wstrain*ghpbc(j,i)+
208 & wcorr*fact(3)*gradcorr(j,i)+
209 & wel_loc*fact(2)*gel_loc(j,i)+
210 & wturn3*fact(2)*gcorr3_turn(j,i)+
211 & wturn4*fact(3)*gcorr4_turn(j,i)+
212 & wcorr5*fact(4)*gradcorr5(j,i)+
213 & wcorr6*fact(5)*gradcorr6(j,i)+
214 & wturn6*fact(5)*gcorr6_turn(j,i)+
215 & wsccor*fact(2)*gsccorc(j,i)
216 & +wliptran*gliptranc(j,i)
217 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
219 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
220 & wsccor*fact(2)*gsccorx(j,i)
225 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
226 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
228 & wcorr*fact(3)*gradcorr(j,i)+
229 & wel_loc*fact(2)*gel_loc(j,i)+
230 & wturn3*fact(2)*gcorr3_turn(j,i)+
231 & wturn4*fact(3)*gcorr4_turn(j,i)+
232 & wcorr5*fact(4)*gradcorr5(j,i)+
233 & wcorr6*fact(5)*gradcorr6(j,i)+
234 & wturn6*fact(5)*gcorr6_turn(j,i)+
235 & wsccor*fact(2)*gsccorc(j,i)
236 & +wliptran*gliptranc(j,i)
237 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
239 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
240 & wsccor*fact(1)*gsccorx(j,i)
241 & +wliptran*gliptranx(j,i)
248 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
249 & +wcorr5*fact(4)*g_corr5_loc(i)
250 & +wcorr6*fact(5)*g_corr6_loc(i)
251 & +wturn4*fact(3)*gel_loc_turn4(i)
252 & +wturn3*fact(2)*gel_loc_turn3(i)
253 & +wturn6*fact(5)*gel_loc_turn6(i)
254 & +wel_loc*fact(2)*gel_loc_loc(i)
255 c & +wsccor*fact(1)*gsccor_loc(i)
256 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
259 if (dyn_ss) call dyn_set_nss
262 C------------------------------------------------------------------------
263 subroutine enerprint(energia,fact)
264 implicit real*8 (a-h,o-z)
266 include 'DIMENSIONS.ZSCOPT'
267 include 'COMMON.IOUNITS'
268 include 'COMMON.FFIELD'
269 include 'COMMON.SBRIDGE'
270 double precision energia(0:max_ene),fact(6)
272 evdw=energia(1)+fact(6)*energia(21)
274 evdw2=energia(2)+energia(17)
286 eello_turn3=energia(8)
287 eello_turn4=energia(9)
288 eello_turn6=energia(10)
295 edihcnstr=energia(20)
297 ehomology_constr=energia(22)
299 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
301 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
302 & etors_d,wtor_d*fact(2),ehpb,wstrain,
303 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
304 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
305 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
306 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,etot
307 10 format (/'Virtual-chain energies:'//
308 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
309 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
310 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
311 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
312 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
313 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
314 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
315 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
316 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
317 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
318 & ' (SS bridges & dist. cnstr.)'/
319 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
320 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
321 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
322 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
323 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
324 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
325 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
326 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
327 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
328 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
329 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
330 & 'ETOT= ',1pE16.6,' (total)')
332 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
333 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
334 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
335 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
336 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
337 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
338 & edihcnstr,ehomology_constr,ebr*nss,
340 10 format (/'Virtual-chain energies:'//
341 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
342 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
343 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
344 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
345 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
346 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
347 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
348 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
349 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
350 & ' (SS bridges & dist. cnstr.)'/
351 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
352 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
353 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
354 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
355 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
356 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
357 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
358 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
359 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
360 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
361 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
362 & 'ETOT= ',1pE16.6,' (total)')
366 C-----------------------------------------------------------------------
367 subroutine elj(evdw,evdw_t)
369 C This subroutine calculates the interaction energy of nonbonded side chains
370 C assuming the LJ potential of interaction.
372 implicit real*8 (a-h,o-z)
374 include 'DIMENSIONS.ZSCOPT'
375 include "DIMENSIONS.COMPAR"
376 parameter (accur=1.0d-10)
379 include 'COMMON.LOCAL'
380 include 'COMMON.CHAIN'
381 include 'COMMON.DERIV'
382 include 'COMMON.INTERACT'
383 include 'COMMON.TORSION'
384 include 'COMMON.ENEPS'
385 include 'COMMON.SBRIDGE'
386 include 'COMMON.NAMES'
387 include 'COMMON.IOUNITS'
388 include 'COMMON.CONTACTS'
392 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
395 eneps_temp(j,i)=0.0d0
402 if (itypi.eq.ntyp1) cycle
403 itypi1=iabs(itype(i+1))
410 C Calculate SC interaction energy.
413 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
414 cd & 'iend=',iend(i,iint)
415 do j=istart(i,iint),iend(i,iint)
417 if (itypj.eq.ntyp1) cycle
421 C Change 12/1/95 to calculate four-body interactions
422 rij=xj*xj+yj*yj+zj*zj
424 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
425 eps0ij=eps(itypi,itypj)
430 ij=icant(itypi,itypj)
431 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
432 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
433 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
434 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
435 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
436 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
437 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
438 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
439 if (bb.gt.0.0d0) then
446 C Calculate the components of the gradient in DC and X
448 fac=-rrij*(e1+evdwij)
453 gvdwx(k,i)=gvdwx(k,i)-gg(k)
454 gvdwx(k,j)=gvdwx(k,j)+gg(k)
458 gvdwc(l,k)=gvdwc(l,k)+gg(l)
463 C 12/1/95, revised on 5/20/97
465 C Calculate the contact function. The ith column of the array JCONT will
466 C contain the numbers of atoms that make contacts with the atom I (of numbers
467 C greater than I). The arrays FACONT and GACONT will contain the values of
468 C the contact function and its derivative.
470 C Uncomment next line, if the correlation interactions include EVDW explicitly.
471 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
472 C Uncomment next line, if the correlation interactions are contact function only
473 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
475 sigij=sigma(itypi,itypj)
476 r0ij=rs0(itypi,itypj)
478 C Check whether the SC's are not too far to make a contact.
481 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
482 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
484 if (fcont.gt.0.0D0) then
485 C If the SC-SC distance if close to sigma, apply spline.
486 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
487 cAdam & fcont1,fprimcont1)
488 cAdam fcont1=1.0d0-fcont1
489 cAdam if (fcont1.gt.0.0d0) then
490 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
491 cAdam fcont=fcont*fcont1
493 C Uncomment following 4 lines to have the geometric average of the epsilon0's
494 cga eps0ij=1.0d0/dsqrt(eps0ij)
496 cga gg(k)=gg(k)*eps0ij
498 cga eps0ij=-evdwij*eps0ij
499 C Uncomment for AL's type of SC correlation interactions.
501 num_conti=num_conti+1
503 facont(num_conti,i)=fcont*eps0ij
504 fprimcont=eps0ij*fprimcont/rij
506 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
507 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
508 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
509 C Uncomment following 3 lines for Skolnick's type of SC correlation.
510 gacont(1,num_conti,i)=-fprimcont*xj
511 gacont(2,num_conti,i)=-fprimcont*yj
512 gacont(3,num_conti,i)=-fprimcont*zj
513 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
514 cd write (iout,'(2i3,3f10.5)')
515 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
521 num_cont(i)=num_conti
526 gvdwc(j,i)=expon*gvdwc(j,i)
527 gvdwx(j,i)=expon*gvdwx(j,i)
531 C******************************************************************************
535 C To save time, the factor of EXPON has been extracted from ALL components
536 C of GVDWC and GRADX. Remember to multiply them by this factor before further
539 C******************************************************************************
542 C-----------------------------------------------------------------------------
543 subroutine eljk(evdw,evdw_t)
545 C This subroutine calculates the interaction energy of nonbonded side chains
546 C assuming the LJK potential of interaction.
548 implicit real*8 (a-h,o-z)
550 include 'DIMENSIONS.ZSCOPT'
551 include "DIMENSIONS.COMPAR"
554 include 'COMMON.LOCAL'
555 include 'COMMON.CHAIN'
556 include 'COMMON.DERIV'
557 include 'COMMON.INTERACT'
558 include 'COMMON.ENEPS'
559 include 'COMMON.IOUNITS'
560 include 'COMMON.NAMES'
565 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
568 eneps_temp(j,i)=0.0d0
575 if (itypi.eq.ntyp1) cycle
576 itypi1=iabs(itype(i+1))
581 C Calculate SC interaction energy.
584 do j=istart(i,iint),iend(i,iint)
586 if (itypj.eq.ntyp1) cycle
590 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
592 e_augm=augm(itypi,itypj)*fac_augm
595 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
596 fac=r_shift_inv**expon
600 ij=icant(itypi,itypj)
601 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
602 & /dabs(eps(itypi,itypj))
603 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
604 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
605 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
606 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
607 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
608 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
609 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
610 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
611 if (bb.gt.0.0d0) then
618 C Calculate the components of the gradient in DC and X
620 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
625 gvdwx(k,i)=gvdwx(k,i)-gg(k)
626 gvdwx(k,j)=gvdwx(k,j)+gg(k)
630 gvdwc(l,k)=gvdwc(l,k)+gg(l)
640 gvdwc(j,i)=expon*gvdwc(j,i)
641 gvdwx(j,i)=expon*gvdwx(j,i)
647 C-----------------------------------------------------------------------------
648 subroutine ebp(evdw,evdw_t)
650 C This subroutine calculates the interaction energy of nonbonded side chains
651 C assuming the Berne-Pechukas potential of interaction.
653 implicit real*8 (a-h,o-z)
655 include 'DIMENSIONS.ZSCOPT'
656 include "DIMENSIONS.COMPAR"
659 include 'COMMON.LOCAL'
660 include 'COMMON.CHAIN'
661 include 'COMMON.DERIV'
662 include 'COMMON.NAMES'
663 include 'COMMON.INTERACT'
664 include 'COMMON.ENEPS'
665 include 'COMMON.IOUNITS'
666 include 'COMMON.CALC'
668 c double precision rrsave(maxdim)
674 eneps_temp(j,i)=0.0d0
679 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
680 c if (icall.eq.0) then
688 if (itypi.eq.ntyp1) cycle
689 itypi1=iabs(itype(i+1))
693 dxi=dc_norm(1,nres+i)
694 dyi=dc_norm(2,nres+i)
695 dzi=dc_norm(3,nres+i)
696 dsci_inv=vbld_inv(i+nres)
698 C Calculate SC interaction energy.
701 do j=istart(i,iint),iend(i,iint)
704 if (itypj.eq.ntyp1) cycle
705 dscj_inv=vbld_inv(j+nres)
706 chi1=chi(itypi,itypj)
707 chi2=chi(itypj,itypi)
714 alf12=0.5D0*(alf1+alf2)
715 C For diagnostics only!!!
728 dxj=dc_norm(1,nres+j)
729 dyj=dc_norm(2,nres+j)
730 dzj=dc_norm(3,nres+j)
731 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
732 cd if (icall.eq.0) then
738 C Calculate the angle-dependent terms of energy & contributions to derivatives.
740 C Calculate whole angle-dependent part of epsilon and contributions
742 fac=(rrij*sigsq)**expon2
745 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
746 eps2der=evdwij*eps3rt
747 eps3der=evdwij*eps2rt
748 evdwij=evdwij*eps2rt*eps3rt
749 ij=icant(itypi,itypj)
750 aux=eps1*eps2rt**2*eps3rt**2
751 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
752 & /dabs(eps(itypi,itypj))
753 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
754 if (bb.gt.0.0d0) then
761 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
763 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
764 & restyp(itypi),i,restyp(itypj),j,
765 & epsi,sigm,chi1,chi2,chip1,chip2,
766 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
767 & om1,om2,om12,1.0D0/dsqrt(rrij),
770 C Calculate gradient components.
771 e1=e1*eps1*eps2rt**2*eps3rt**2
772 fac=-expon*(e1+evdwij)
775 C Calculate radial part of the gradient
779 C Calculate the angular part of the gradient and sum add the contributions
780 C to the appropriate components of the Cartesian gradient.
789 C-----------------------------------------------------------------------------
790 subroutine egb(evdw,evdw_t)
792 C This subroutine calculates the interaction energy of nonbonded side chains
793 C assuming the Gay-Berne potential of interaction.
795 implicit real*8 (a-h,o-z)
797 include 'DIMENSIONS.ZSCOPT'
798 include "DIMENSIONS.COMPAR"
801 include 'COMMON.LOCAL'
802 include 'COMMON.CHAIN'
803 include 'COMMON.DERIV'
804 include 'COMMON.NAMES'
805 include 'COMMON.INTERACT'
806 include 'COMMON.ENEPS'
807 include 'COMMON.IOUNITS'
808 include 'COMMON.CALC'
809 include 'COMMON.SBRIDGE'
812 integer icant,xshift,yshift,zshift
816 eneps_temp(j,i)=0.0d0
819 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
823 c if (icall.gt.0) lprn=.true.
827 if (itypi.eq.ntyp1) cycle
828 itypi1=iabs(itype(i+1))
832 C returning the ith atom to box
834 if (xi.lt.0) xi=xi+boxxsize
836 if (yi.lt.0) yi=yi+boxysize
838 if (zi.lt.0) zi=zi+boxzsize
839 if ((zi.gt.bordlipbot)
840 &.and.(zi.lt.bordliptop)) then
841 C the energy transfer exist
842 if (zi.lt.buflipbot) then
843 C what fraction I am in
845 & ((zi-bordlipbot)/lipbufthick)
846 C lipbufthick is thickenes of lipid buffore
847 sslipi=sscalelip(fracinbuf)
848 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
849 elseif (zi.gt.bufliptop) then
850 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
851 sslipi=sscalelip(fracinbuf)
852 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
862 dxi=dc_norm(1,nres+i)
863 dyi=dc_norm(2,nres+i)
864 dzi=dc_norm(3,nres+i)
865 dsci_inv=vbld_inv(i+nres)
867 C Calculate SC interaction energy.
870 do j=istart(i,iint),iend(i,iint)
871 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
872 call dyn_ssbond_ene(i,j,evdwij)
874 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
875 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
876 C triple bond artifac removal
877 do k=j+1,iend(i,iint)
878 C search over all next residues
879 if (dyn_ss_mask(k)) then
880 C check if they are cysteins
881 C write(iout,*) 'k=',k
882 call triple_ssbond_ene(i,j,k,evdwij)
883 C call the energy function that removes the artifical triple disulfide
884 C bond the soubroutine is located in ssMD.F
886 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
887 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
893 if (itypj.eq.ntyp1) cycle
894 dscj_inv=vbld_inv(j+nres)
895 sig0ij=sigma(itypi,itypj)
896 chi1=chi(itypi,itypj)
897 chi2=chi(itypj,itypi)
904 alf12=0.5D0*(alf1+alf2)
905 C For diagnostics only!!!
918 C returning jth atom to box
920 if (xj.lt.0) xj=xj+boxxsize
922 if (yj.lt.0) yj=yj+boxysize
924 if (zj.lt.0) zj=zj+boxzsize
925 if ((zj.gt.bordlipbot)
926 &.and.(zj.lt.bordliptop)) then
927 C the energy transfer exist
928 if (zj.lt.buflipbot) then
929 C what fraction I am in
931 & ((zj-bordlipbot)/lipbufthick)
932 C lipbufthick is thickenes of lipid buffore
933 sslipj=sscalelip(fracinbuf)
934 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
935 elseif (zj.gt.bufliptop) then
936 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
937 sslipj=sscalelip(fracinbuf)
938 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
947 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
948 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
949 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
950 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
951 C if (aa.ne.aa_aq(itypi,itypj)) then
953 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
954 C & bb_aq(itypi,itypj)-bb,
958 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
959 C checking the distance
960 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
965 C finding the closest
969 xj=xj_safe+xshift*boxxsize
970 yj=yj_safe+yshift*boxysize
971 zj=zj_safe+zshift*boxzsize
972 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
973 if(dist_temp.lt.dist_init) then
983 if (subchap.eq.1) then
993 dxj=dc_norm(1,nres+j)
994 dyj=dc_norm(2,nres+j)
995 dzj=dc_norm(3,nres+j)
996 c write (iout,*) i,j,xj,yj,zj
997 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
999 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1000 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1001 if (sss.le.0.0) cycle
1002 C Calculate angle-dependent terms of energy and contributions to their
1007 sig=sig0ij*dsqrt(sigsq)
1008 rij_shift=1.0D0/rij-sig+sig0ij
1009 C I hate to put IF's in the loops, but here don't have another choice!!!!
1010 if (rij_shift.le.0.0D0) then
1015 c---------------------------------------------------------------
1016 rij_shift=1.0D0/rij_shift
1017 fac=rij_shift**expon
1020 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1021 eps2der=evdwij*eps3rt
1022 eps3der=evdwij*eps2rt
1023 evdwij=evdwij*eps2rt*eps3rt
1025 evdw=evdw+evdwij*sss
1027 evdw_t=evdw_t+evdwij*sss
1029 ij=icant(itypi,itypj)
1030 aux=eps1*eps2rt**2*eps3rt**2
1031 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1032 & /dabs(eps(itypi,itypj))
1033 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1034 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1035 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1036 c & aux*e2/eps(itypi,itypj)
1038 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1042 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1043 & restyp(itypi),i,restyp(itypj),j,
1044 & epsi,sigm,chi1,chi2,chip1,chip2,
1045 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1046 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1048 write (iout,*) "partial sum", evdw, evdw_t
1053 C Calculate gradient components.
1054 e1=e1*eps1*eps2rt**2*eps3rt**2
1055 fac=-expon*(e1+evdwij)*rij_shift
1058 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1059 C Calculate the radial part of the gradient
1063 C Calculate angular part of the gradient.
1066 C write(iout,*) "partial sum", evdw, evdw_t
1073 C-----------------------------------------------------------------------------
1074 subroutine egbv(evdw,evdw_t)
1076 C This subroutine calculates the interaction energy of nonbonded side chains
1077 C assuming the Gay-Berne-Vorobjev potential of interaction.
1079 implicit real*8 (a-h,o-z)
1080 include 'DIMENSIONS'
1081 include 'DIMENSIONS.ZSCOPT'
1082 include "DIMENSIONS.COMPAR"
1083 include 'COMMON.GEO'
1084 include 'COMMON.VAR'
1085 include 'COMMON.LOCAL'
1086 include 'COMMON.CHAIN'
1087 include 'COMMON.DERIV'
1088 include 'COMMON.NAMES'
1089 include 'COMMON.INTERACT'
1090 include 'COMMON.ENEPS'
1091 include 'COMMON.IOUNITS'
1092 include 'COMMON.CALC'
1093 common /srutu/ icall
1099 eneps_temp(j,i)=0.0d0
1104 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1107 c if (icall.gt.0) lprn=.true.
1109 do i=iatsc_s,iatsc_e
1110 itypi=iabs(itype(i))
1111 if (itypi.eq.ntyp1) cycle
1112 itypi1=iabs(itype(i+1))
1116 dxi=dc_norm(1,nres+i)
1117 dyi=dc_norm(2,nres+i)
1118 dzi=dc_norm(3,nres+i)
1119 dsci_inv=vbld_inv(i+nres)
1121 C Calculate SC interaction energy.
1123 do iint=1,nint_gr(i)
1124 do j=istart(i,iint),iend(i,iint)
1126 itypj=iabs(itype(j))
1127 if (itypj.eq.ntyp1) cycle
1128 dscj_inv=vbld_inv(j+nres)
1129 sig0ij=sigma(itypi,itypj)
1130 r0ij=r0(itypi,itypj)
1131 chi1=chi(itypi,itypj)
1132 chi2=chi(itypj,itypi)
1139 alf12=0.5D0*(alf1+alf2)
1140 C For diagnostics only!!!
1153 dxj=dc_norm(1,nres+j)
1154 dyj=dc_norm(2,nres+j)
1155 dzj=dc_norm(3,nres+j)
1156 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1158 C Calculate angle-dependent terms of energy and contributions to their
1162 sig=sig0ij*dsqrt(sigsq)
1163 rij_shift=1.0D0/rij-sig+r0ij
1164 C I hate to put IF's in the loops, but here don't have another choice!!!!
1165 if (rij_shift.le.0.0D0) then
1170 c---------------------------------------------------------------
1171 rij_shift=1.0D0/rij_shift
1172 fac=rij_shift**expon
1175 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1176 eps2der=evdwij*eps3rt
1177 eps3der=evdwij*eps2rt
1178 fac_augm=rrij**expon
1179 e_augm=augm(itypi,itypj)*fac_augm
1180 evdwij=evdwij*eps2rt*eps3rt
1181 if (bb.gt.0.0d0) then
1182 evdw=evdw+evdwij+e_augm
1184 evdw_t=evdw_t+evdwij+e_augm
1186 ij=icant(itypi,itypj)
1187 aux=eps1*eps2rt**2*eps3rt**2
1188 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1189 & /dabs(eps(itypi,itypj))
1190 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1191 c eneps_temp(ij)=eneps_temp(ij)
1192 c & +(evdwij+e_augm)/eps(itypi,itypj)
1194 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1195 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1196 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1197 c & restyp(itypi),i,restyp(itypj),j,
1198 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1199 c & chi1,chi2,chip1,chip2,
1200 c & eps1,eps2rt**2,eps3rt**2,
1201 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1205 C Calculate gradient components.
1206 e1=e1*eps1*eps2rt**2*eps3rt**2
1207 fac=-expon*(e1+evdwij)*rij_shift
1209 fac=rij*fac-2*expon*rrij*e_augm
1210 C Calculate the radial part of the gradient
1214 C Calculate angular part of the gradient.
1222 C-----------------------------------------------------------------------------
1223 subroutine sc_angular
1224 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1225 C om12. Called by ebp, egb, and egbv.
1227 include 'COMMON.CALC'
1231 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1232 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1233 om12=dxi*dxj+dyi*dyj+dzi*dzj
1235 C Calculate eps1(om12) and its derivative in om12
1236 faceps1=1.0D0-om12*chiom12
1237 faceps1_inv=1.0D0/faceps1
1238 eps1=dsqrt(faceps1_inv)
1239 C Following variable is eps1*deps1/dom12
1240 eps1_om12=faceps1_inv*chiom12
1241 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1246 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1247 sigsq=1.0D0-facsig*faceps1_inv
1248 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1249 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1250 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1251 C Calculate eps2 and its derivatives in om1, om2, and om12.
1254 chipom12=chip12*om12
1255 facp=1.0D0-om12*chipom12
1257 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1258 C Following variable is the square root of eps2
1259 eps2rt=1.0D0-facp1*facp_inv
1260 C Following three variables are the derivatives of the square root of eps
1261 C in om1, om2, and om12.
1262 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1263 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1264 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1265 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1266 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1267 C Calculate whole angle-dependent part of epsilon and contributions
1268 C to its derivatives
1271 C----------------------------------------------------------------------------
1273 implicit real*8 (a-h,o-z)
1274 include 'DIMENSIONS'
1275 include 'DIMENSIONS.ZSCOPT'
1276 include 'COMMON.CHAIN'
1277 include 'COMMON.DERIV'
1278 include 'COMMON.CALC'
1279 double precision dcosom1(3),dcosom2(3)
1280 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1281 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1282 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1283 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1285 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1286 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1289 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1292 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1293 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1294 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1295 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1296 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1297 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1300 C Calculate the components of the gradient in DC and X
1304 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1309 c------------------------------------------------------------------------------
1310 subroutine vec_and_deriv
1311 implicit real*8 (a-h,o-z)
1312 include 'DIMENSIONS'
1313 include 'DIMENSIONS.ZSCOPT'
1314 include 'COMMON.IOUNITS'
1315 include 'COMMON.GEO'
1316 include 'COMMON.VAR'
1317 include 'COMMON.LOCAL'
1318 include 'COMMON.CHAIN'
1319 include 'COMMON.VECTORS'
1320 include 'COMMON.DERIV'
1321 include 'COMMON.INTERACT'
1322 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1323 C Compute the local reference systems. For reference system (i), the
1324 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1325 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1327 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1328 if (i.eq.nres-1) then
1329 C Case of the last full residue
1330 C Compute the Z-axis
1331 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1332 costh=dcos(pi-theta(nres))
1333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1338 C Compute the derivatives of uz
1340 uzder(2,1,1)=-dc_norm(3,i-1)
1341 uzder(3,1,1)= dc_norm(2,i-1)
1342 uzder(1,2,1)= dc_norm(3,i-1)
1344 uzder(3,2,1)=-dc_norm(1,i-1)
1345 uzder(1,3,1)=-dc_norm(2,i-1)
1346 uzder(2,3,1)= dc_norm(1,i-1)
1349 uzder(2,1,2)= dc_norm(3,i)
1350 uzder(3,1,2)=-dc_norm(2,i)
1351 uzder(1,2,2)=-dc_norm(3,i)
1353 uzder(3,2,2)= dc_norm(1,i)
1354 uzder(1,3,2)= dc_norm(2,i)
1355 uzder(2,3,2)=-dc_norm(1,i)
1358 C Compute the Y-axis
1361 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1364 C Compute the derivatives of uy
1367 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1368 & -dc_norm(k,i)*dc_norm(j,i-1)
1369 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1371 uyder(j,j,1)=uyder(j,j,1)-costh
1372 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1377 uygrad(l,k,j,i)=uyder(l,k,j)
1378 uzgrad(l,k,j,i)=uzder(l,k,j)
1382 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1383 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1384 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1385 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1389 C Compute the Z-axis
1390 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1391 costh=dcos(pi-theta(i+2))
1392 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1397 C Compute the derivatives of uz
1399 uzder(2,1,1)=-dc_norm(3,i+1)
1400 uzder(3,1,1)= dc_norm(2,i+1)
1401 uzder(1,2,1)= dc_norm(3,i+1)
1403 uzder(3,2,1)=-dc_norm(1,i+1)
1404 uzder(1,3,1)=-dc_norm(2,i+1)
1405 uzder(2,3,1)= dc_norm(1,i+1)
1408 uzder(2,1,2)= dc_norm(3,i)
1409 uzder(3,1,2)=-dc_norm(2,i)
1410 uzder(1,2,2)=-dc_norm(3,i)
1412 uzder(3,2,2)= dc_norm(1,i)
1413 uzder(1,3,2)= dc_norm(2,i)
1414 uzder(2,3,2)=-dc_norm(1,i)
1417 C Compute the Y-axis
1420 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1423 C Compute the derivatives of uy
1426 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1427 & -dc_norm(k,i)*dc_norm(j,i+1)
1428 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1430 uyder(j,j,1)=uyder(j,j,1)-costh
1431 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1436 uygrad(l,k,j,i)=uyder(l,k,j)
1437 uzgrad(l,k,j,i)=uzder(l,k,j)
1441 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1442 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1443 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1444 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1450 vbld_inv_temp(1)=vbld_inv(i+1)
1451 if (i.lt.nres-1) then
1452 vbld_inv_temp(2)=vbld_inv(i+2)
1454 vbld_inv_temp(2)=vbld_inv(i)
1459 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1460 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1468 C-----------------------------------------------------------------------------
1469 subroutine vec_and_deriv_test
1470 implicit real*8 (a-h,o-z)
1471 include 'DIMENSIONS'
1472 include 'DIMENSIONS.ZSCOPT'
1473 include 'COMMON.IOUNITS'
1474 include 'COMMON.GEO'
1475 include 'COMMON.VAR'
1476 include 'COMMON.LOCAL'
1477 include 'COMMON.CHAIN'
1478 include 'COMMON.VECTORS'
1479 dimension uyder(3,3,2),uzder(3,3,2)
1480 C Compute the local reference systems. For reference system (i), the
1481 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1482 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1484 if (i.eq.nres-1) then
1485 C Case of the last full residue
1486 C Compute the Z-axis
1487 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1488 costh=dcos(pi-theta(nres))
1489 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1490 c write (iout,*) 'fac',fac,
1491 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1492 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1496 C Compute the derivatives of uz
1498 uzder(2,1,1)=-dc_norm(3,i-1)
1499 uzder(3,1,1)= dc_norm(2,i-1)
1500 uzder(1,2,1)= dc_norm(3,i-1)
1502 uzder(3,2,1)=-dc_norm(1,i-1)
1503 uzder(1,3,1)=-dc_norm(2,i-1)
1504 uzder(2,3,1)= dc_norm(1,i-1)
1507 uzder(2,1,2)= dc_norm(3,i)
1508 uzder(3,1,2)=-dc_norm(2,i)
1509 uzder(1,2,2)=-dc_norm(3,i)
1511 uzder(3,2,2)= dc_norm(1,i)
1512 uzder(1,3,2)= dc_norm(2,i)
1513 uzder(2,3,2)=-dc_norm(1,i)
1515 C Compute the Y-axis
1517 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1520 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1521 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1522 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1524 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1527 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1528 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1531 c write (iout,*) 'facy',facy,
1532 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1533 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1535 uy(k,i)=facy*uy(k,i)
1537 C Compute the derivatives of uy
1540 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1541 & -dc_norm(k,i)*dc_norm(j,i-1)
1542 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1544 c uyder(j,j,1)=uyder(j,j,1)-costh
1545 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1546 uyder(j,j,1)=uyder(j,j,1)
1547 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1548 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1554 uygrad(l,k,j,i)=uyder(l,k,j)
1555 uzgrad(l,k,j,i)=uzder(l,k,j)
1559 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1560 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1561 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1562 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1565 C Compute the Z-axis
1566 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1567 costh=dcos(pi-theta(i+2))
1568 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1569 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1573 C Compute the derivatives of uz
1575 uzder(2,1,1)=-dc_norm(3,i+1)
1576 uzder(3,1,1)= dc_norm(2,i+1)
1577 uzder(1,2,1)= dc_norm(3,i+1)
1579 uzder(3,2,1)=-dc_norm(1,i+1)
1580 uzder(1,3,1)=-dc_norm(2,i+1)
1581 uzder(2,3,1)= dc_norm(1,i+1)
1584 uzder(2,1,2)= dc_norm(3,i)
1585 uzder(3,1,2)=-dc_norm(2,i)
1586 uzder(1,2,2)=-dc_norm(3,i)
1588 uzder(3,2,2)= dc_norm(1,i)
1589 uzder(1,3,2)= dc_norm(2,i)
1590 uzder(2,3,2)=-dc_norm(1,i)
1592 C Compute the Y-axis
1594 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1595 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1596 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1598 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1601 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1602 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1605 c write (iout,*) 'facy',facy,
1606 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1607 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1609 uy(k,i)=facy*uy(k,i)
1611 C Compute the derivatives of uy
1614 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1615 & -dc_norm(k,i)*dc_norm(j,i+1)
1616 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1618 c uyder(j,j,1)=uyder(j,j,1)-costh
1619 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1620 uyder(j,j,1)=uyder(j,j,1)
1621 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1622 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1628 uygrad(l,k,j,i)=uyder(l,k,j)
1629 uzgrad(l,k,j,i)=uzder(l,k,j)
1633 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1634 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1635 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1636 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1643 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1644 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1651 C-----------------------------------------------------------------------------
1652 subroutine check_vecgrad
1653 implicit real*8 (a-h,o-z)
1654 include 'DIMENSIONS'
1655 include 'DIMENSIONS.ZSCOPT'
1656 include 'COMMON.IOUNITS'
1657 include 'COMMON.GEO'
1658 include 'COMMON.VAR'
1659 include 'COMMON.LOCAL'
1660 include 'COMMON.CHAIN'
1661 include 'COMMON.VECTORS'
1662 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1663 dimension uyt(3,maxres),uzt(3,maxres)
1664 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1665 double precision delta /1.0d-7/
1668 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1669 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1670 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1671 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1672 cd & (dc_norm(if90,i),if90=1,3)
1673 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1674 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1675 cd write(iout,'(a)')
1681 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1682 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1695 cd write (iout,*) 'i=',i
1697 erij(k)=dc_norm(k,i)
1701 dc_norm(k,i)=erij(k)
1703 dc_norm(j,i)=dc_norm(j,i)+delta
1704 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1706 c dc_norm(k,i)=dc_norm(k,i)/fac
1708 c write (iout,*) (dc_norm(k,i),k=1,3)
1709 c write (iout,*) (erij(k),k=1,3)
1712 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1713 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1714 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1715 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1717 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1718 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1719 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1722 dc_norm(k,i)=erij(k)
1725 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1726 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1727 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1728 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1729 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1730 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1731 cd write (iout,'(a)')
1736 C--------------------------------------------------------------------------
1737 subroutine set_matrices
1738 implicit real*8 (a-h,o-z)
1739 include 'DIMENSIONS'
1740 include 'DIMENSIONS.ZSCOPT'
1741 include 'COMMON.IOUNITS'
1742 include 'COMMON.GEO'
1743 include 'COMMON.VAR'
1744 include 'COMMON.LOCAL'
1745 include 'COMMON.CHAIN'
1746 include 'COMMON.DERIV'
1747 include 'COMMON.INTERACT'
1748 include 'COMMON.CONTACTS'
1749 include 'COMMON.TORSION'
1750 include 'COMMON.VECTORS'
1751 include 'COMMON.FFIELD'
1752 double precision auxvec(2),auxmat(2,2)
1754 C Compute the virtual-bond-torsional-angle dependent quantities needed
1755 C to calculate the el-loc multibody terms of various order.
1758 if (i .lt. nres+1) then
1795 if (i .gt. 3 .and. i .lt. nres+1) then
1796 obrot_der(1,i-2)=-sin1
1797 obrot_der(2,i-2)= cos1
1798 Ugder(1,1,i-2)= sin1
1799 Ugder(1,2,i-2)=-cos1
1800 Ugder(2,1,i-2)=-cos1
1801 Ugder(2,2,i-2)=-sin1
1804 obrot2_der(1,i-2)=-dwasin2
1805 obrot2_der(2,i-2)= dwacos2
1806 Ug2der(1,1,i-2)= dwasin2
1807 Ug2der(1,2,i-2)=-dwacos2
1808 Ug2der(2,1,i-2)=-dwacos2
1809 Ug2der(2,2,i-2)=-dwasin2
1811 obrot_der(1,i-2)=0.0d0
1812 obrot_der(2,i-2)=0.0d0
1813 Ugder(1,1,i-2)=0.0d0
1814 Ugder(1,2,i-2)=0.0d0
1815 Ugder(2,1,i-2)=0.0d0
1816 Ugder(2,2,i-2)=0.0d0
1817 obrot2_der(1,i-2)=0.0d0
1818 obrot2_der(2,i-2)=0.0d0
1819 Ug2der(1,1,i-2)=0.0d0
1820 Ug2der(1,2,i-2)=0.0d0
1821 Ug2der(2,1,i-2)=0.0d0
1822 Ug2der(2,2,i-2)=0.0d0
1824 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1825 if (itype(i-2).le.ntyp) then
1826 iti = itortyp(itype(i-2))
1833 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1834 if (itype(i-1).le.ntyp) then
1835 iti1 = itortyp(itype(i-1))
1842 cd write (iout,*) '*******i',i,' iti1',iti
1843 cd write (iout,*) 'b1',b1(:,iti)
1844 cd write (iout,*) 'b2',b2(:,iti)
1845 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1846 c print *,"itilde1 i iti iti1",i,iti,iti1
1847 if (i .gt. iatel_s+2) then
1848 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1849 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1850 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1851 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1852 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1853 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1854 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1864 DtUg2(l,k,i-2)=0.0d0
1868 c print *,"itilde2 i iti iti1",i,iti,iti1
1869 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1870 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1871 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1872 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1873 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1874 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1875 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1876 c print *,"itilde3 i iti iti1",i,iti,iti1
1878 muder(k,i-2)=Ub2der(k,i-2)
1880 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1881 if (itype(i-1).le.ntyp) then
1882 iti1 = itortyp(itype(i-1))
1890 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1892 C Vectors and matrices dependent on a single virtual-bond dihedral.
1893 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1894 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1895 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1896 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1897 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1898 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1899 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1900 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1901 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1902 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1903 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1905 C Matrices dependent on two consecutive virtual-bond dihedrals.
1906 C The order of matrices is from left to right.
1908 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1909 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1910 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1911 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1912 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1913 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1914 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1915 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1918 cd iti = itortyp(itype(i))
1921 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1922 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1927 C--------------------------------------------------------------------------
1928 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1930 C This subroutine calculates the average interaction energy and its gradient
1931 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1932 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1933 C The potential depends both on the distance of peptide-group centers and on
1934 C the orientation of the CA-CA virtual bonds.
1936 implicit real*8 (a-h,o-z)
1937 include 'DIMENSIONS'
1938 include 'DIMENSIONS.ZSCOPT'
1939 include 'DIMENSIONS.FREE'
1940 include 'COMMON.CONTROL'
1941 include 'COMMON.IOUNITS'
1942 include 'COMMON.GEO'
1943 include 'COMMON.VAR'
1944 include 'COMMON.LOCAL'
1945 include 'COMMON.CHAIN'
1946 include 'COMMON.DERIV'
1947 include 'COMMON.INTERACT'
1948 include 'COMMON.CONTACTS'
1949 include 'COMMON.TORSION'
1950 include 'COMMON.VECTORS'
1951 include 'COMMON.FFIELD'
1952 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1953 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1954 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1955 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1956 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1957 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1958 double precision scal_el /0.5d0/
1960 C 13-go grudnia roku pamietnego...
1961 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1962 & 0.0d0,1.0d0,0.0d0,
1963 & 0.0d0,0.0d0,1.0d0/
1964 cd write(iout,*) 'In EELEC'
1966 cd write(iout,*) 'Type',i
1967 cd write(iout,*) 'B1',B1(:,i)
1968 cd write(iout,*) 'B2',B2(:,i)
1969 cd write(iout,*) 'CC',CC(:,:,i)
1970 cd write(iout,*) 'DD',DD(:,:,i)
1971 cd write(iout,*) 'EE',EE(:,:,i)
1973 cd call check_vecgrad
1975 if (icheckgrad.eq.1) then
1977 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1979 dc_norm(k,i)=dc(k,i)*fac
1981 c write (iout,*) 'i',i,' fac',fac
1984 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1985 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1986 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1987 cd if (wel_loc.gt.0.0d0) then
1988 if (icheckgrad.eq.1) then
1989 call vec_and_deriv_test
1996 cd write (iout,*) 'i=',i
1998 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2001 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2002 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2015 cd print '(a)','Enter EELEC'
2016 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2018 gel_loc_loc(i)=0.0d0
2021 do i=iatel_s,iatel_e
2023 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2024 & .or. ((i+2).gt.nres)
2026 & .or. itype(i+2).eq.ntyp1
2027 & .or. itype(i-1).eq.ntyp1
2030 if (itel(i).eq.0) goto 1215
2034 dx_normi=dc_norm(1,i)
2035 dy_normi=dc_norm(2,i)
2036 dz_normi=dc_norm(3,i)
2037 xmedi=c(1,i)+0.5d0*dxi
2038 ymedi=c(2,i)+0.5d0*dyi
2039 zmedi=c(3,i)+0.5d0*dzi
2040 xmedi=mod(xmedi,boxxsize)
2041 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2042 ymedi=mod(ymedi,boxysize)
2043 if (ymedi.lt.0) ymedi=ymedi+boxysize
2044 zmedi=mod(zmedi,boxzsize)
2045 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2047 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2048 do j=ielstart(i),ielend(i)
2050 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2051 & .or.((j+2).gt.nres)
2053 & .or.itype(j+2).eq.ntyp1
2054 & .or.itype(j-1).eq.ntyp1
2056 if (itel(j).eq.0) goto 1216
2060 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2061 aaa=app(iteli,itelj)
2062 bbb=bpp(iteli,itelj)
2063 C Diagnostics only!!!
2069 ael6i=ael6(iteli,itelj)
2070 ael3i=ael3(iteli,itelj)
2074 dx_normj=dc_norm(1,j)
2075 dy_normj=dc_norm(2,j)
2076 dz_normj=dc_norm(3,j)
2081 if (xj.lt.0) xj=xj+boxxsize
2083 if (yj.lt.0) yj=yj+boxysize
2085 if (zj.lt.0) zj=zj+boxzsize
2086 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2094 xj=xj_safe+xshift*boxxsize
2095 yj=yj_safe+yshift*boxysize
2096 zj=zj_safe+zshift*boxzsize
2097 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2098 if(dist_temp.lt.dist_init) then
2108 if (isubchap.eq.1) then
2117 rij=xj*xj+yj*yj+zj*zj
2118 sss=sscale(sqrt(rij))
2119 sssgrad=sscagrad(sqrt(rij))
2125 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2126 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2127 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2128 fac=cosa-3.0D0*cosb*cosg
2130 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2131 if (j.eq.i+2) ev1=scal_el*ev1
2136 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2139 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2140 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2141 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2143 evdw1=evdw1+evdwij*sss
2144 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2145 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2146 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2147 cd & xmedi,ymedi,zmedi,xj,yj,zj
2149 C Calculate contributions to the Cartesian gradient.
2152 facvdw=-6*rrmij*(ev1+evdwij)*sss
2153 facel=-3*rrmij*(el1+eesij)
2160 * Radial derivatives. First process both termini of the fragment (i,j)
2167 gelc(k,i)=gelc(k,i)+ghalf
2168 gelc(k,j)=gelc(k,j)+ghalf
2171 * Loop over residues i+1 thru j-1.
2175 gelc(l,k)=gelc(l,k)+ggg(l)
2183 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2184 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2187 * Loop over residues i+1 thru j-1.
2191 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2198 fac=-3*rrmij*(facvdw+facvdw+facel)
2204 * Radial derivatives. First process both termini of the fragment (i,j)
2211 gelc(k,i)=gelc(k,i)+ghalf
2212 gelc(k,j)=gelc(k,j)+ghalf
2215 * Loop over residues i+1 thru j-1.
2219 gelc(l,k)=gelc(l,k)+ggg(l)
2226 ecosa=2.0D0*fac3*fac1+fac4
2229 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2230 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2232 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2233 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2235 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2236 cd & (dcosg(k),k=1,3)
2238 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2242 gelc(k,i)=gelc(k,i)+ghalf
2243 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2244 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2245 gelc(k,j)=gelc(k,j)+ghalf
2246 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2247 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2251 gelc(l,k)=gelc(l,k)+ggg(l)
2256 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2257 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2258 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2260 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2261 C energy of a peptide unit is assumed in the form of a second-order
2262 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2263 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2264 C are computed for EVERY pair of non-contiguous peptide groups.
2266 if (j.lt.nres-1) then
2277 muij(kkk)=mu(k,i)*mu(l,j)
2280 cd write (iout,*) 'EELEC: i',i,' j',j
2281 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2282 cd write(iout,*) 'muij',muij
2283 ury=scalar(uy(1,i),erij)
2284 urz=scalar(uz(1,i),erij)
2285 vry=scalar(uy(1,j),erij)
2286 vrz=scalar(uz(1,j),erij)
2287 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2288 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2289 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2290 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2291 C For diagnostics only
2296 fac=dsqrt(-ael6i)*r3ij
2297 cd write (2,*) 'fac=',fac
2298 C For diagnostics only
2304 cd write (iout,'(4i5,4f10.5)')
2305 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2306 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2307 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2308 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2309 cd write (iout,'(4f10.5)')
2310 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2311 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2312 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2313 cd write (iout,'(2i3,9f10.5/)') i,j,
2314 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2316 C Derivatives of the elements of A in virtual-bond vectors
2317 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2345 C Compute radial contributions to the gradient
2367 C Add the contributions coming from er
2370 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2371 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2372 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2373 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2376 C Derivatives in DC(i)
2377 ghalf1=0.5d0*agg(k,1)
2378 ghalf2=0.5d0*agg(k,2)
2379 ghalf3=0.5d0*agg(k,3)
2380 ghalf4=0.5d0*agg(k,4)
2381 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2382 & -3.0d0*uryg(k,2)*vry)+ghalf1
2383 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2384 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2385 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2386 & -3.0d0*urzg(k,2)*vry)+ghalf3
2387 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2388 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2389 C Derivatives in DC(i+1)
2390 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2391 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2392 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2393 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2394 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2395 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2396 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2397 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2398 C Derivatives in DC(j)
2399 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2400 & -3.0d0*vryg(k,2)*ury)+ghalf1
2401 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2402 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2403 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2404 & -3.0d0*vryg(k,2)*urz)+ghalf3
2405 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2406 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2407 C Derivatives in DC(j+1) or DC(nres-1)
2408 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2409 & -3.0d0*vryg(k,3)*ury)
2410 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2411 & -3.0d0*vrzg(k,3)*ury)
2412 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2413 & -3.0d0*vryg(k,3)*urz)
2414 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2415 & -3.0d0*vrzg(k,3)*urz)
2420 C Derivatives in DC(i+1)
2421 cd aggi1(k,1)=agg(k,1)
2422 cd aggi1(k,2)=agg(k,2)
2423 cd aggi1(k,3)=agg(k,3)
2424 cd aggi1(k,4)=agg(k,4)
2425 C Derivatives in DC(j)
2430 C Derivatives in DC(j+1)
2435 if (j.eq.nres-1 .and. i.lt.j-2) then
2437 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2438 cd aggj1(k,l)=agg(k,l)
2444 C Check the loc-el terms by numerical integration
2454 aggi(k,l)=-aggi(k,l)
2455 aggi1(k,l)=-aggi1(k,l)
2456 aggj(k,l)=-aggj(k,l)
2457 aggj1(k,l)=-aggj1(k,l)
2460 if (j.lt.nres-1) then
2466 aggi(k,l)=-aggi(k,l)
2467 aggi1(k,l)=-aggi1(k,l)
2468 aggj(k,l)=-aggj(k,l)
2469 aggj1(k,l)=-aggj1(k,l)
2480 aggi(k,l)=-aggi(k,l)
2481 aggi1(k,l)=-aggi1(k,l)
2482 aggj(k,l)=-aggj(k,l)
2483 aggj1(k,l)=-aggj1(k,l)
2489 IF (wel_loc.gt.0.0d0) THEN
2490 C Contribution to the local-electrostatic energy coming from the i-j pair
2491 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2493 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2494 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2495 eel_loc=eel_loc+eel_loc_ij
2496 C Partial derivatives in virtual-bond dihedral angles gamma
2499 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2500 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2501 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2502 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2503 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2504 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2505 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2506 cd write(iout,*) 'agg ',agg
2507 cd write(iout,*) 'aggi ',aggi
2508 cd write(iout,*) 'aggi1',aggi1
2509 cd write(iout,*) 'aggj ',aggj
2510 cd write(iout,*) 'aggj1',aggj1
2512 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2514 ggg(l)=agg(l,1)*muij(1)+
2515 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2519 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2522 C Remaining derivatives of eello
2524 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2525 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2526 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2527 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2528 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2529 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2530 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2531 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2535 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2536 C Contributions from turns
2541 call eturn34(i,j,eello_turn3,eello_turn4)
2543 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2544 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2546 C Calculate the contact function. The ith column of the array JCONT will
2547 C contain the numbers of atoms that make contacts with the atom I (of numbers
2548 C greater than I). The arrays FACONT and GACONT will contain the values of
2549 C the contact function and its derivative.
2550 c r0ij=1.02D0*rpp(iteli,itelj)
2551 c r0ij=1.11D0*rpp(iteli,itelj)
2552 r0ij=2.20D0*rpp(iteli,itelj)
2553 c r0ij=1.55D0*rpp(iteli,itelj)
2554 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2555 if (fcont.gt.0.0D0) then
2556 num_conti=num_conti+1
2557 if (num_conti.gt.maxconts) then
2558 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2559 & ' will skip next contacts for this conf.'
2561 jcont_hb(num_conti,i)=j
2562 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2563 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2564 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2566 d_cont(num_conti,i)=rij
2567 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2568 C --- Electrostatic-interaction matrix ---
2569 a_chuj(1,1,num_conti,i)=a22
2570 a_chuj(1,2,num_conti,i)=a23
2571 a_chuj(2,1,num_conti,i)=a32
2572 a_chuj(2,2,num_conti,i)=a33
2573 C --- Gradient of rij
2575 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2578 c a_chuj(1,1,num_conti,i)=-0.61d0
2579 c a_chuj(1,2,num_conti,i)= 0.4d0
2580 c a_chuj(2,1,num_conti,i)= 0.65d0
2581 c a_chuj(2,2,num_conti,i)= 0.50d0
2582 c else if (i.eq.2) then
2583 c a_chuj(1,1,num_conti,i)= 0.0d0
2584 c a_chuj(1,2,num_conti,i)= 0.0d0
2585 c a_chuj(2,1,num_conti,i)= 0.0d0
2586 c a_chuj(2,2,num_conti,i)= 0.0d0
2588 C --- and its gradients
2589 cd write (iout,*) 'i',i,' j',j
2591 cd write (iout,*) 'iii 1 kkk',kkk
2592 cd write (iout,*) agg(kkk,:)
2595 cd write (iout,*) 'iii 2 kkk',kkk
2596 cd write (iout,*) aggi(kkk,:)
2599 cd write (iout,*) 'iii 3 kkk',kkk
2600 cd write (iout,*) aggi1(kkk,:)
2603 cd write (iout,*) 'iii 4 kkk',kkk
2604 cd write (iout,*) aggj(kkk,:)
2607 cd write (iout,*) 'iii 5 kkk',kkk
2608 cd write (iout,*) aggj1(kkk,:)
2615 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2616 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2617 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2618 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2619 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2621 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2627 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2628 C Calculate contact energies
2630 wij=cosa-3.0D0*cosb*cosg
2633 c fac3=dsqrt(-ael6i)/r0ij**3
2634 fac3=dsqrt(-ael6i)*r3ij
2635 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2636 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2638 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2639 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2640 C Diagnostics. Comment out or remove after debugging!
2641 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2642 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2643 c ees0m(num_conti,i)=0.0D0
2645 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2646 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2647 facont_hb(num_conti,i)=fcont
2649 C Angular derivatives of the contact function
2650 ees0pij1=fac3/ees0pij
2651 ees0mij1=fac3/ees0mij
2652 fac3p=-3.0D0*fac3*rrmij
2653 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2654 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2656 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2657 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2658 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2659 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2660 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2661 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2662 ecosap=ecosa1+ecosa2
2663 ecosbp=ecosb1+ecosb2
2664 ecosgp=ecosg1+ecosg2
2665 ecosam=ecosa1-ecosa2
2666 ecosbm=ecosb1-ecosb2
2667 ecosgm=ecosg1-ecosg2
2676 fprimcont=fprimcont/rij
2677 cd facont_hb(num_conti,i)=1.0D0
2678 C Following line is for diagnostics.
2681 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2682 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2685 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2686 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2688 gggp(1)=gggp(1)+ees0pijp*xj
2689 gggp(2)=gggp(2)+ees0pijp*yj
2690 gggp(3)=gggp(3)+ees0pijp*zj
2691 gggm(1)=gggm(1)+ees0mijp*xj
2692 gggm(2)=gggm(2)+ees0mijp*yj
2693 gggm(3)=gggm(3)+ees0mijp*zj
2694 C Derivatives due to the contact function
2695 gacont_hbr(1,num_conti,i)=fprimcont*xj
2696 gacont_hbr(2,num_conti,i)=fprimcont*yj
2697 gacont_hbr(3,num_conti,i)=fprimcont*zj
2699 ghalfp=0.5D0*gggp(k)
2700 ghalfm=0.5D0*gggm(k)
2701 gacontp_hb1(k,num_conti,i)=ghalfp
2702 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2703 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2704 gacontp_hb2(k,num_conti,i)=ghalfp
2705 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2706 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2707 gacontp_hb3(k,num_conti,i)=gggp(k)
2708 gacontm_hb1(k,num_conti,i)=ghalfm
2709 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2710 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2711 gacontm_hb2(k,num_conti,i)=ghalfm
2712 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2713 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2714 gacontm_hb3(k,num_conti,i)=gggm(k)
2717 C Diagnostics. Comment out or remove after debugging!
2719 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2720 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2721 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2722 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2723 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2724 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2727 endif ! num_conti.le.maxconts
2732 num_cont_hb(i)=num_conti
2736 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2737 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2739 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2740 ccc eel_loc=eel_loc+eello_turn3
2743 C-----------------------------------------------------------------------------
2744 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2745 C Third- and fourth-order contributions from turns
2746 implicit real*8 (a-h,o-z)
2747 include 'DIMENSIONS'
2748 include 'DIMENSIONS.ZSCOPT'
2749 include 'COMMON.IOUNITS'
2750 include 'COMMON.GEO'
2751 include 'COMMON.VAR'
2752 include 'COMMON.LOCAL'
2753 include 'COMMON.CHAIN'
2754 include 'COMMON.DERIV'
2755 include 'COMMON.INTERACT'
2756 include 'COMMON.CONTACTS'
2757 include 'COMMON.TORSION'
2758 include 'COMMON.VECTORS'
2759 include 'COMMON.FFIELD'
2761 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2762 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2763 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2764 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2765 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2766 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2768 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2769 C changes suggested by Ana to avoid out of bounds
2770 C & .or.((i+5).gt.nres)
2771 C & .or.((i-1).le.0)
2772 C end of changes suggested by Ana
2773 & .or. itype(i+2).eq.ntyp1
2774 & .or. itype(i+3).eq.ntyp1
2775 C & .or. itype(i+5).eq.ntyp1
2776 C & .or. itype(i).eq.ntyp1
2777 C & .or. itype(i-1).eq.ntyp1
2780 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2782 C Third-order contributions
2789 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2790 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2791 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2792 call transpose2(auxmat(1,1),auxmat1(1,1))
2793 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2794 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2795 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2796 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2797 cd & ' eello_turn3_num',4*eello_turn3_num
2799 C Derivatives in gamma(i)
2800 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2801 call transpose2(auxmat2(1,1),pizda(1,1))
2802 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2803 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2804 C Derivatives in gamma(i+1)
2805 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2806 call transpose2(auxmat2(1,1),pizda(1,1))
2807 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2808 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2809 & +0.5d0*(pizda(1,1)+pizda(2,2))
2810 C Cartesian derivatives
2812 a_temp(1,1)=aggi(l,1)
2813 a_temp(1,2)=aggi(l,2)
2814 a_temp(2,1)=aggi(l,3)
2815 a_temp(2,2)=aggi(l,4)
2816 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2817 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2818 & +0.5d0*(pizda(1,1)+pizda(2,2))
2819 a_temp(1,1)=aggi1(l,1)
2820 a_temp(1,2)=aggi1(l,2)
2821 a_temp(2,1)=aggi1(l,3)
2822 a_temp(2,2)=aggi1(l,4)
2823 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2824 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2825 & +0.5d0*(pizda(1,1)+pizda(2,2))
2826 a_temp(1,1)=aggj(l,1)
2827 a_temp(1,2)=aggj(l,2)
2828 a_temp(2,1)=aggj(l,3)
2829 a_temp(2,2)=aggj(l,4)
2830 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2831 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2832 & +0.5d0*(pizda(1,1)+pizda(2,2))
2833 a_temp(1,1)=aggj1(l,1)
2834 a_temp(1,2)=aggj1(l,2)
2835 a_temp(2,1)=aggj1(l,3)
2836 a_temp(2,2)=aggj1(l,4)
2837 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2838 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2839 & +0.5d0*(pizda(1,1)+pizda(2,2))
2843 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2844 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2845 C changes suggested by Ana to avoid out of bounds
2846 C & .or.((i+5).gt.nres)
2847 C & .or.((i-1).le.0)
2848 C end of changes suggested by Ana
2849 & .or. itype(i+3).eq.ntyp1
2850 & .or. itype(i+4).eq.ntyp1
2851 C & .or. itype(i+5).eq.ntyp1
2852 & .or. itype(i).eq.ntyp1
2853 C & .or. itype(i-1).eq.ntyp1
2855 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2857 C Fourth-order contributions
2865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2866 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2867 iti1=itortyp(itype(i+1))
2868 iti2=itortyp(itype(i+2))
2869 iti3=itortyp(itype(i+3))
2870 call transpose2(EUg(1,1,i+1),e1t(1,1))
2871 call transpose2(Eug(1,1,i+2),e2t(1,1))
2872 call transpose2(Eug(1,1,i+3),e3t(1,1))
2873 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2874 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2875 s1=scalar2(b1(1,iti2),auxvec(1))
2876 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2877 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2878 s2=scalar2(b1(1,iti1),auxvec(1))
2879 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2880 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2881 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2882 eello_turn4=eello_turn4-(s1+s2+s3)
2883 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2884 cd & ' eello_turn4_num',8*eello_turn4_num
2885 C Derivatives in gamma(i)
2887 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2888 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2889 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2890 s1=scalar2(b1(1,iti2),auxvec(1))
2891 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2892 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2893 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2894 C Derivatives in gamma(i+1)
2895 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2896 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2897 s2=scalar2(b1(1,iti1),auxvec(1))
2898 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2899 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2900 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2901 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2902 C Derivatives in gamma(i+2)
2903 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2904 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2905 s1=scalar2(b1(1,iti2),auxvec(1))
2906 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2907 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2908 s2=scalar2(b1(1,iti1),auxvec(1))
2909 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2910 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2912 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2913 C Cartesian derivatives
2914 C Derivatives of this turn contributions in DC(i+2)
2915 if (j.lt.nres-1) then
2917 a_temp(1,1)=agg(l,1)
2918 a_temp(1,2)=agg(l,2)
2919 a_temp(2,1)=agg(l,3)
2920 a_temp(2,2)=agg(l,4)
2921 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2922 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2923 s1=scalar2(b1(1,iti2),auxvec(1))
2924 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2925 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2926 s2=scalar2(b1(1,iti1),auxvec(1))
2927 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2928 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2929 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2931 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2934 C Remaining derivatives of this turn contribution
2936 a_temp(1,1)=aggi(l,1)
2937 a_temp(1,2)=aggi(l,2)
2938 a_temp(2,1)=aggi(l,3)
2939 a_temp(2,2)=aggi(l,4)
2940 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2941 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2942 s1=scalar2(b1(1,iti2),auxvec(1))
2943 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2944 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2945 s2=scalar2(b1(1,iti1),auxvec(1))
2946 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2947 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2948 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2949 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2950 a_temp(1,1)=aggi1(l,1)
2951 a_temp(1,2)=aggi1(l,2)
2952 a_temp(2,1)=aggi1(l,3)
2953 a_temp(2,2)=aggi1(l,4)
2954 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2955 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2956 s1=scalar2(b1(1,iti2),auxvec(1))
2957 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2958 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2959 s2=scalar2(b1(1,iti1),auxvec(1))
2960 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2961 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2962 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2963 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2964 a_temp(1,1)=aggj(l,1)
2965 a_temp(1,2)=aggj(l,2)
2966 a_temp(2,1)=aggj(l,3)
2967 a_temp(2,2)=aggj(l,4)
2968 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2969 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2970 s1=scalar2(b1(1,iti2),auxvec(1))
2971 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2972 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2973 s2=scalar2(b1(1,iti1),auxvec(1))
2974 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2975 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2976 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2977 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2978 a_temp(1,1)=aggj1(l,1)
2979 a_temp(1,2)=aggj1(l,2)
2980 a_temp(2,1)=aggj1(l,3)
2981 a_temp(2,2)=aggj1(l,4)
2982 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2983 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2984 s1=scalar2(b1(1,iti2),auxvec(1))
2985 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2986 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2987 s2=scalar2(b1(1,iti1),auxvec(1))
2988 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2989 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2990 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2991 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2998 C-----------------------------------------------------------------------------
2999 subroutine vecpr(u,v,w)
3000 implicit real*8(a-h,o-z)
3001 dimension u(3),v(3),w(3)
3002 w(1)=u(2)*v(3)-u(3)*v(2)
3003 w(2)=-u(1)*v(3)+u(3)*v(1)
3004 w(3)=u(1)*v(2)-u(2)*v(1)
3007 C-----------------------------------------------------------------------------
3008 subroutine unormderiv(u,ugrad,unorm,ungrad)
3009 C This subroutine computes the derivatives of a normalized vector u, given
3010 C the derivatives computed without normalization conditions, ugrad. Returns
3013 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3014 double precision vec(3)
3015 double precision scalar
3017 c write (2,*) 'ugrad',ugrad
3020 vec(i)=scalar(ugrad(1,i),u(1))
3022 c write (2,*) 'vec',vec
3025 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3028 c write (2,*) 'ungrad',ungrad
3031 C-----------------------------------------------------------------------------
3032 subroutine escp(evdw2,evdw2_14)
3034 C This subroutine calculates the excluded-volume interaction energy between
3035 C peptide-group centers and side chains and its gradient in virtual-bond and
3036 C side-chain vectors.
3038 implicit real*8 (a-h,o-z)
3039 include 'DIMENSIONS'
3040 include 'DIMENSIONS.ZSCOPT'
3041 include 'COMMON.GEO'
3042 include 'COMMON.VAR'
3043 include 'COMMON.LOCAL'
3044 include 'COMMON.CHAIN'
3045 include 'COMMON.DERIV'
3046 include 'COMMON.INTERACT'
3047 include 'COMMON.FFIELD'
3048 include 'COMMON.IOUNITS'
3052 cd print '(a)','Enter ESCP'
3053 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3054 c & ' scal14',scal14
3055 do i=iatscp_s,iatscp_e
3056 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3058 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3059 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3060 if (iteli.eq.0) goto 1225
3061 xi=0.5D0*(c(1,i)+c(1,i+1))
3062 yi=0.5D0*(c(2,i)+c(2,i+1))
3063 zi=0.5D0*(c(3,i)+c(3,i+1))
3064 C Returning the ith atom to box
3066 if (xi.lt.0) xi=xi+boxxsize
3068 if (yi.lt.0) yi=yi+boxysize
3070 if (zi.lt.0) zi=zi+boxzsize
3071 do iint=1,nscp_gr(i)
3073 do j=iscpstart(i,iint),iscpend(i,iint)
3074 itypj=iabs(itype(j))
3075 if (itypj.eq.ntyp1) cycle
3076 C Uncomment following three lines for SC-p interactions
3080 C Uncomment following three lines for Ca-p interactions
3084 C returning the jth atom to box
3086 if (xj.lt.0) xj=xj+boxxsize
3088 if (yj.lt.0) yj=yj+boxysize
3090 if (zj.lt.0) zj=zj+boxzsize
3091 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3096 C Finding the closest jth atom
3100 xj=xj_safe+xshift*boxxsize
3101 yj=yj_safe+yshift*boxysize
3102 zj=zj_safe+zshift*boxzsize
3103 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3104 if(dist_temp.lt.dist_init) then
3114 if (subchap.eq.1) then
3123 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3124 C sss is scaling function for smoothing the cutoff gradient otherwise
3125 C the gradient would not be continuouse
3126 sss=sscale(1.0d0/(dsqrt(rrij)))
3127 if (sss.le.0.0d0) cycle
3128 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3130 e1=fac*fac*aad(itypj,iteli)
3131 e2=fac*bad(itypj,iteli)
3132 if (iabs(j-i) .le. 2) then
3135 evdw2_14=evdw2_14+(e1+e2)*sss
3138 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3139 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3140 c & bad(itypj,iteli)
3141 evdw2=evdw2+evdwij*sss
3144 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3146 fac=-(evdwij+e1)*rrij*sss
3147 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3152 cd write (iout,*) 'j<i'
3153 C Uncomment following three lines for SC-p interactions
3155 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3158 cd write (iout,*) 'j>i'
3161 C Uncomment following line for SC-p interactions
3162 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3166 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3170 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3171 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3174 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3184 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3185 gradx_scp(j,i)=expon*gradx_scp(j,i)
3188 C******************************************************************************
3192 C To save time the factor EXPON has been extracted from ALL components
3193 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3196 C******************************************************************************
3199 C--------------------------------------------------------------------------
3200 subroutine edis(ehpb)
3202 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3204 implicit real*8 (a-h,o-z)
3205 include 'DIMENSIONS'
3206 include 'DIMENSIONS.ZSCOPT'
3207 include 'DIMENSIONS.FREE'
3208 include 'COMMON.SBRIDGE'
3209 include 'COMMON.CHAIN'
3210 include 'COMMON.DERIV'
3211 include 'COMMON.VAR'
3212 include 'COMMON.INTERACT'
3213 include 'COMMON.CONTROL'
3214 include 'COMMON.IOUNITS'
3217 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3218 cd print *,'link_start=',link_start,' link_end=',link_end
3219 C write(iout,*) link_end, "link_end"
3220 if (link_end.eq.0) return
3221 do i=link_start,link_end
3222 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3223 C CA-CA distance used in regularization of structure.
3226 C iii and jjj point to the residues for which the distance is assigned.
3227 if (ii.gt.nres) then
3234 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3235 C distance and angle dependent SS bond potential.
3236 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3237 C & iabs(itype(jjj)).eq.1) then
3238 C write(iout,*) constr_dist,"const"
3239 if (.not.dyn_ss .and. i.le.nss) then
3240 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3241 & iabs(itype(jjj)).eq.1) then
3242 call ssbond_ene(iii,jjj,eij)
3245 else if (ii.gt.nres .and. jj.gt.nres) then
3246 c Restraints from contact prediction
3248 if (constr_dist.eq.11) then
3249 C ehpb=ehpb+fordepth(i)**4.0d0
3250 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3251 ehpb=ehpb+fordepth(i)**4.0d0
3252 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3253 fac=fordepth(i)**4.0d0
3254 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3255 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3256 C & ehpb,fordepth(i),dd
3257 C write(iout,*) ehpb,"atu?"
3259 C fac=fordepth(i)**4.0d0
3260 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3262 if (dhpb1(i).gt.0.0d0) then
3263 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3264 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3265 c write (iout,*) "beta nmr",
3266 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3270 C Get the force constant corresponding to this distance.
3272 C Calculate the contribution to energy.
3273 ehpb=ehpb+waga*rdis*rdis
3274 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3276 C Evaluate gradient.
3279 endif !end dhpb1(i).gt.0
3280 endif !end const_dist=11
3282 ggg(j)=fac*(c(j,jj)-c(j,ii))
3285 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3286 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3289 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3290 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3293 C write(iout,*) "before"
3295 C write(iout,*) "after",dd
3296 if (constr_dist.eq.11) then
3297 ehpb=ehpb+fordepth(i)**4.0d0
3298 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3299 fac=fordepth(i)**4.0d0
3300 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3301 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3302 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3303 C print *,ehpb,"tu?"
3304 C write(iout,*) ehpb,"btu?",
3305 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3306 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3307 C & ehpb,fordepth(i),dd
3309 if (dhpb1(i).gt.0.0d0) then
3310 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3311 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3312 c write (iout,*) "alph nmr",
3313 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3316 C Get the force constant corresponding to this distance.
3318 C Calculate the contribution to energy.
3319 ehpb=ehpb+waga*rdis*rdis
3320 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3322 C Evaluate gradient.
3329 ggg(j)=fac*(c(j,jj)-c(j,ii))
3331 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3332 C If this is a SC-SC distance, we need to calculate the contributions to the
3333 C Cartesian gradient in the SC vectors (ghpbx).
3336 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3337 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3342 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3347 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3350 C--------------------------------------------------------------------------
3351 subroutine ssbond_ene(i,j,eij)
3353 C Calculate the distance and angle dependent SS-bond potential energy
3354 C using a free-energy function derived based on RHF/6-31G** ab initio
3355 C calculations of diethyl disulfide.
3357 C A. Liwo and U. Kozlowska, 11/24/03
3359 implicit real*8 (a-h,o-z)
3360 include 'DIMENSIONS'
3361 include 'DIMENSIONS.ZSCOPT'
3362 include 'COMMON.SBRIDGE'
3363 include 'COMMON.CHAIN'
3364 include 'COMMON.DERIV'
3365 include 'COMMON.LOCAL'
3366 include 'COMMON.INTERACT'
3367 include 'COMMON.VAR'
3368 include 'COMMON.IOUNITS'
3369 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3370 itypi=iabs(itype(i))
3374 dxi=dc_norm(1,nres+i)
3375 dyi=dc_norm(2,nres+i)
3376 dzi=dc_norm(3,nres+i)
3377 dsci_inv=dsc_inv(itypi)
3378 itypj=iabs(itype(j))
3379 dscj_inv=dsc_inv(itypj)
3383 dxj=dc_norm(1,nres+j)
3384 dyj=dc_norm(2,nres+j)
3385 dzj=dc_norm(3,nres+j)
3386 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3391 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3392 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3393 om12=dxi*dxj+dyi*dyj+dzi*dzj
3395 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3396 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3402 deltat12=om2-om1+2.0d0
3404 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3405 & +akct*deltad*deltat12
3406 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3407 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3408 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3409 c & " deltat12",deltat12," eij",eij
3410 ed=2*akcm*deltad+akct*deltat12
3412 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3413 eom1=-2*akth*deltat1-pom1-om2*pom2
3414 eom2= 2*akth*deltat2+pom1-om1*pom2
3417 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3420 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3421 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3422 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3423 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3426 C Calculate the components of the gradient in DC and X
3430 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3435 C--------------------------------------------------------------------------
3436 c MODELLER restraint function
3437 subroutine e_modeller(ehomology_constr)
3438 implicit real*8 (a-h,o-z)
3439 include 'DIMENSIONS'
3440 include 'DIMENSIONS.ZSCOPT'
3441 include 'DIMENSIONS.FREE'
3442 integer nnn, i, j, k, ki, irec, l
3443 integer katy, odleglosci, test7
3444 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3445 real*8 distance(max_template),distancek(max_template),
3446 & min_odl,godl(max_template),dih_diff(max_template)
3449 c FP - 30/10/2014 Temporary specifications for homology restraints
3451 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3453 double precision, dimension (maxres) :: guscdiff,usc_diff
3454 double precision, dimension (max_template) ::
3455 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3458 include 'COMMON.SBRIDGE'
3459 include 'COMMON.CHAIN'
3460 include 'COMMON.GEO'
3461 include 'COMMON.DERIV'
3462 include 'COMMON.LOCAL'
3463 include 'COMMON.INTERACT'
3464 include 'COMMON.VAR'
3465 include 'COMMON.IOUNITS'
3466 include 'COMMON.CONTROL'
3467 include 'COMMON.HOMRESTR'
3469 include 'COMMON.SETUP'
3470 include 'COMMON.NAMES'
3473 distancek(i)=9999999.9
3478 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3480 C AL 5/2/14 - Introduce list of restraints
3481 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3483 write(iout,*) "------- dist restrs start -------"
3485 do ii = link_start_homo,link_end_homo
3489 c write (iout,*) "dij(",i,j,") =",dij
3490 do k=1,constr_homology
3491 if(.not.l_homo(k,ii)) cycle
3492 distance(k)=odl(k,ii)-dij
3493 c write (iout,*) "distance(",k,") =",distance(k)
3495 c For Gaussian-type Urestr
3497 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3498 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3499 c write (iout,*) "distancek(",k,") =",distancek(k)
3500 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3502 c For Lorentzian-type Urestr
3504 if (waga_dist.lt.0.0d0) then
3505 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3506 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3507 & (distance(k)**2+sigma_odlir(k,ii)**2))
3511 c min_odl=minval(distancek)
3512 do kk=1,constr_homology
3513 if(l_homo(kk,ii)) then
3514 min_odl=distancek(kk)
3518 do kk=1,constr_homology
3519 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3520 & min_odl=distancek(kk)
3522 c write (iout,* )"min_odl",min_odl
3524 write (iout,*) "ij dij",i,j,dij
3525 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3526 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3527 write (iout,* )"min_odl",min_odl
3530 do k=1,constr_homology
3531 c Nie wiem po co to liczycie jeszcze raz!
3532 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3533 c & (2*(sigma_odl(i,j,k))**2))
3534 if(.not.l_homo(k,ii)) cycle
3535 if (waga_dist.ge.0.0d0) then
3537 c For Gaussian-type Urestr
3539 godl(k)=dexp(-distancek(k)+min_odl)
3540 odleg2=odleg2+godl(k)
3542 c For Lorentzian-type Urestr
3545 odleg2=odleg2+distancek(k)
3548 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3549 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3550 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3551 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3554 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3555 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3557 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3558 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3560 if (waga_dist.ge.0.0d0) then
3562 c For Gaussian-type Urestr
3564 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3566 c For Lorentzian-type Urestr
3569 odleg=odleg+odleg2/constr_homology
3573 c write (iout,*) "odleg",odleg ! sum of -ln-s
3576 c For Gaussian-type Urestr
3578 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3580 do k=1,constr_homology
3581 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3582 c & *waga_dist)+min_odl
3583 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3585 if(.not.l_homo(k,ii)) cycle
3586 if (waga_dist.ge.0.0d0) then
3587 c For Gaussian-type Urestr
3589 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3591 c For Lorentzian-type Urestr
3594 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3595 & sigma_odlir(k,ii)**2)**2)
3597 sum_sgodl=sum_sgodl+sgodl
3599 c sgodl2=sgodl2+sgodl
3600 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3601 c write(iout,*) "constr_homology=",constr_homology
3602 c write(iout,*) i, j, k, "TEST K"
3604 if (waga_dist.ge.0.0d0) then
3606 c For Gaussian-type Urestr
3608 grad_odl3=waga_homology(iset)*waga_dist
3609 & *sum_sgodl/(sum_godl*dij)
3611 c For Lorentzian-type Urestr
3614 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3615 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3616 grad_odl3=-waga_homology(iset)*waga_dist*
3617 & sum_sgodl/(constr_homology*dij)
3620 c grad_odl3=sum_sgodl/(sum_godl*dij)
3623 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3624 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3625 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3627 ccc write(iout,*) godl, sgodl, grad_odl3
3629 c grad_odl=grad_odl+grad_odl3
3632 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3633 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3634 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3635 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3636 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3637 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3638 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3639 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3640 c if (i.eq.25.and.j.eq.27) then
3641 c write(iout,*) "jik",jik,"i",i,"j",j
3642 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3643 c write(iout,*) "grad_odl3",grad_odl3
3644 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3645 c write(iout,*) "ggodl",ggodl
3646 c write(iout,*) "ghpbc(",jik,i,")",
3647 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3652 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3653 ccc & dLOG(odleg2),"-odleg=", -odleg
3655 enddo ! ii-loop for dist
3657 write(iout,*) "------- dist restrs end -------"
3658 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3659 c & waga_d.eq.1.0d0) call sum_gradient
3661 c Pseudo-energy and gradient from dihedral-angle restraints from
3662 c homology templates
3663 c write (iout,*) "End of distance loop"
3666 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3668 write(iout,*) "------- dih restrs start -------"
3669 do i=idihconstr_start_homo,idihconstr_end_homo
3670 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3673 do i=idihconstr_start_homo,idihconstr_end_homo
3675 c betai=beta(i,i+1,i+2,i+3)
3677 c write (iout,*) "betai =",betai
3678 do k=1,constr_homology
3679 dih_diff(k)=pinorm(dih(k,i)-betai)
3680 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3681 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3682 c & -(6.28318-dih_diff(i,k))
3683 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3684 c & 6.28318+dih_diff(i,k)
3686 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3687 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3690 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3693 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3694 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3696 write (iout,*) "i",i," betai",betai," kat2",kat2
3697 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3699 if (kat2.le.1.0d-14) cycle
3700 kat=kat-dLOG(kat2/constr_homology)
3701 c write (iout,*) "kat",kat ! sum of -ln-s
3703 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3704 ccc & dLOG(kat2), "-kat=", -kat
3707 c ----------------------------------------------------------------------
3709 c ----------------------------------------------------------------------
3713 do k=1,constr_homology
3714 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3715 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3716 sum_sgdih=sum_sgdih+sgdih
3718 c grad_dih3=sum_sgdih/sum_gdih
3719 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3721 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3722 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3723 ccc & gloc(nphi+i-3,icg)
3724 gloc(i,icg)=gloc(i,icg)+grad_dih3
3726 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3728 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3729 ccc & gloc(nphi+i-3,icg)
3731 enddo ! i-loop for dih
3733 write(iout,*) "------- dih restrs end -------"
3736 c Pseudo-energy and gradient for theta angle restraints from
3737 c homology templates
3738 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3742 c For constr_homology reference structures (FP)
3744 c Uconst_back_tot=0.0d0
3747 c Econstr_back legacy
3750 c do i=ithet_start,ithet_end
3753 c do i=loc_start,loc_end
3756 duscdiffx(j,i)=0.0d0
3762 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3763 c write (iout,*) "waga_theta",waga_theta
3764 if (waga_theta.gt.0.0d0) then
3766 write (iout,*) "usampl",usampl
3767 write(iout,*) "------- theta restrs start -------"
3768 c do i=ithet_start,ithet_end
3769 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3772 c write (iout,*) "maxres",maxres,"nres",nres
3774 do i=ithet_start,ithet_end
3777 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3779 c Deviation of theta angles wrt constr_homology ref structures
3781 utheta_i=0.0d0 ! argument of Gaussian for single k
3782 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3783 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3784 c over residues in a fragment
3785 c write (iout,*) "theta(",i,")=",theta(i)
3786 do k=1,constr_homology
3788 c dtheta_i=theta(j)-thetaref(j,iref)
3789 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3790 theta_diff(k)=thetatpl(k,i)-theta(i)
3792 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3793 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3794 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3795 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3796 c Gradient for single Gaussian restraint in subr Econstr_back
3797 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3800 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3801 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3805 c Gradient for multiple Gaussian restraint
3806 sum_gtheta=gutheta_i
3808 do k=1,constr_homology
3809 c New generalized expr for multiple Gaussian from Econstr_back
3810 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3812 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3813 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3816 c Final value of gradient using same var as in Econstr_back
3817 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3818 & *waga_homology(iset)
3819 c dutheta(i)=sum_sgtheta/sum_gtheta
3821 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3823 Eval=Eval-dLOG(gutheta_i/constr_homology)
3824 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3825 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3826 c Uconst_back=Uconst_back+utheta(i)
3827 enddo ! (i-loop for theta)
3829 write(iout,*) "------- theta restrs end -------"
3833 c Deviation of local SC geometry
3835 c Separation of two i-loops (instructed by AL - 11/3/2014)
3837 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3838 c write (iout,*) "waga_d",waga_d
3841 write(iout,*) "------- SC restrs start -------"
3842 write (iout,*) "Initial duscdiff,duscdiffx"
3843 do i=loc_start,loc_end
3844 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3845 & (duscdiffx(jik,i),jik=1,3)
3848 do i=loc_start,loc_end
3849 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3850 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3851 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3852 c write(iout,*) "xxtab, yytab, zztab"
3853 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3854 do k=1,constr_homology
3856 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3857 c Original sign inverted for calc of gradients (s. Econstr_back)
3858 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3859 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3860 c write(iout,*) "dxx, dyy, dzz"
3861 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3863 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3864 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3865 c uscdiffk(k)=usc_diff(i)
3866 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3867 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3868 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3869 c & xxref(j),yyref(j),zzref(j)
3874 c Generalized expression for multiple Gaussian acc to that for a single
3875 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3877 c Original implementation
3878 c sum_guscdiff=guscdiff(i)
3880 c sum_sguscdiff=0.0d0
3881 c do k=1,constr_homology
3882 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3883 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3884 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3887 c Implementation of new expressions for gradient (Jan. 2015)
3889 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3891 do k=1,constr_homology
3893 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3894 c before. Now the drivatives should be correct
3896 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3897 c Original sign inverted for calc of gradients (s. Econstr_back)
3898 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3899 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3901 c New implementation
3903 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3904 & sigma_d(k,i) ! for the grad wrt r'
3905 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3908 c New implementation
3909 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3911 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3912 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3913 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3914 duscdiff(jik,i)=duscdiff(jik,i)+
3915 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3916 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3917 duscdiffx(jik,i)=duscdiffx(jik,i)+
3918 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3919 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3922 write(iout,*) "jik",jik,"i",i
3923 write(iout,*) "dxx, dyy, dzz"
3924 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3925 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3926 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3927 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3928 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3929 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3930 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3931 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3932 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3933 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3934 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3935 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3936 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3937 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3938 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3945 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3946 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3948 c write (iout,*) i," uscdiff",uscdiff(i)
3950 c Put together deviations from local geometry
3952 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3953 c & wfrag_back(3,i,iset)*uscdiff(i)
3954 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3955 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3956 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3957 c Uconst_back=Uconst_back+usc_diff(i)
3959 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3961 c New implment: multiplied by sum_sguscdiff
3964 enddo ! (i-loop for dscdiff)
3969 write(iout,*) "------- SC restrs end -------"
3970 write (iout,*) "------ After SC loop in e_modeller ------"
3971 do i=loc_start,loc_end
3972 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3973 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3975 if (waga_theta.eq.1.0d0) then
3976 write (iout,*) "in e_modeller after SC restr end: dutheta"
3977 do i=ithet_start,ithet_end
3978 write (iout,*) i,dutheta(i)
3981 if (waga_d.eq.1.0d0) then
3982 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3984 write (iout,*) i,(duscdiff(j,i),j=1,3)
3985 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3990 c Total energy from homology restraints
3992 write (iout,*) "odleg",odleg," kat",kat
3993 write (iout,*) "odleg",odleg," kat",kat
3994 write (iout,*) "Eval",Eval," Erot",Erot
3995 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3996 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3997 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4000 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4002 c ehomology_constr=odleg+kat
4004 c For Lorentzian-type Urestr
4007 if (waga_dist.ge.0.0d0) then
4009 c For Gaussian-type Urestr
4011 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4012 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4013 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4014 & waga_theta*Eval+waga_d*Erot
4015 c write (iout,*) "ehomology_constr=",ehomology_constr
4018 c For Lorentzian-type Urestr
4020 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4021 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4022 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4023 & waga_theta*Eval+waga_d*Erot
4024 c write (iout,*) "ehomology_constr=",ehomology_constr
4027 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4028 & "Eval",waga_theta,eval,
4029 & "Erot",waga_d,Erot
4030 write (iout,*) "ehomology_constr",ehomology_constr
4034 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4035 747 format(a12,i4,i4,i4,f8.3,f8.3)
4036 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4037 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4038 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4039 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4041 c-----------------------------------------------------------------------
4042 subroutine ebond(estr)
4044 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4046 implicit real*8 (a-h,o-z)
4047 include 'DIMENSIONS'
4048 include 'DIMENSIONS.ZSCOPT'
4049 include 'DIMENSIONS.FREE'
4050 include 'COMMON.LOCAL'
4051 include 'COMMON.GEO'
4052 include 'COMMON.INTERACT'
4053 include 'COMMON.DERIV'
4054 include 'COMMON.VAR'
4055 include 'COMMON.CHAIN'
4056 include 'COMMON.IOUNITS'
4057 include 'COMMON.NAMES'
4058 include 'COMMON.FFIELD'
4059 include 'COMMON.CONTROL'
4060 logical energy_dec /.false./
4061 double precision u(3),ud(3)
4063 C write (iout,*) "distchainmax",distchainmax
4065 c write (iout,*) "distchainmax",distchainmax
4067 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4068 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4070 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4071 C & *dc(j,i-1)/vbld(i)
4073 C if (energy_dec) write(iout,*)
4074 C & "estr1",i,vbld(i),distchainmax,
4075 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4077 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4078 diff = vbld(i)-vbldpDUM
4079 C write(iout,*) i,diff
4081 diff = vbld(i)-vbldp0
4082 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4086 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4089 C write (iout,'(a7,i5,4f7.3)')
4090 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4092 estr=0.5d0*AKP*estr+estr1
4094 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4098 if (iti.ne.10 .and. iti.ne.ntyp1) then
4101 diff=vbld(i+nres)-vbldsc0(1,iti)
4102 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4103 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4104 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4106 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4110 diff=vbld(i+nres)-vbldsc0(j,iti)
4111 ud(j)=aksc(j,iti)*diff
4112 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4126 uprod2=uprod2*u(k)*u(k)
4130 usumsqder=usumsqder+ud(j)*uprod2
4132 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4133 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4134 estr=estr+uprod/usum
4136 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4144 C--------------------------------------------------------------------------
4145 subroutine ebend(etheta)
4147 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4148 C angles gamma and its derivatives in consecutive thetas and gammas.
4150 implicit real*8 (a-h,o-z)
4151 include 'DIMENSIONS'
4152 include 'DIMENSIONS.ZSCOPT'
4153 include 'COMMON.LOCAL'
4154 include 'COMMON.GEO'
4155 include 'COMMON.INTERACT'
4156 include 'COMMON.DERIV'
4157 include 'COMMON.VAR'
4158 include 'COMMON.CHAIN'
4159 include 'COMMON.IOUNITS'
4160 include 'COMMON.NAMES'
4161 include 'COMMON.FFIELD'
4162 common /calcthet/ term1,term2,termm,diffak,ratak,
4163 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4164 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4165 double precision y(2),z(2)
4167 time11=dexp(-2*time)
4170 c write (iout,*) "nres",nres
4171 c write (*,'(a,i2)') 'EBEND ICG=',icg
4172 c write (iout,*) ithet_start,ithet_end
4173 do i=ithet_start,ithet_end
4174 C if (itype(i-1).eq.ntyp1) cycle
4176 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4177 & .or.itype(i).eq.ntyp1) cycle
4178 C Zero the energy function and its derivative at 0 or pi.
4179 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4181 ichir1=isign(1,itype(i-2))
4182 ichir2=isign(1,itype(i))
4183 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4184 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4185 if (itype(i-1).eq.10) then
4186 itype1=isign(10,itype(i-2))
4187 ichir11=isign(1,itype(i-2))
4188 ichir12=isign(1,itype(i-2))
4189 itype2=isign(10,itype(i))
4190 ichir21=isign(1,itype(i))
4191 ichir22=isign(1,itype(i))
4198 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4202 c call proc_proc(phii,icrc)
4203 if (icrc.eq.1) phii=150.0
4214 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4218 c call proc_proc(phii1,icrc)
4219 if (icrc.eq.1) phii1=150.0
4231 C Calculate the "mean" value of theta from the part of the distribution
4232 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4233 C In following comments this theta will be referred to as t_c.
4234 thet_pred_mean=0.0d0
4236 athetk=athet(k,it,ichir1,ichir2)
4237 bthetk=bthet(k,it,ichir1,ichir2)
4239 athetk=athet(k,itype1,ichir11,ichir12)
4240 bthetk=bthet(k,itype2,ichir21,ichir22)
4242 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4244 c write (iout,*) "thet_pred_mean",thet_pred_mean
4245 dthett=thet_pred_mean*ssd
4246 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4247 c write (iout,*) "thet_pred_mean",thet_pred_mean
4248 C Derivatives of the "mean" values in gamma1 and gamma2.
4249 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4250 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4251 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4252 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4254 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4255 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4256 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4257 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4259 if (theta(i).gt.pi-delta) then
4260 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4262 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4263 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4264 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4266 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4268 else if (theta(i).lt.delta) then
4269 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4270 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4271 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4273 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4274 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4277 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4280 etheta=etheta+ethetai
4281 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4282 c & 'ebend',i,ethetai,theta(i),itype(i)
4283 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4284 c & rad2deg*phii,rad2deg*phii1,ethetai
4285 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4286 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4287 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4291 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4292 do i=1,ntheta_constr
4293 itheta=itheta_constr(i)
4294 thetiii=theta(itheta)
4295 difi=pinorm(thetiii-theta_constr0(i))
4296 if (difi.gt.theta_drange(i)) then
4297 difi=difi-theta_drange(i)
4298 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4299 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4300 & +for_thet_constr(i)*difi**3
4301 else if (difi.lt.-drange(i)) then
4303 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4304 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4305 & +for_thet_constr(i)*difi**3
4309 C if (energy_dec) then
4310 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4311 C & i,itheta,rad2deg*thetiii,
4312 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4313 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4314 C & gloc(itheta+nphi-2,icg)
4317 C Ufff.... We've done all this!!!
4320 C---------------------------------------------------------------------------
4321 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4323 implicit real*8 (a-h,o-z)
4324 include 'DIMENSIONS'
4325 include 'COMMON.LOCAL'
4326 include 'COMMON.IOUNITS'
4327 common /calcthet/ term1,term2,termm,diffak,ratak,
4328 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4329 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4330 C Calculate the contributions to both Gaussian lobes.
4331 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4332 C The "polynomial part" of the "standard deviation" of this part of
4336 sig=sig*thet_pred_mean+polthet(j,it)
4338 C Derivative of the "interior part" of the "standard deviation of the"
4339 C gamma-dependent Gaussian lobe in t_c.
4340 sigtc=3*polthet(3,it)
4342 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4345 C Set the parameters of both Gaussian lobes of the distribution.
4346 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4347 fac=sig*sig+sigc0(it)
4350 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4351 sigsqtc=-4.0D0*sigcsq*sigtc
4352 c print *,i,sig,sigtc,sigsqtc
4353 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4354 sigtc=-sigtc/(fac*fac)
4355 C Following variable is sigma(t_c)**(-2)
4356 sigcsq=sigcsq*sigcsq
4358 sig0inv=1.0D0/sig0i**2
4359 delthec=thetai-thet_pred_mean
4360 delthe0=thetai-theta0i
4361 term1=-0.5D0*sigcsq*delthec*delthec
4362 term2=-0.5D0*sig0inv*delthe0*delthe0
4363 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4364 C NaNs in taking the logarithm. We extract the largest exponent which is added
4365 C to the energy (this being the log of the distribution) at the end of energy
4366 C term evaluation for this virtual-bond angle.
4367 if (term1.gt.term2) then
4369 term2=dexp(term2-termm)
4373 term1=dexp(term1-termm)
4376 C The ratio between the gamma-independent and gamma-dependent lobes of
4377 C the distribution is a Gaussian function of thet_pred_mean too.
4378 diffak=gthet(2,it)-thet_pred_mean
4379 ratak=diffak/gthet(3,it)**2
4380 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4381 C Let's differentiate it in thet_pred_mean NOW.
4383 C Now put together the distribution terms to make complete distribution.
4384 termexp=term1+ak*term2
4385 termpre=sigc+ak*sig0i
4386 C Contribution of the bending energy from this theta is just the -log of
4387 C the sum of the contributions from the two lobes and the pre-exponential
4388 C factor. Simple enough, isn't it?
4389 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4390 C NOW the derivatives!!!
4391 C 6/6/97 Take into account the deformation.
4392 E_theta=(delthec*sigcsq*term1
4393 & +ak*delthe0*sig0inv*term2)/termexp
4394 E_tc=((sigtc+aktc*sig0i)/termpre
4395 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4396 & aktc*term2)/termexp)
4399 c-----------------------------------------------------------------------------
4400 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4401 implicit real*8 (a-h,o-z)
4402 include 'DIMENSIONS'
4403 include 'COMMON.LOCAL'
4404 include 'COMMON.IOUNITS'
4405 common /calcthet/ term1,term2,termm,diffak,ratak,
4406 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4407 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4408 delthec=thetai-thet_pred_mean
4409 delthe0=thetai-theta0i
4410 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4411 t3 = thetai-thet_pred_mean
4415 t14 = t12+t6*sigsqtc
4417 t21 = thetai-theta0i
4423 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4424 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4425 & *(-t12*t9-ak*sig0inv*t27)
4429 C--------------------------------------------------------------------------
4430 subroutine ebend(etheta)
4432 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4433 C angles gamma and its derivatives in consecutive thetas and gammas.
4434 C ab initio-derived potentials from
4435 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4437 implicit real*8 (a-h,o-z)
4438 include 'DIMENSIONS'
4439 include 'DIMENSIONS.ZSCOPT'
4440 include 'DIMENSIONS.FREE'
4441 include 'COMMON.LOCAL'
4442 include 'COMMON.GEO'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.VAR'
4446 include 'COMMON.CHAIN'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.NAMES'
4449 include 'COMMON.FFIELD'
4450 include 'COMMON.CONTROL'
4451 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4452 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4453 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4454 & sinph1ph2(maxdouble,maxdouble)
4455 logical lprn /.false./, lprn1 /.false./
4457 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4458 do i=ithet_start,ithet_end
4460 c print *,i,itype(i-1),itype(i),itype(i-2)
4461 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4462 & .or.(itype(i).eq.ntyp1)) cycle
4463 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4465 if (iabs(itype(i+1)).eq.20) iblock=2
4466 if (iabs(itype(i+1)).ne.20) iblock=1
4470 theti2=0.5d0*theta(i)
4471 ityp2=ithetyp((itype(i-1)))
4473 coskt(k)=dcos(k*theti2)
4474 sinkt(k)=dsin(k*theti2)
4476 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4479 if (phii.ne.phii) phii=150.0
4483 ityp1=ithetyp((itype(i-2)))
4485 cosph1(k)=dcos(k*phii)
4486 sinph1(k)=dsin(k*phii)
4496 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4499 if (phii1.ne.phii1) phii1=150.0
4504 ityp3=ithetyp((itype(i)))
4506 cosph2(k)=dcos(k*phii1)
4507 sinph2(k)=dsin(k*phii1)
4517 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4518 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4520 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4523 ccl=cosph1(l)*cosph2(k-l)
4524 ssl=sinph1(l)*sinph2(k-l)
4525 scl=sinph1(l)*cosph2(k-l)
4526 csl=cosph1(l)*sinph2(k-l)
4527 cosph1ph2(l,k)=ccl-ssl
4528 cosph1ph2(k,l)=ccl+ssl
4529 sinph1ph2(l,k)=scl+csl
4530 sinph1ph2(k,l)=scl-csl
4534 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4535 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4536 write (iout,*) "coskt and sinkt"
4538 write (iout,*) k,coskt(k),sinkt(k)
4542 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4543 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4546 & write (iout,*) "k",k,"
4547 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4548 & " ethetai",ethetai
4551 write (iout,*) "cosph and sinph"
4553 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4555 write (iout,*) "cosph1ph2 and sinph2ph2"
4558 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4559 & sinph1ph2(l,k),sinph1ph2(k,l)
4562 write(iout,*) "ethetai",ethetai
4566 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4567 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4568 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4569 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4570 ethetai=ethetai+sinkt(m)*aux
4571 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4572 dephii=dephii+k*sinkt(m)*(
4573 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4574 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4575 dephii1=dephii1+k*sinkt(m)*(
4576 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4577 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4579 & write (iout,*) "m",m," k",k," bbthet",
4580 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4581 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4582 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4583 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4587 & write(iout,*) "ethetai",ethetai
4591 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4592 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4593 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4594 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4595 ethetai=ethetai+sinkt(m)*aux
4596 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4597 dephii=dephii+l*sinkt(m)*(
4598 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4599 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4600 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4601 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4602 dephii1=dephii1+(k-l)*sinkt(m)*(
4603 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4604 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4605 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4606 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4608 write (iout,*) "m",m," k",k," l",l," ffthet",
4609 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4610 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4611 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4612 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4613 & " ethetai",ethetai
4614 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4615 & cosph1ph2(k,l)*sinkt(m),
4616 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4622 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4623 & i,theta(i)*rad2deg,phii*rad2deg,
4624 & phii1*rad2deg,ethetai
4625 etheta=etheta+ethetai
4626 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4627 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4628 c gloc(nphi+i-2,icg)=wang*dethetai
4629 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4633 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4634 do i=1,ntheta_constr
4635 itheta=itheta_constr(i)
4636 thetiii=theta(itheta)
4637 difi=pinorm(thetiii-theta_constr0(i))
4638 if (difi.gt.theta_drange(i)) then
4639 difi=difi-theta_drange(i)
4640 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4641 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4642 & +for_thet_constr(i)*difi**3
4643 else if (difi.lt.-drange(i)) then
4645 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4646 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4647 & +for_thet_constr(i)*difi**3
4651 C if (energy_dec) then
4652 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4653 C & i,itheta,rad2deg*thetiii,
4654 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4655 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4656 C & gloc(itheta+nphi-2,icg)
4664 c-----------------------------------------------------------------------------
4665 subroutine esc(escloc)
4666 C Calculate the local energy of a side chain and its derivatives in the
4667 C corresponding virtual-bond valence angles THETA and the spherical angles
4669 implicit real*8 (a-h,o-z)
4670 include 'DIMENSIONS'
4671 include 'DIMENSIONS.ZSCOPT'
4672 include 'COMMON.GEO'
4673 include 'COMMON.LOCAL'
4674 include 'COMMON.VAR'
4675 include 'COMMON.INTERACT'
4676 include 'COMMON.DERIV'
4677 include 'COMMON.CHAIN'
4678 include 'COMMON.IOUNITS'
4679 include 'COMMON.NAMES'
4680 include 'COMMON.FFIELD'
4681 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4682 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4683 common /sccalc/ time11,time12,time112,theti,it,nlobit
4686 C write (iout,*) 'ESC'
4687 do i=loc_start,loc_end
4689 if (it.eq.ntyp1) cycle
4690 if (it.eq.10) goto 1
4691 nlobit=nlob(iabs(it))
4692 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4693 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4694 theti=theta(i+1)-pipol
4698 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4700 if (x(2).gt.pi-delta) then
4704 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4706 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4707 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4709 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4710 & ddersc0(1),dersc(1))
4711 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4712 & ddersc0(3),dersc(3))
4714 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4716 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4717 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4718 & dersc0(2),esclocbi,dersc02)
4719 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4721 call splinthet(x(2),0.5d0*delta,ss,ssd)
4726 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4728 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4729 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4731 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4733 c write (iout,*) escloci
4734 else if (x(2).lt.delta) then
4738 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4740 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4741 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4743 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4744 & ddersc0(1),dersc(1))
4745 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4746 & ddersc0(3),dersc(3))
4748 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4750 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4751 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4752 & dersc0(2),esclocbi,dersc02)
4753 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4758 call splinthet(x(2),0.5d0*delta,ss,ssd)
4760 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4762 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4763 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4765 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4766 C write (iout,*) 'i=',i, escloci
4768 call enesc(x,escloci,dersc,ddummy,.false.)
4771 escloc=escloc+escloci
4772 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4773 write (iout,'(a6,i5,0pf7.3)')
4774 & 'escloc',i,escloci
4776 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4778 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4779 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4784 C---------------------------------------------------------------------------
4785 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4786 implicit real*8 (a-h,o-z)
4787 include 'DIMENSIONS'
4788 include 'COMMON.GEO'
4789 include 'COMMON.LOCAL'
4790 include 'COMMON.IOUNITS'
4791 common /sccalc/ time11,time12,time112,theti,it,nlobit
4792 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4793 double precision contr(maxlob,-1:1)
4795 c write (iout,*) 'it=',it,' nlobit=',nlobit
4799 if (mixed) ddersc(j)=0.0d0
4803 C Because of periodicity of the dependence of the SC energy in omega we have
4804 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4805 C To avoid underflows, first compute & store the exponents.
4813 z(k)=x(k)-censc(k,j,it)
4818 Axk=Axk+gaussc(l,k,j,it)*z(l)
4824 expfac=expfac+Ax(k,j,iii)*z(k)
4832 C As in the case of ebend, we want to avoid underflows in exponentiation and
4833 C subsequent NaNs and INFs in energy calculation.
4834 C Find the largest exponent
4838 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4842 cd print *,'it=',it,' emin=',emin
4844 C Compute the contribution to SC energy and derivatives
4848 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4849 cd print *,'j=',j,' expfac=',expfac
4850 escloc_i=escloc_i+expfac
4852 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4856 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4857 & +gaussc(k,2,j,it))*expfac
4864 dersc(1)=dersc(1)/cos(theti)**2
4865 ddersc(1)=ddersc(1)/cos(theti)**2
4868 escloci=-(dlog(escloc_i)-emin)
4870 dersc(j)=dersc(j)/escloc_i
4874 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4879 C------------------------------------------------------------------------------
4880 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4881 implicit real*8 (a-h,o-z)
4882 include 'DIMENSIONS'
4883 include 'COMMON.GEO'
4884 include 'COMMON.LOCAL'
4885 include 'COMMON.IOUNITS'
4886 common /sccalc/ time11,time12,time112,theti,it,nlobit
4887 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4888 double precision contr(maxlob)
4899 z(k)=x(k)-censc(k,j,it)
4905 Axk=Axk+gaussc(l,k,j,it)*z(l)
4911 expfac=expfac+Ax(k,j)*z(k)
4916 C As in the case of ebend, we want to avoid underflows in exponentiation and
4917 C subsequent NaNs and INFs in energy calculation.
4918 C Find the largest exponent
4921 if (emin.gt.contr(j)) emin=contr(j)
4925 C Compute the contribution to SC energy and derivatives
4929 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4930 escloc_i=escloc_i+expfac
4932 dersc(k)=dersc(k)+Ax(k,j)*expfac
4934 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4935 & +gaussc(1,2,j,it))*expfac
4939 dersc(1)=dersc(1)/cos(theti)**2
4940 dersc12=dersc12/cos(theti)**2
4941 escloci=-(dlog(escloc_i)-emin)
4943 dersc(j)=dersc(j)/escloc_i
4945 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4949 c----------------------------------------------------------------------------------
4950 subroutine esc(escloc)
4951 C Calculate the local energy of a side chain and its derivatives in the
4952 C corresponding virtual-bond valence angles THETA and the spherical angles
4953 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4954 C added by Urszula Kozlowska. 07/11/2007
4956 implicit real*8 (a-h,o-z)
4957 include 'DIMENSIONS'
4958 include 'DIMENSIONS.ZSCOPT'
4959 include 'DIMENSIONS.FREE'
4960 include 'COMMON.GEO'
4961 include 'COMMON.LOCAL'
4962 include 'COMMON.VAR'
4963 include 'COMMON.SCROT'
4964 include 'COMMON.INTERACT'
4965 include 'COMMON.DERIV'
4966 include 'COMMON.CHAIN'
4967 include 'COMMON.IOUNITS'
4968 include 'COMMON.NAMES'
4969 include 'COMMON.FFIELD'
4970 include 'COMMON.CONTROL'
4971 include 'COMMON.VECTORS'
4972 double precision x_prime(3),y_prime(3),z_prime(3)
4973 & , sumene,dsc_i,dp2_i,x(65),
4974 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4975 & de_dxx,de_dyy,de_dzz,de_dt
4976 double precision s1_t,s1_6_t,s2_t,s2_6_t
4978 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4979 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4980 & dt_dCi(3),dt_dCi1(3)
4981 common /sccalc/ time11,time12,time112,theti,it,nlobit
4984 do i=loc_start,loc_end
4985 if (itype(i).eq.ntyp1) cycle
4986 costtab(i+1) =dcos(theta(i+1))
4987 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4988 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4989 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4990 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4991 cosfac=dsqrt(cosfac2)
4992 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4993 sinfac=dsqrt(sinfac2)
4995 if (it.eq.10) goto 1
4997 C Compute the axes of tghe local cartesian coordinates system; store in
4998 c x_prime, y_prime and z_prime
5005 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5006 C & dc_norm(3,i+nres)
5008 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5009 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5012 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5015 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5016 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5017 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5018 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5019 c & " xy",scalar(x_prime(1),y_prime(1)),
5020 c & " xz",scalar(x_prime(1),z_prime(1)),
5021 c & " yy",scalar(y_prime(1),y_prime(1)),
5022 c & " yz",scalar(y_prime(1),z_prime(1)),
5023 c & " zz",scalar(z_prime(1),z_prime(1))
5025 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5026 C to local coordinate system. Store in xx, yy, zz.
5032 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5033 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5034 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5041 C Compute the energy of the ith side cbain
5043 c write (2,*) "xx",xx," yy",yy," zz",zz
5046 x(j) = sc_parmin(j,it)
5049 Cc diagnostics - remove later
5051 yy1 = dsin(alph(2))*dcos(omeg(2))
5052 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5053 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5054 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5056 C," --- ", xx_w,yy_w,zz_w
5059 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5060 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5062 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5063 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5065 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5066 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5067 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5068 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5069 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5071 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5072 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5073 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5074 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5075 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5077 dsc_i = 0.743d0+x(61)
5079 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5080 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5081 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5082 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5083 s1=(1+x(63))/(0.1d0 + dscp1)
5084 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5085 s2=(1+x(65))/(0.1d0 + dscp2)
5086 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5087 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5088 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5089 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5091 c & dscp1,dscp2,sumene
5092 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5093 escloc = escloc + sumene
5094 c write (2,*) "escloc",escloc
5095 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5097 if (.not. calc_grad) goto 1
5100 C This section to check the numerical derivatives of the energy of ith side
5101 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5102 C #define DEBUG in the code to turn it on.
5104 write (2,*) "sumene =",sumene
5108 write (2,*) xx,yy,zz
5109 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5110 de_dxx_num=(sumenep-sumene)/aincr
5112 write (2,*) "xx+ sumene from enesc=",sumenep
5115 write (2,*) xx,yy,zz
5116 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5117 de_dyy_num=(sumenep-sumene)/aincr
5119 write (2,*) "yy+ sumene from enesc=",sumenep
5122 write (2,*) xx,yy,zz
5123 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5124 de_dzz_num=(sumenep-sumene)/aincr
5126 write (2,*) "zz+ sumene from enesc=",sumenep
5127 costsave=cost2tab(i+1)
5128 sintsave=sint2tab(i+1)
5129 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5130 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5131 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5132 de_dt_num=(sumenep-sumene)/aincr
5133 write (2,*) " t+ sumene from enesc=",sumenep
5134 cost2tab(i+1)=costsave
5135 sint2tab(i+1)=sintsave
5136 C End of diagnostics section.
5139 C Compute the gradient of esc
5141 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5142 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5143 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5144 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5145 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5146 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5147 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5148 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5149 pom1=(sumene3*sint2tab(i+1)+sumene1)
5150 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5151 pom2=(sumene4*cost2tab(i+1)+sumene2)
5152 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5153 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5154 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5155 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5157 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5158 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5159 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5161 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5162 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5163 & +(pom1+pom2)*pom_dx
5165 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5168 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5169 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5170 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5172 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5173 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5174 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5175 & +x(59)*zz**2 +x(60)*xx*zz
5176 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5177 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5178 & +(pom1-pom2)*pom_dy
5180 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5183 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5184 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5185 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5186 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5187 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5188 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5189 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5190 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5192 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5195 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5196 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5197 & +pom1*pom_dt1+pom2*pom_dt2
5199 write(2,*), "de_dt = ", de_dt,de_dt_num
5203 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5204 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5205 cosfac2xx=cosfac2*xx
5206 sinfac2yy=sinfac2*yy
5208 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5210 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5212 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5213 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5214 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5215 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5216 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5217 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5218 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5219 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5220 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5221 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5225 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5226 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5227 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5228 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5231 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5232 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5233 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5235 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5236 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5240 dXX_Ctab(k,i)=dXX_Ci(k)
5241 dXX_C1tab(k,i)=dXX_Ci1(k)
5242 dYY_Ctab(k,i)=dYY_Ci(k)
5243 dYY_C1tab(k,i)=dYY_Ci1(k)
5244 dZZ_Ctab(k,i)=dZZ_Ci(k)
5245 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5246 dXX_XYZtab(k,i)=dXX_XYZ(k)
5247 dYY_XYZtab(k,i)=dYY_XYZ(k)
5248 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5252 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5253 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5254 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5255 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5256 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5258 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5259 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5260 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5261 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5262 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5263 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5264 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5265 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5267 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5268 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5270 C to check gradient call subroutine check_grad
5277 c------------------------------------------------------------------------------
5278 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5280 C This procedure calculates two-body contact function g(rij) and its derivative:
5283 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5286 C where x=(rij-r0ij)/delta
5288 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5291 double precision rij,r0ij,eps0ij,fcont,fprimcont
5292 double precision x,x2,x4,delta
5296 if (x.lt.-1.0D0) then
5299 else if (x.le.1.0D0) then
5302 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5303 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5310 c------------------------------------------------------------------------------
5311 subroutine splinthet(theti,delta,ss,ssder)
5312 implicit real*8 (a-h,o-z)
5313 include 'DIMENSIONS'
5314 include 'DIMENSIONS.ZSCOPT'
5315 include 'COMMON.VAR'
5316 include 'COMMON.GEO'
5319 if (theti.gt.pipol) then
5320 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5322 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5327 c------------------------------------------------------------------------------
5328 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5330 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5331 double precision ksi,ksi2,ksi3,a1,a2,a3
5332 a1=fprim0*delta/(f1-f0)
5338 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5339 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5342 c------------------------------------------------------------------------------
5343 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5345 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5346 double precision ksi,ksi2,ksi3,a1,a2,a3
5351 a2=3*(f1x-f0x)-2*fprim0x*delta
5352 a3=fprim0x*delta-2*(f1x-f0x)
5353 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5356 C-----------------------------------------------------------------------------
5358 C-----------------------------------------------------------------------------
5359 subroutine etor(etors,edihcnstr,fact)
5360 implicit real*8 (a-h,o-z)
5361 include 'DIMENSIONS'
5362 include 'DIMENSIONS.ZSCOPT'
5363 include 'COMMON.VAR'
5364 include 'COMMON.GEO'
5365 include 'COMMON.LOCAL'
5366 include 'COMMON.TORSION'
5367 include 'COMMON.INTERACT'
5368 include 'COMMON.DERIV'
5369 include 'COMMON.CHAIN'
5370 include 'COMMON.NAMES'
5371 include 'COMMON.IOUNITS'
5372 include 'COMMON.FFIELD'
5373 include 'COMMON.TORCNSTR'
5375 C Set lprn=.true. for debugging
5379 do i=iphi_start,iphi_end
5380 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5381 & .or. itype(i).eq.ntyp1) cycle
5382 itori=itortyp(itype(i-2))
5383 itori1=itortyp(itype(i-1))
5386 C Proline-Proline pair is a special case...
5387 if (itori.eq.3 .and. itori1.eq.3) then
5388 if (phii.gt.-dwapi3) then
5390 fac=1.0D0/(1.0D0-cosphi)
5391 etorsi=v1(1,3,3)*fac
5392 etorsi=etorsi+etorsi
5393 etors=etors+etorsi-v1(1,3,3)
5394 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5397 v1ij=v1(j+1,itori,itori1)
5398 v2ij=v2(j+1,itori,itori1)
5401 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5402 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5406 v1ij=v1(j,itori,itori1)
5407 v2ij=v2(j,itori,itori1)
5410 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5411 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5415 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5416 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5417 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5418 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5419 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5421 ! 6/20/98 - dihedral angle constraints
5424 itori=idih_constr(i)
5427 if (difi.gt.drange(i)) then
5429 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5430 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5431 else if (difi.lt.-drange(i)) then
5433 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5434 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5436 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5437 C & i,itori,rad2deg*phii,
5438 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5440 ! write (iout,*) 'edihcnstr',edihcnstr
5443 c------------------------------------------------------------------------------
5445 subroutine etor(etors,edihcnstr,fact)
5446 implicit real*8 (a-h,o-z)
5447 include 'DIMENSIONS'
5448 include 'DIMENSIONS.ZSCOPT'
5449 include 'COMMON.VAR'
5450 include 'COMMON.GEO'
5451 include 'COMMON.LOCAL'
5452 include 'COMMON.TORSION'
5453 include 'COMMON.INTERACT'
5454 include 'COMMON.DERIV'
5455 include 'COMMON.CHAIN'
5456 include 'COMMON.NAMES'
5457 include 'COMMON.IOUNITS'
5458 include 'COMMON.FFIELD'
5459 include 'COMMON.TORCNSTR'
5461 C Set lprn=.true. for debugging
5465 do i=iphi_start,iphi_end
5467 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5468 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5469 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5470 C & .or. itype(i).eq.ntyp1) cycle
5471 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5472 if (iabs(itype(i)).eq.20) then
5477 itori=itortyp(itype(i-2))
5478 itori1=itortyp(itype(i-1))
5481 C Regular cosine and sine terms
5482 do j=1,nterm(itori,itori1,iblock)
5483 v1ij=v1(j,itori,itori1,iblock)
5484 v2ij=v2(j,itori,itori1,iblock)
5487 etors=etors+v1ij*cosphi+v2ij*sinphi
5488 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5492 C E = SUM ----------------------------------- - v1
5493 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5495 cosphi=dcos(0.5d0*phii)
5496 sinphi=dsin(0.5d0*phii)
5497 do j=1,nlor(itori,itori1,iblock)
5498 vl1ij=vlor1(j,itori,itori1)
5499 vl2ij=vlor2(j,itori,itori1)
5500 vl3ij=vlor3(j,itori,itori1)
5501 pom=vl2ij*cosphi+vl3ij*sinphi
5502 pom1=1.0d0/(pom*pom+1.0d0)
5503 etors=etors+vl1ij*pom1
5504 c if (energy_dec) etors_ii=etors_ii+
5507 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5509 C Subtract the constant term
5510 etors=etors-v0(itori,itori1,iblock)
5512 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5513 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5514 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5515 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5516 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5519 ! 6/20/98 - dihedral angle constraints
5522 itori=idih_constr(i)
5524 difi=pinorm(phii-phi0(i))
5526 if (difi.gt.drange(i)) then
5528 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5529 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5530 edihi=0.25d0*ftors(i)*difi**4
5531 else if (difi.lt.-drange(i)) then
5533 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5534 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5535 edihi=0.25d0*ftors(i)*difi**4
5539 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5540 & i,itori,rad2deg*phii,
5541 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5542 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5544 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5545 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5547 ! write (iout,*) 'edihcnstr',edihcnstr
5550 c----------------------------------------------------------------------------
5551 subroutine etor_d(etors_d,fact2)
5552 C 6/23/01 Compute double torsional energy
5553 implicit real*8 (a-h,o-z)
5554 include 'DIMENSIONS'
5555 include 'DIMENSIONS.ZSCOPT'
5556 include 'COMMON.VAR'
5557 include 'COMMON.GEO'
5558 include 'COMMON.LOCAL'
5559 include 'COMMON.TORSION'
5560 include 'COMMON.INTERACT'
5561 include 'COMMON.DERIV'
5562 include 'COMMON.CHAIN'
5563 include 'COMMON.NAMES'
5564 include 'COMMON.IOUNITS'
5565 include 'COMMON.FFIELD'
5566 include 'COMMON.TORCNSTR'
5568 C Set lprn=.true. for debugging
5572 do i=iphi_start,iphi_end-1
5574 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5575 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5576 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5577 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5578 & (itype(i+1).eq.ntyp1)) cycle
5579 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5581 itori=itortyp(itype(i-2))
5582 itori1=itortyp(itype(i-1))
5583 itori2=itortyp(itype(i))
5589 if (iabs(itype(i+1)).eq.20) iblock=2
5590 C Regular cosine and sine terms
5591 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5592 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5593 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5594 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5595 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5596 cosphi1=dcos(j*phii)
5597 sinphi1=dsin(j*phii)
5598 cosphi2=dcos(j*phii1)
5599 sinphi2=dsin(j*phii1)
5600 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5601 & v2cij*cosphi2+v2sij*sinphi2
5602 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5603 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5605 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5607 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5608 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5609 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5610 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5611 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5612 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5613 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5614 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5615 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5616 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5617 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5618 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5619 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5620 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5623 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5624 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5630 c------------------------------------------------------------------------------
5631 subroutine eback_sc_corr(esccor)
5632 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5633 c conformational states; temporarily implemented as differences
5634 c between UNRES torsional potentials (dependent on three types of
5635 c residues) and the torsional potentials dependent on all 20 types
5636 c of residues computed from AM1 energy surfaces of terminally-blocked
5637 c amino-acid residues.
5638 implicit real*8 (a-h,o-z)
5639 include 'DIMENSIONS'
5640 include 'DIMENSIONS.ZSCOPT'
5641 include 'DIMENSIONS.FREE'
5642 include 'COMMON.VAR'
5643 include 'COMMON.GEO'
5644 include 'COMMON.LOCAL'
5645 include 'COMMON.TORSION'
5646 include 'COMMON.SCCOR'
5647 include 'COMMON.INTERACT'
5648 include 'COMMON.DERIV'
5649 include 'COMMON.CHAIN'
5650 include 'COMMON.NAMES'
5651 include 'COMMON.IOUNITS'
5652 include 'COMMON.FFIELD'
5653 include 'COMMON.CONTROL'
5655 C Set lprn=.true. for debugging
5658 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5660 do i=itau_start,itau_end
5661 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5663 isccori=isccortyp(itype(i-2))
5664 isccori1=isccortyp(itype(i-1))
5666 do intertyp=1,3 !intertyp
5667 cc Added 09 May 2012 (Adasko)
5668 cc Intertyp means interaction type of backbone mainchain correlation:
5669 c 1 = SC...Ca...Ca...Ca
5670 c 2 = Ca...Ca...Ca...SC
5671 c 3 = SC...Ca...Ca...SCi
5673 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5674 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5675 & (itype(i-1).eq.ntyp1)))
5676 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5677 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5678 & .or.(itype(i).eq.ntyp1)))
5679 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5680 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5681 & (itype(i-3).eq.ntyp1)))) cycle
5682 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5683 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5685 do j=1,nterm_sccor(isccori,isccori1)
5686 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5687 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5688 cosphi=dcos(j*tauangle(intertyp,i))
5689 sinphi=dsin(j*tauangle(intertyp,i))
5690 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5691 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5693 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5694 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5695 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5697 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5698 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5699 & (v1sccor(j,1,itori,itori1),j=1,6)
5700 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5701 c gsccor_loc(i-3)=gloci
5706 c------------------------------------------------------------------------------
5707 subroutine multibody(ecorr)
5708 C This subroutine calculates multi-body contributions to energy following
5709 C the idea of Skolnick et al. If side chains I and J make a contact and
5710 C at the same time side chains I+1 and J+1 make a contact, an extra
5711 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5712 implicit real*8 (a-h,o-z)
5713 include 'DIMENSIONS'
5714 include 'COMMON.IOUNITS'
5715 include 'COMMON.DERIV'
5716 include 'COMMON.INTERACT'
5717 include 'COMMON.CONTACTS'
5718 double precision gx(3),gx1(3)
5721 C Set lprn=.true. for debugging
5725 write (iout,'(a)') 'Contact function values:'
5727 write (iout,'(i2,20(1x,i2,f10.5))')
5728 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5743 num_conti=num_cont(i)
5744 num_conti1=num_cont(i1)
5749 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5750 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5751 cd & ' ishift=',ishift
5752 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5753 C The system gains extra energy.
5754 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5755 endif ! j1==j+-ishift
5764 c------------------------------------------------------------------------------
5765 double precision function esccorr(i,j,k,l,jj,kk)
5766 implicit real*8 (a-h,o-z)
5767 include 'DIMENSIONS'
5768 include 'COMMON.IOUNITS'
5769 include 'COMMON.DERIV'
5770 include 'COMMON.INTERACT'
5771 include 'COMMON.CONTACTS'
5772 double precision gx(3),gx1(3)
5777 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5778 C Calculate the multi-body contribution to energy.
5779 C Calculate multi-body contributions to the gradient.
5780 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5781 cd & k,l,(gacont(m,kk,k),m=1,3)
5783 gx(m) =ekl*gacont(m,jj,i)
5784 gx1(m)=eij*gacont(m,kk,k)
5785 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5786 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5787 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5788 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5792 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5797 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5803 c------------------------------------------------------------------------------
5805 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5806 implicit real*8 (a-h,o-z)
5807 include 'DIMENSIONS'
5808 integer dimen1,dimen2,atom,indx
5809 double precision buffer(dimen1,dimen2)
5810 double precision zapas
5811 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5812 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5813 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5814 num_kont=num_cont_hb(atom)
5818 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5821 buffer(i,indx+22)=facont_hb(i,atom)
5822 buffer(i,indx+23)=ees0p(i,atom)
5823 buffer(i,indx+24)=ees0m(i,atom)
5824 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5826 buffer(1,indx+26)=dfloat(num_kont)
5829 c------------------------------------------------------------------------------
5830 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5831 implicit real*8 (a-h,o-z)
5832 include 'DIMENSIONS'
5833 integer dimen1,dimen2,atom,indx
5834 double precision buffer(dimen1,dimen2)
5835 double precision zapas
5836 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5837 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5838 & ees0m(ntyp,maxres),
5839 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5840 num_kont=buffer(1,indx+26)
5841 num_kont_old=num_cont_hb(atom)
5842 num_cont_hb(atom)=num_kont+num_kont_old
5847 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5850 facont_hb(ii,atom)=buffer(i,indx+22)
5851 ees0p(ii,atom)=buffer(i,indx+23)
5852 ees0m(ii,atom)=buffer(i,indx+24)
5853 jcont_hb(ii,atom)=buffer(i,indx+25)
5857 c------------------------------------------------------------------------------
5859 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5860 C This subroutine calculates multi-body contributions to hydrogen-bonding
5861 implicit real*8 (a-h,o-z)
5862 include 'DIMENSIONS'
5863 include 'DIMENSIONS.ZSCOPT'
5864 include 'COMMON.IOUNITS'
5866 include 'COMMON.INFO'
5868 include 'COMMON.FFIELD'
5869 include 'COMMON.DERIV'
5870 include 'COMMON.INTERACT'
5871 include 'COMMON.CONTACTS'
5873 parameter (max_cont=maxconts)
5874 parameter (max_dim=2*(8*3+2))
5875 parameter (msglen1=max_cont*max_dim*4)
5876 parameter (msglen2=2*msglen1)
5877 integer source,CorrelType,CorrelID,Error
5878 double precision buffer(max_cont,max_dim)
5880 double precision gx(3),gx1(3)
5883 C Set lprn=.true. for debugging
5888 if (fgProcs.le.1) goto 30
5890 write (iout,'(a)') 'Contact function values:'
5892 write (iout,'(2i3,50(1x,i2,f5.2))')
5893 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5894 & j=1,num_cont_hb(i))
5897 C Caution! Following code assumes that electrostatic interactions concerning
5898 C a given atom are split among at most two processors!
5908 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5911 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5912 if (MyRank.gt.0) then
5913 C Send correlation contributions to the preceding processor
5915 nn=num_cont_hb(iatel_s)
5916 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5917 cd write (iout,*) 'The BUFFER array:'
5919 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5921 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5923 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5924 C Clear the contacts of the atom passed to the neighboring processor
5925 nn=num_cont_hb(iatel_s+1)
5927 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5929 num_cont_hb(iatel_s)=0
5931 cd write (iout,*) 'Processor ',MyID,MyRank,
5932 cd & ' is sending correlation contribution to processor',MyID-1,
5933 cd & ' msglen=',msglen
5934 cd write (*,*) 'Processor ',MyID,MyRank,
5935 cd & ' is sending correlation contribution to processor',MyID-1,
5936 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5937 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5938 cd write (iout,*) 'Processor ',MyID,
5939 cd & ' has sent correlation contribution to processor',MyID-1,
5940 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5941 cd write (*,*) 'Processor ',MyID,
5942 cd & ' has sent correlation contribution to processor',MyID-1,
5943 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5945 endif ! (MyRank.gt.0)
5949 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5950 if (MyRank.lt.fgProcs-1) then
5951 C Receive correlation contributions from the next processor
5953 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5954 cd write (iout,*) 'Processor',MyID,
5955 cd & ' is receiving correlation contribution from processor',MyID+1,
5956 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5957 cd write (*,*) 'Processor',MyID,
5958 cd & ' is receiving correlation contribution from processor',MyID+1,
5959 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5961 do while (nbytes.le.0)
5962 call mp_probe(MyID+1,CorrelType,nbytes)
5964 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5965 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5966 cd write (iout,*) 'Processor',MyID,
5967 cd & ' has received correlation contribution from processor',MyID+1,
5968 cd & ' msglen=',msglen,' nbytes=',nbytes
5969 cd write (iout,*) 'The received BUFFER array:'
5971 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5973 if (msglen.eq.msglen1) then
5974 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5975 else if (msglen.eq.msglen2) then
5976 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5977 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5980 & 'ERROR!!!! message length changed while processing correlations.'
5982 & 'ERROR!!!! message length changed while processing correlations.'
5983 call mp_stopall(Error)
5984 endif ! msglen.eq.msglen1
5985 endif ! MyRank.lt.fgProcs-1
5992 write (iout,'(a)') 'Contact function values:'
5994 write (iout,'(2i3,50(1x,i2,f5.2))')
5995 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5996 & j=1,num_cont_hb(i))
6000 C Remove the loop below after debugging !!!
6007 C Calculate the local-electrostatic correlation terms
6008 do i=iatel_s,iatel_e+1
6010 num_conti=num_cont_hb(i)
6011 num_conti1=num_cont_hb(i+1)
6016 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6017 c & ' jj=',jj,' kk=',kk
6018 if (j1.eq.j+1 .or. j1.eq.j-1) then
6019 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6020 C The system gains extra energy.
6021 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6023 else if (j1.eq.j) then
6024 C Contacts I-J and I-(J+1) occur simultaneously.
6025 C The system loses extra energy.
6026 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6031 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6032 c & ' jj=',jj,' kk=',kk
6034 C Contacts I-J and (I+1)-J occur simultaneously.
6035 C The system loses extra energy.
6036 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6043 c------------------------------------------------------------------------------
6044 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6046 C This subroutine calculates multi-body contributions to hydrogen-bonding
6047 implicit real*8 (a-h,o-z)
6048 include 'DIMENSIONS'
6049 include 'DIMENSIONS.ZSCOPT'
6050 include 'COMMON.IOUNITS'
6052 include 'COMMON.INFO'
6054 include 'COMMON.FFIELD'
6055 include 'COMMON.DERIV'
6056 include 'COMMON.INTERACT'
6057 include 'COMMON.CONTACTS'
6059 parameter (max_cont=maxconts)
6060 parameter (max_dim=2*(8*3+2))
6061 parameter (msglen1=max_cont*max_dim*4)
6062 parameter (msglen2=2*msglen1)
6063 integer source,CorrelType,CorrelID,Error
6064 double precision buffer(max_cont,max_dim)
6066 double precision gx(3),gx1(3)
6069 C Set lprn=.true. for debugging
6076 if (fgProcs.le.1) goto 30
6078 write (iout,'(a)') 'Contact function values:'
6080 write (iout,'(2i3,50(1x,i2,f5.2))')
6081 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6082 & j=1,num_cont_hb(i))
6085 C Caution! Following code assumes that electrostatic interactions concerning
6086 C a given atom are split among at most two processors!
6096 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6099 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6100 if (MyRank.gt.0) then
6101 C Send correlation contributions to the preceding processor
6103 nn=num_cont_hb(iatel_s)
6104 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6105 cd write (iout,*) 'The BUFFER array:'
6107 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6109 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6111 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6112 C Clear the contacts of the atom passed to the neighboring processor
6113 nn=num_cont_hb(iatel_s+1)
6115 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6117 num_cont_hb(iatel_s)=0
6119 cd write (iout,*) 'Processor ',MyID,MyRank,
6120 cd & ' is sending correlation contribution to processor',MyID-1,
6121 cd & ' msglen=',msglen
6122 cd write (*,*) 'Processor ',MyID,MyRank,
6123 cd & ' is sending correlation contribution to processor',MyID-1,
6124 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6125 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6126 cd write (iout,*) 'Processor ',MyID,
6127 cd & ' has sent correlation contribution to processor',MyID-1,
6128 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6129 cd write (*,*) 'Processor ',MyID,
6130 cd & ' has sent correlation contribution to processor',MyID-1,
6131 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6133 endif ! (MyRank.gt.0)
6137 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6138 if (MyRank.lt.fgProcs-1) then
6139 C Receive correlation contributions from the next processor
6141 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6142 cd write (iout,*) 'Processor',MyID,
6143 cd & ' is receiving correlation contribution from processor',MyID+1,
6144 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6145 cd write (*,*) 'Processor',MyID,
6146 cd & ' is receiving correlation contribution from processor',MyID+1,
6147 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6149 do while (nbytes.le.0)
6150 call mp_probe(MyID+1,CorrelType,nbytes)
6152 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6153 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6154 cd write (iout,*) 'Processor',MyID,
6155 cd & ' has received correlation contribution from processor',MyID+1,
6156 cd & ' msglen=',msglen,' nbytes=',nbytes
6157 cd write (iout,*) 'The received BUFFER array:'
6159 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6161 if (msglen.eq.msglen1) then
6162 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6163 else if (msglen.eq.msglen2) then
6164 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6165 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6168 & 'ERROR!!!! message length changed while processing correlations.'
6170 & 'ERROR!!!! message length changed while processing correlations.'
6171 call mp_stopall(Error)
6172 endif ! msglen.eq.msglen1
6173 endif ! MyRank.lt.fgProcs-1
6180 write (iout,'(a)') 'Contact function values:'
6182 write (iout,'(2i3,50(1x,i2,f5.2))')
6183 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6184 & j=1,num_cont_hb(i))
6190 C Remove the loop below after debugging !!!
6197 C Calculate the dipole-dipole interaction energies
6198 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6199 do i=iatel_s,iatel_e+1
6200 num_conti=num_cont_hb(i)
6207 C Calculate the local-electrostatic correlation terms
6208 do i=iatel_s,iatel_e+1
6210 num_conti=num_cont_hb(i)
6211 num_conti1=num_cont_hb(i+1)
6216 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6217 c & ' jj=',jj,' kk=',kk
6218 if (j1.eq.j+1 .or. j1.eq.j-1) then
6219 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6220 C The system gains extra energy.
6222 sqd1=dsqrt(d_cont(jj,i))
6223 sqd2=dsqrt(d_cont(kk,i1))
6224 sred_geom = sqd1*sqd2
6225 IF (sred_geom.lt.cutoff_corr) THEN
6226 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6228 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6229 c & ' jj=',jj,' kk=',kk
6230 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6231 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6233 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6234 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6237 cd write (iout,*) 'sred_geom=',sred_geom,
6238 cd & ' ekont=',ekont,' fprim=',fprimcont
6239 call calc_eello(i,j,i+1,j1,jj,kk)
6240 if (wcorr4.gt.0.0d0)
6241 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6242 if (wcorr5.gt.0.0d0)
6243 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6244 c print *,"wcorr5",ecorr5
6245 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6246 cd write(2,*)'ijkl',i,j,i+1,j1
6247 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6248 & .or. wturn6.eq.0.0d0))then
6249 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6250 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6251 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6252 cd & 'ecorr6=',ecorr6
6253 cd write (iout,'(4e15.5)') sred_geom,
6254 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6255 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6256 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6257 else if (wturn6.gt.0.0d0
6258 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6259 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6260 eturn6=eturn6+eello_turn6(i,jj,kk)
6261 cd write (2,*) 'multibody_eello:eturn6',eturn6
6262 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6269 else if (j1.eq.j) then
6270 C Contacts I-J and I-(J+1) occur simultaneously.
6271 C The system loses extra energy.
6272 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6277 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6278 c & ' jj=',jj,' kk=',kk
6280 C Contacts I-J and (I+1)-J occur simultaneously.
6281 C The system loses extra energy.
6282 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6287 write (iout,*) "eturn6",eturn6,ecorr6
6290 c------------------------------------------------------------------------------
6291 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6292 implicit real*8 (a-h,o-z)
6293 include 'DIMENSIONS'
6294 include 'COMMON.IOUNITS'
6295 include 'COMMON.DERIV'
6296 include 'COMMON.INTERACT'
6297 include 'COMMON.CONTACTS'
6298 double precision gx(3),gx1(3)
6308 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6309 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6310 C Following 4 lines for diagnostics.
6315 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6317 c write (iout,*)'Contacts have occurred for peptide groups',
6318 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6319 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6320 C Calculate the multi-body contribution to energy.
6321 ecorr=ecorr+ekont*ees
6323 C Calculate multi-body contributions to the gradient.
6325 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6326 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6327 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6328 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6329 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6330 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6331 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6332 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6333 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6334 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6335 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6336 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6337 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6338 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6342 gradcorr(ll,m)=gradcorr(ll,m)+
6343 & ees*ekl*gacont_hbr(ll,jj,i)-
6344 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6345 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6350 gradcorr(ll,m)=gradcorr(ll,m)+
6351 & ees*eij*gacont_hbr(ll,kk,k)-
6352 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6353 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6360 C---------------------------------------------------------------------------
6361 subroutine dipole(i,j,jj)
6362 implicit real*8 (a-h,o-z)
6363 include 'DIMENSIONS'
6364 include 'DIMENSIONS.ZSCOPT'
6365 include 'COMMON.IOUNITS'
6366 include 'COMMON.CHAIN'
6367 include 'COMMON.FFIELD'
6368 include 'COMMON.DERIV'
6369 include 'COMMON.INTERACT'
6370 include 'COMMON.CONTACTS'
6371 include 'COMMON.TORSION'
6372 include 'COMMON.VAR'
6373 include 'COMMON.GEO'
6374 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6376 iti1 = itortyp(itype(i+1))
6377 if (j.lt.nres-1) then
6378 if (itype(j).le.ntyp) then
6379 itj1 = itortyp(itype(j+1))
6387 dipi(iii,1)=Ub2(iii,i)
6388 dipderi(iii)=Ub2der(iii,i)
6389 dipi(iii,2)=b1(iii,iti1)
6390 dipj(iii,1)=Ub2(iii,j)
6391 dipderj(iii)=Ub2der(iii,j)
6392 dipj(iii,2)=b1(iii,itj1)
6396 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6399 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6402 if (.not.calc_grad) return
6407 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6411 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6416 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6417 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6419 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6421 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6423 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6427 C---------------------------------------------------------------------------
6428 subroutine calc_eello(i,j,k,l,jj,kk)
6430 C This subroutine computes matrices and vectors needed to calculate
6431 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6433 implicit real*8 (a-h,o-z)
6434 include 'DIMENSIONS'
6435 include 'DIMENSIONS.ZSCOPT'
6436 include 'COMMON.IOUNITS'
6437 include 'COMMON.CHAIN'
6438 include 'COMMON.DERIV'
6439 include 'COMMON.INTERACT'
6440 include 'COMMON.CONTACTS'
6441 include 'COMMON.TORSION'
6442 include 'COMMON.VAR'
6443 include 'COMMON.GEO'
6444 include 'COMMON.FFIELD'
6445 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6446 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6449 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6450 cd & ' jj=',jj,' kk=',kk
6451 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6454 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6455 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6458 call transpose2(aa1(1,1),aa1t(1,1))
6459 call transpose2(aa2(1,1),aa2t(1,1))
6462 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6463 & aa1tder(1,1,lll,kkk))
6464 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6465 & aa2tder(1,1,lll,kkk))
6469 C parallel orientation of the two CA-CA-CA frames.
6470 if (i.gt.1 .and. itype(i).le.ntyp) then
6471 iti=itortyp(itype(i))
6475 itk1=itortyp(itype(k+1))
6476 itj=itortyp(itype(j))
6477 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6478 itl1=itortyp(itype(l+1))
6482 C A1 kernel(j+1) A2T
6484 cd write (iout,'(3f10.5,5x,3f10.5)')
6485 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6487 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6488 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6489 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6490 C Following matrices are needed only for 6-th order cumulants
6491 IF (wcorr6.gt.0.0d0) THEN
6492 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6493 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6494 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6495 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6496 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6497 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6498 & ADtEAderx(1,1,1,1,1,1))
6500 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6501 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6502 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6503 & ADtEA1derx(1,1,1,1,1,1))
6505 C End 6-th order cumulants
6508 cd write (2,*) 'In calc_eello6'
6510 cd write (2,*) 'iii=',iii
6512 cd write (2,*) 'kkk=',kkk
6514 cd write (2,'(3(2f10.5),5x)')
6515 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6520 call transpose2(EUgder(1,1,k),auxmat(1,1))
6521 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6522 call transpose2(EUg(1,1,k),auxmat(1,1))
6523 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6524 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6528 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6529 & EAEAderx(1,1,lll,kkk,iii,1))
6533 C A1T kernel(i+1) A2
6534 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6535 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6536 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6537 C Following matrices are needed only for 6-th order cumulants
6538 IF (wcorr6.gt.0.0d0) THEN
6539 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6540 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6541 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6542 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6543 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6544 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6545 & ADtEAderx(1,1,1,1,1,2))
6546 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6547 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6548 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6549 & ADtEA1derx(1,1,1,1,1,2))
6551 C End 6-th order cumulants
6552 call transpose2(EUgder(1,1,l),auxmat(1,1))
6553 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6554 call transpose2(EUg(1,1,l),auxmat(1,1))
6555 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6556 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6560 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6561 & EAEAderx(1,1,lll,kkk,iii,2))
6566 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6567 C They are needed only when the fifth- or the sixth-order cumulants are
6569 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6570 call transpose2(AEA(1,1,1),auxmat(1,1))
6571 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6572 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6573 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6574 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6575 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6576 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6577 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6578 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6579 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6580 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6581 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6582 call transpose2(AEA(1,1,2),auxmat(1,1))
6583 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6584 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6585 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6586 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6587 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6588 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6589 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6590 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6591 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6592 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6593 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6594 C Calculate the Cartesian derivatives of the vectors.
6598 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6599 call matvec2(auxmat(1,1),b1(1,iti),
6600 & AEAb1derx(1,lll,kkk,iii,1,1))
6601 call matvec2(auxmat(1,1),Ub2(1,i),
6602 & AEAb2derx(1,lll,kkk,iii,1,1))
6603 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6604 & AEAb1derx(1,lll,kkk,iii,2,1))
6605 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6606 & AEAb2derx(1,lll,kkk,iii,2,1))
6607 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6608 call matvec2(auxmat(1,1),b1(1,itj),
6609 & AEAb1derx(1,lll,kkk,iii,1,2))
6610 call matvec2(auxmat(1,1),Ub2(1,j),
6611 & AEAb2derx(1,lll,kkk,iii,1,2))
6612 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6613 & AEAb1derx(1,lll,kkk,iii,2,2))
6614 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6615 & AEAb2derx(1,lll,kkk,iii,2,2))
6622 C Antiparallel orientation of the two CA-CA-CA frames.
6623 if (i.gt.1 .and. itype(i).le.ntyp) then
6624 iti=itortyp(itype(i))
6628 itk1=itortyp(itype(k+1))
6629 itl=itortyp(itype(l))
6630 itj=itortyp(itype(j))
6631 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6632 itj1=itortyp(itype(j+1))
6636 C A2 kernel(j-1)T A1T
6637 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6638 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6639 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6640 C Following matrices are needed only for 6-th order cumulants
6641 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6642 & j.eq.i+4 .and. l.eq.i+3)) THEN
6643 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6644 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6645 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6646 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6647 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6648 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6649 & ADtEAderx(1,1,1,1,1,1))
6650 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6651 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6652 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6653 & ADtEA1derx(1,1,1,1,1,1))
6655 C End 6-th order cumulants
6656 call transpose2(EUgder(1,1,k),auxmat(1,1))
6657 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6658 call transpose2(EUg(1,1,k),auxmat(1,1))
6659 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6660 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6664 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6665 & EAEAderx(1,1,lll,kkk,iii,1))
6669 C A2T kernel(i+1)T A1
6670 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6671 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6672 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6673 C Following matrices are needed only for 6-th order cumulants
6674 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6675 & j.eq.i+4 .and. l.eq.i+3)) THEN
6676 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6677 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6678 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6679 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6680 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6681 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6682 & ADtEAderx(1,1,1,1,1,2))
6683 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6684 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6685 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6686 & ADtEA1derx(1,1,1,1,1,2))
6688 C End 6-th order cumulants
6689 call transpose2(EUgder(1,1,j),auxmat(1,1))
6690 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6691 call transpose2(EUg(1,1,j),auxmat(1,1))
6692 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6693 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6697 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6698 & EAEAderx(1,1,lll,kkk,iii,2))
6703 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6704 C They are needed only when the fifth- or the sixth-order cumulants are
6706 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6707 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6708 call transpose2(AEA(1,1,1),auxmat(1,1))
6709 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6710 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6711 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6712 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6713 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6714 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6715 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6716 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6717 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6718 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6719 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6720 call transpose2(AEA(1,1,2),auxmat(1,1))
6721 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6722 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6723 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6724 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6725 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6726 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6727 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6728 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6729 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6730 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6731 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6732 C Calculate the Cartesian derivatives of the vectors.
6736 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6737 call matvec2(auxmat(1,1),b1(1,iti),
6738 & AEAb1derx(1,lll,kkk,iii,1,1))
6739 call matvec2(auxmat(1,1),Ub2(1,i),
6740 & AEAb2derx(1,lll,kkk,iii,1,1))
6741 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6742 & AEAb1derx(1,lll,kkk,iii,2,1))
6743 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6744 & AEAb2derx(1,lll,kkk,iii,2,1))
6745 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6746 call matvec2(auxmat(1,1),b1(1,itl),
6747 & AEAb1derx(1,lll,kkk,iii,1,2))
6748 call matvec2(auxmat(1,1),Ub2(1,l),
6749 & AEAb2derx(1,lll,kkk,iii,1,2))
6750 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6751 & AEAb1derx(1,lll,kkk,iii,2,2))
6752 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6753 & AEAb2derx(1,lll,kkk,iii,2,2))
6762 C---------------------------------------------------------------------------
6763 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6764 & KK,KKderg,AKA,AKAderg,AKAderx)
6768 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6769 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6770 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6775 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6777 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6780 cd if (lprn) write (2,*) 'In kernel'
6782 cd if (lprn) write (2,*) 'kkk=',kkk
6784 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6785 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6787 cd write (2,*) 'lll=',lll
6788 cd write (2,*) 'iii=1'
6790 cd write (2,'(3(2f10.5),5x)')
6791 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6794 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6795 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6797 cd write (2,*) 'lll=',lll
6798 cd write (2,*) 'iii=2'
6800 cd write (2,'(3(2f10.5),5x)')
6801 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6808 C---------------------------------------------------------------------------
6809 double precision function eello4(i,j,k,l,jj,kk)
6810 implicit real*8 (a-h,o-z)
6811 include 'DIMENSIONS'
6812 include 'DIMENSIONS.ZSCOPT'
6813 include 'COMMON.IOUNITS'
6814 include 'COMMON.CHAIN'
6815 include 'COMMON.DERIV'
6816 include 'COMMON.INTERACT'
6817 include 'COMMON.CONTACTS'
6818 include 'COMMON.TORSION'
6819 include 'COMMON.VAR'
6820 include 'COMMON.GEO'
6821 double precision pizda(2,2),ggg1(3),ggg2(3)
6822 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6826 cd print *,'eello4:',i,j,k,l,jj,kk
6827 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6828 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6829 cold eij=facont_hb(jj,i)
6830 cold ekl=facont_hb(kk,k)
6832 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6834 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6835 gcorr_loc(k-1)=gcorr_loc(k-1)
6836 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6838 gcorr_loc(l-1)=gcorr_loc(l-1)
6839 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6841 gcorr_loc(j-1)=gcorr_loc(j-1)
6842 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6847 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6848 & -EAEAderx(2,2,lll,kkk,iii,1)
6849 cd derx(lll,kkk,iii)=0.0d0
6853 cd gcorr_loc(l-1)=0.0d0
6854 cd gcorr_loc(j-1)=0.0d0
6855 cd gcorr_loc(k-1)=0.0d0
6857 cd write (iout,*)'Contacts have occurred for peptide groups',
6858 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6859 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6860 if (j.lt.nres-1) then
6867 if (l.lt.nres-1) then
6875 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6876 ggg1(ll)=eel4*g_contij(ll,1)
6877 ggg2(ll)=eel4*g_contij(ll,2)
6878 ghalf=0.5d0*ggg1(ll)
6880 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6881 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6882 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6883 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6884 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6885 ghalf=0.5d0*ggg2(ll)
6887 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6888 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6889 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6890 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6895 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6896 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6901 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6902 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6908 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6913 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6917 cd write (2,*) iii,gcorr_loc(iii)
6921 cd write (2,*) 'ekont',ekont
6922 cd write (iout,*) 'eello4',ekont*eel4
6925 C---------------------------------------------------------------------------
6926 double precision function eello5(i,j,k,l,jj,kk)
6927 implicit real*8 (a-h,o-z)
6928 include 'DIMENSIONS'
6929 include 'DIMENSIONS.ZSCOPT'
6930 include 'COMMON.IOUNITS'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.DERIV'
6933 include 'COMMON.INTERACT'
6934 include 'COMMON.CONTACTS'
6935 include 'COMMON.TORSION'
6936 include 'COMMON.VAR'
6937 include 'COMMON.GEO'
6938 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6939 double precision ggg1(3),ggg2(3)
6940 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6945 C /l\ / \ \ / \ / \ / C
6946 C / \ / \ \ / \ / \ / C
6947 C j| o |l1 | o | o| o | | o |o C
6948 C \ |/k\| |/ \| / |/ \| |/ \| C
6949 C \i/ \ / \ / / \ / \ C
6951 C (I) (II) (III) (IV) C
6953 C eello5_1 eello5_2 eello5_3 eello5_4 C
6955 C Antiparallel chains C
6958 C /j\ / \ \ / \ / \ / C
6959 C / \ / \ \ / \ / \ / C
6960 C j1| o |l | o | o| o | | o |o C
6961 C \ |/k\| |/ \| / |/ \| |/ \| C
6962 C \i/ \ / \ / / \ / \ C
6964 C (I) (II) (III) (IV) C
6966 C eello5_1 eello5_2 eello5_3 eello5_4 C
6968 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6971 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6976 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6978 itk=itortyp(itype(k))
6979 itl=itortyp(itype(l))
6980 itj=itortyp(itype(j))
6985 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6986 cd & eel5_3_num,eel5_4_num)
6990 derx(lll,kkk,iii)=0.0d0
6994 cd eij=facont_hb(jj,i)
6995 cd ekl=facont_hb(kk,k)
6997 cd write (iout,*)'Contacts have occurred for peptide groups',
6998 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7000 C Contribution from the graph I.
7001 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7002 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7003 call transpose2(EUg(1,1,k),auxmat(1,1))
7004 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7005 vv(1)=pizda(1,1)-pizda(2,2)
7006 vv(2)=pizda(1,2)+pizda(2,1)
7007 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7008 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7010 C Explicit gradient in virtual-dihedral angles.
7011 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7012 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7013 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7014 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7015 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7016 vv(1)=pizda(1,1)-pizda(2,2)
7017 vv(2)=pizda(1,2)+pizda(2,1)
7018 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7019 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7020 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7021 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7022 vv(1)=pizda(1,1)-pizda(2,2)
7023 vv(2)=pizda(1,2)+pizda(2,1)
7025 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7026 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7027 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7029 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7030 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7031 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7033 C Cartesian gradient
7037 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7039 vv(1)=pizda(1,1)-pizda(2,2)
7040 vv(2)=pizda(1,2)+pizda(2,1)
7041 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7042 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7043 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7050 C Contribution from graph II
7051 call transpose2(EE(1,1,itk),auxmat(1,1))
7052 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7053 vv(1)=pizda(1,1)+pizda(2,2)
7054 vv(2)=pizda(2,1)-pizda(1,2)
7055 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7056 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7058 C Explicit gradient in virtual-dihedral angles.
7059 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7060 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7061 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7062 vv(1)=pizda(1,1)+pizda(2,2)
7063 vv(2)=pizda(2,1)-pizda(1,2)
7065 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7066 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7067 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7069 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7070 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7071 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7073 C Cartesian gradient
7077 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7079 vv(1)=pizda(1,1)+pizda(2,2)
7080 vv(2)=pizda(2,1)-pizda(1,2)
7081 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7082 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7083 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7092 C Parallel orientation
7093 C Contribution from graph III
7094 call transpose2(EUg(1,1,l),auxmat(1,1))
7095 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7096 vv(1)=pizda(1,1)-pizda(2,2)
7097 vv(2)=pizda(1,2)+pizda(2,1)
7098 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7099 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7101 C Explicit gradient in virtual-dihedral angles.
7102 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7103 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7104 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7105 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7106 vv(1)=pizda(1,1)-pizda(2,2)
7107 vv(2)=pizda(1,2)+pizda(2,1)
7108 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7109 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7110 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7111 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7112 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7113 vv(1)=pizda(1,1)-pizda(2,2)
7114 vv(2)=pizda(1,2)+pizda(2,1)
7115 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7116 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7117 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7118 C Cartesian gradient
7122 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7124 vv(1)=pizda(1,1)-pizda(2,2)
7125 vv(2)=pizda(1,2)+pizda(2,1)
7126 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7127 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7128 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7134 C Contribution from graph IV
7136 call transpose2(EE(1,1,itl),auxmat(1,1))
7137 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7138 vv(1)=pizda(1,1)+pizda(2,2)
7139 vv(2)=pizda(2,1)-pizda(1,2)
7140 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7141 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7143 C Explicit gradient in virtual-dihedral angles.
7144 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7145 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7146 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7147 vv(1)=pizda(1,1)+pizda(2,2)
7148 vv(2)=pizda(2,1)-pizda(1,2)
7149 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7150 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7151 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7152 C Cartesian gradient
7156 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7158 vv(1)=pizda(1,1)+pizda(2,2)
7159 vv(2)=pizda(2,1)-pizda(1,2)
7160 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7161 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7162 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7168 C Antiparallel orientation
7169 C Contribution from graph III
7171 call transpose2(EUg(1,1,j),auxmat(1,1))
7172 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7173 vv(1)=pizda(1,1)-pizda(2,2)
7174 vv(2)=pizda(1,2)+pizda(2,1)
7175 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7176 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7178 C Explicit gradient in virtual-dihedral angles.
7179 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7180 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7181 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7182 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7183 vv(1)=pizda(1,1)-pizda(2,2)
7184 vv(2)=pizda(1,2)+pizda(2,1)
7185 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7186 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7187 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7188 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7189 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7190 vv(1)=pizda(1,1)-pizda(2,2)
7191 vv(2)=pizda(1,2)+pizda(2,1)
7192 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7193 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7194 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7195 C Cartesian gradient
7199 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7201 vv(1)=pizda(1,1)-pizda(2,2)
7202 vv(2)=pizda(1,2)+pizda(2,1)
7203 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7204 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7205 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7211 C Contribution from graph IV
7213 call transpose2(EE(1,1,itj),auxmat(1,1))
7214 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7215 vv(1)=pizda(1,1)+pizda(2,2)
7216 vv(2)=pizda(2,1)-pizda(1,2)
7217 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7218 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7220 C Explicit gradient in virtual-dihedral angles.
7221 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7222 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7223 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7224 vv(1)=pizda(1,1)+pizda(2,2)
7225 vv(2)=pizda(2,1)-pizda(1,2)
7226 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7227 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7228 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7229 C Cartesian gradient
7233 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7235 vv(1)=pizda(1,1)+pizda(2,2)
7236 vv(2)=pizda(2,1)-pizda(1,2)
7237 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7238 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7239 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7246 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7247 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7248 cd write (2,*) 'ijkl',i,j,k,l
7249 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7250 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7252 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7253 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7254 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7255 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7257 if (j.lt.nres-1) then
7264 if (l.lt.nres-1) then
7274 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7276 ggg1(ll)=eel5*g_contij(ll,1)
7277 ggg2(ll)=eel5*g_contij(ll,2)
7278 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7279 ghalf=0.5d0*ggg1(ll)
7281 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7282 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7283 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7284 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7285 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7286 ghalf=0.5d0*ggg2(ll)
7288 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7289 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7290 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7291 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7296 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7297 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7302 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7303 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7309 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7314 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7318 cd write (2,*) iii,g_corr5_loc(iii)
7322 cd write (2,*) 'ekont',ekont
7323 cd write (iout,*) 'eello5',ekont*eel5
7326 c--------------------------------------------------------------------------
7327 double precision function eello6(i,j,k,l,jj,kk)
7328 implicit real*8 (a-h,o-z)
7329 include 'DIMENSIONS'
7330 include 'DIMENSIONS.ZSCOPT'
7331 include 'COMMON.IOUNITS'
7332 include 'COMMON.CHAIN'
7333 include 'COMMON.DERIV'
7334 include 'COMMON.INTERACT'
7335 include 'COMMON.CONTACTS'
7336 include 'COMMON.TORSION'
7337 include 'COMMON.VAR'
7338 include 'COMMON.GEO'
7339 include 'COMMON.FFIELD'
7340 double precision ggg1(3),ggg2(3)
7341 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7346 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7354 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7355 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7359 derx(lll,kkk,iii)=0.0d0
7363 cd eij=facont_hb(jj,i)
7364 cd ekl=facont_hb(kk,k)
7370 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7371 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7372 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7373 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7374 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7375 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7377 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7378 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7379 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7380 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7381 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7382 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7386 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7388 C If turn contributions are considered, they will be handled separately.
7389 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7390 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7391 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7392 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7393 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7394 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7395 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7398 if (j.lt.nres-1) then
7405 if (l.lt.nres-1) then
7413 ggg1(ll)=eel6*g_contij(ll,1)
7414 ggg2(ll)=eel6*g_contij(ll,2)
7415 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7416 ghalf=0.5d0*ggg1(ll)
7418 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7419 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7420 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7421 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7422 ghalf=0.5d0*ggg2(ll)
7423 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7425 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7426 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7427 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7428 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7433 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7434 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7439 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7440 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7446 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7451 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7455 cd write (2,*) iii,g_corr6_loc(iii)
7459 cd write (2,*) 'ekont',ekont
7460 cd write (iout,*) 'eello6',ekont*eel6
7463 c--------------------------------------------------------------------------
7464 double precision function eello6_graph1(i,j,k,l,imat,swap)
7465 implicit real*8 (a-h,o-z)
7466 include 'DIMENSIONS'
7467 include 'DIMENSIONS.ZSCOPT'
7468 include 'COMMON.IOUNITS'
7469 include 'COMMON.CHAIN'
7470 include 'COMMON.DERIV'
7471 include 'COMMON.INTERACT'
7472 include 'COMMON.CONTACTS'
7473 include 'COMMON.TORSION'
7474 include 'COMMON.VAR'
7475 include 'COMMON.GEO'
7476 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7480 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7482 C Parallel Antiparallel C
7488 C \ j|/k\| / \ |/k\|l / C
7493 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7494 itk=itortyp(itype(k))
7495 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7496 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7497 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7498 call transpose2(EUgC(1,1,k),auxmat(1,1))
7499 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7500 vv1(1)=pizda1(1,1)-pizda1(2,2)
7501 vv1(2)=pizda1(1,2)+pizda1(2,1)
7502 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7503 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7504 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7505 s5=scalar2(vv(1),Dtobr2(1,i))
7506 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7507 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7508 if (.not. calc_grad) return
7509 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7510 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7511 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7512 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7513 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7514 & +scalar2(vv(1),Dtobr2der(1,i)))
7515 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7516 vv1(1)=pizda1(1,1)-pizda1(2,2)
7517 vv1(2)=pizda1(1,2)+pizda1(2,1)
7518 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7519 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7521 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7522 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7523 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7524 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7525 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7527 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7528 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7529 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7530 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7531 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7533 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7534 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7535 vv1(1)=pizda1(1,1)-pizda1(2,2)
7536 vv1(2)=pizda1(1,2)+pizda1(2,1)
7537 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7538 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7539 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7540 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7549 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7550 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7551 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7552 call transpose2(EUgC(1,1,k),auxmat(1,1))
7553 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7555 vv1(1)=pizda1(1,1)-pizda1(2,2)
7556 vv1(2)=pizda1(1,2)+pizda1(2,1)
7557 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7558 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7559 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7560 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7561 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7562 s5=scalar2(vv(1),Dtobr2(1,i))
7563 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7569 c----------------------------------------------------------------------------
7570 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'DIMENSIONS.ZSCOPT'
7574 include 'COMMON.IOUNITS'
7575 include 'COMMON.CHAIN'
7576 include 'COMMON.DERIV'
7577 include 'COMMON.INTERACT'
7578 include 'COMMON.CONTACTS'
7579 include 'COMMON.TORSION'
7580 include 'COMMON.VAR'
7581 include 'COMMON.GEO'
7583 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7584 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7589 C Parallel Antiparallel C
7595 C \ j|/k\| \ |/k\|l C
7600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7601 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7602 C AL 7/4/01 s1 would occur in the sixth-order moment,
7603 C but not in a cluster cumulant
7605 s1=dip(1,jj,i)*dip(1,kk,k)
7607 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7608 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7609 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7610 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7611 call transpose2(EUg(1,1,k),auxmat(1,1))
7612 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7613 vv(1)=pizda(1,1)-pizda(2,2)
7614 vv(2)=pizda(1,2)+pizda(2,1)
7615 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7616 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7618 eello6_graph2=-(s1+s2+s3+s4)
7620 eello6_graph2=-(s2+s3+s4)
7623 if (.not. calc_grad) return
7624 C Derivatives in gamma(i-1)
7627 s1=dipderg(1,jj,i)*dip(1,kk,k)
7629 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7630 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7631 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7632 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7634 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7636 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7638 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7640 C Derivatives in gamma(k-1)
7642 s1=dip(1,jj,i)*dipderg(1,kk,k)
7644 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7645 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7646 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7647 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7648 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7649 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7650 vv(1)=pizda(1,1)-pizda(2,2)
7651 vv(2)=pizda(1,2)+pizda(2,1)
7652 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7654 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7656 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7658 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7659 C Derivatives in gamma(j-1) or gamma(l-1)
7662 s1=dipderg(3,jj,i)*dip(1,kk,k)
7664 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7665 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7666 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7667 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7668 vv(1)=pizda(1,1)-pizda(2,2)
7669 vv(2)=pizda(1,2)+pizda(2,1)
7670 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7673 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7675 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7678 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7679 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7681 C Derivatives in gamma(l-1) or gamma(j-1)
7684 s1=dip(1,jj,i)*dipderg(3,kk,k)
7686 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7687 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7688 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7689 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7690 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7691 vv(1)=pizda(1,1)-pizda(2,2)
7692 vv(2)=pizda(1,2)+pizda(2,1)
7693 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7696 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7698 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7701 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7702 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7704 C Cartesian derivatives.
7706 write (2,*) 'In eello6_graph2'
7708 write (2,*) 'iii=',iii
7710 write (2,*) 'kkk=',kkk
7712 write (2,'(3(2f10.5),5x)')
7713 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7723 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7725 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7728 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7730 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7731 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7733 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7734 call transpose2(EUg(1,1,k),auxmat(1,1))
7735 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7737 vv(1)=pizda(1,1)-pizda(2,2)
7738 vv(2)=pizda(1,2)+pizda(2,1)
7739 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7740 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7742 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7744 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7747 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7749 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7756 c----------------------------------------------------------------------------
7757 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7758 implicit real*8 (a-h,o-z)
7759 include 'DIMENSIONS'
7760 include 'DIMENSIONS.ZSCOPT'
7761 include 'COMMON.IOUNITS'
7762 include 'COMMON.CHAIN'
7763 include 'COMMON.DERIV'
7764 include 'COMMON.INTERACT'
7765 include 'COMMON.CONTACTS'
7766 include 'COMMON.TORSION'
7767 include 'COMMON.VAR'
7768 include 'COMMON.GEO'
7769 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7771 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7773 C Parallel Antiparallel C
7779 C j|/k\| / |/k\|l / C
7784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7786 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7787 C energy moment and not to the cluster cumulant.
7788 iti=itortyp(itype(i))
7789 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7790 itj1=itortyp(itype(j+1))
7794 itk=itortyp(itype(k))
7795 itk1=itortyp(itype(k+1))
7796 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7797 itl1=itortyp(itype(l+1))
7802 s1=dip(4,jj,i)*dip(4,kk,k)
7804 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7805 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7806 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7807 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7808 call transpose2(EE(1,1,itk),auxmat(1,1))
7809 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7810 vv(1)=pizda(1,1)+pizda(2,2)
7811 vv(2)=pizda(2,1)-pizda(1,2)
7812 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7813 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7815 eello6_graph3=-(s1+s2+s3+s4)
7817 eello6_graph3=-(s2+s3+s4)
7820 if (.not. calc_grad) return
7821 C Derivatives in gamma(k-1)
7822 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7823 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7824 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7825 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7826 C Derivatives in gamma(l-1)
7827 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7828 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7829 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7830 vv(1)=pizda(1,1)+pizda(2,2)
7831 vv(2)=pizda(2,1)-pizda(1,2)
7832 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7833 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7834 C Cartesian derivatives.
7840 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7842 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7845 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7847 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7848 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7850 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7851 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7853 vv(1)=pizda(1,1)+pizda(2,2)
7854 vv(2)=pizda(2,1)-pizda(1,2)
7855 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7857 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7859 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7862 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7864 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7866 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7872 c----------------------------------------------------------------------------
7873 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7874 implicit real*8 (a-h,o-z)
7875 include 'DIMENSIONS'
7876 include 'DIMENSIONS.ZSCOPT'
7877 include 'COMMON.IOUNITS'
7878 include 'COMMON.CHAIN'
7879 include 'COMMON.DERIV'
7880 include 'COMMON.INTERACT'
7881 include 'COMMON.CONTACTS'
7882 include 'COMMON.TORSION'
7883 include 'COMMON.VAR'
7884 include 'COMMON.GEO'
7885 include 'COMMON.FFIELD'
7886 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7887 & auxvec1(2),auxmat1(2,2)
7889 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7891 C Parallel Antiparallel C
7897 C \ j|/k\| \ |/k\|l C
7902 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7904 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7905 C energy moment and not to the cluster cumulant.
7906 cd write (2,*) 'eello_graph4: wturn6',wturn6
7907 iti=itortyp(itype(i))
7908 itj=itortyp(itype(j))
7909 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7910 itj1=itortyp(itype(j+1))
7914 itk=itortyp(itype(k))
7915 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7916 itk1=itortyp(itype(k+1))
7920 itl=itortyp(itype(l))
7921 if (l.lt.nres-1) then
7922 itl1=itortyp(itype(l+1))
7926 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7927 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7928 cd & ' itl',itl,' itl1',itl1
7931 s1=dip(3,jj,i)*dip(3,kk,k)
7933 s1=dip(2,jj,j)*dip(2,kk,l)
7936 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7937 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7939 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7940 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7942 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7943 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7945 call transpose2(EUg(1,1,k),auxmat(1,1))
7946 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7947 vv(1)=pizda(1,1)-pizda(2,2)
7948 vv(2)=pizda(2,1)+pizda(1,2)
7949 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7950 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7952 eello6_graph4=-(s1+s2+s3+s4)
7954 eello6_graph4=-(s2+s3+s4)
7956 if (.not. calc_grad) return
7957 C Derivatives in gamma(i-1)
7961 s1=dipderg(2,jj,i)*dip(3,kk,k)
7963 s1=dipderg(4,jj,j)*dip(2,kk,l)
7966 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7968 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7969 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7971 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7972 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7974 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7975 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7976 cd write (2,*) 'turn6 derivatives'
7978 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7980 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7984 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7986 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7990 C Derivatives in gamma(k-1)
7993 s1=dip(3,jj,i)*dipderg(2,kk,k)
7995 s1=dip(2,jj,j)*dipderg(4,kk,l)
7998 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7999 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8001 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8002 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8004 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8005 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8007 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8008 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8009 vv(1)=pizda(1,1)-pizda(2,2)
8010 vv(2)=pizda(2,1)+pizda(1,2)
8011 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8012 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8014 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8016 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8020 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8022 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8025 C Derivatives in gamma(j-1) or gamma(l-1)
8026 if (l.eq.j+1 .and. l.gt.1) then
8027 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8028 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8029 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8030 vv(1)=pizda(1,1)-pizda(2,2)
8031 vv(2)=pizda(2,1)+pizda(1,2)
8032 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8033 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8034 else if (j.gt.1) then
8035 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8036 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8037 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8038 vv(1)=pizda(1,1)-pizda(2,2)
8039 vv(2)=pizda(2,1)+pizda(1,2)
8040 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8041 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8042 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8044 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8047 C Cartesian derivatives.
8054 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8056 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8060 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8062 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8066 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8068 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8070 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8071 & b1(1,itj1),auxvec(1))
8072 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8074 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8075 & b1(1,itl1),auxvec(1))
8076 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8078 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8080 vv(1)=pizda(1,1)-pizda(2,2)
8081 vv(2)=pizda(2,1)+pizda(1,2)
8082 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8084 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8086 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8089 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8092 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8095 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8097 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8099 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8103 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8105 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8108 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8110 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8118 c----------------------------------------------------------------------------
8119 double precision function eello_turn6(i,jj,kk)
8120 implicit real*8 (a-h,o-z)
8121 include 'DIMENSIONS'
8122 include 'DIMENSIONS.ZSCOPT'
8123 include 'COMMON.IOUNITS'
8124 include 'COMMON.CHAIN'
8125 include 'COMMON.DERIV'
8126 include 'COMMON.INTERACT'
8127 include 'COMMON.CONTACTS'
8128 include 'COMMON.TORSION'
8129 include 'COMMON.VAR'
8130 include 'COMMON.GEO'
8131 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8132 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8134 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8135 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8136 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8137 C the respective energy moment and not to the cluster cumulant.
8142 iti=itortyp(itype(i))
8143 itk=itortyp(itype(k))
8144 itk1=itortyp(itype(k+1))
8145 itl=itortyp(itype(l))
8146 itj=itortyp(itype(j))
8147 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8148 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8149 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8154 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8156 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8160 derx_turn(lll,kkk,iii)=0.0d0
8167 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8169 cd write (2,*) 'eello6_5',eello6_5
8171 call transpose2(AEA(1,1,1),auxmat(1,1))
8172 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8173 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8174 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8178 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8179 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8180 s2 = scalar2(b1(1,itk),vtemp1(1))
8182 call transpose2(AEA(1,1,2),atemp(1,1))
8183 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8184 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8185 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8189 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8190 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8191 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8193 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8194 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8195 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8196 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8197 ss13 = scalar2(b1(1,itk),vtemp4(1))
8198 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8202 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8208 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8210 C Derivatives in gamma(i+2)
8212 call transpose2(AEA(1,1,1),auxmatd(1,1))
8213 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8214 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8215 call transpose2(AEAderg(1,1,2),atempd(1,1))
8216 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8217 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8221 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8222 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8223 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8229 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8230 C Derivatives in gamma(i+3)
8232 call transpose2(AEA(1,1,1),auxmatd(1,1))
8233 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8234 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8235 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8239 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8240 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8241 s2d = scalar2(b1(1,itk),vtemp1d(1))
8243 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8244 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8246 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8248 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8249 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8250 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8260 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8261 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8263 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8264 & -0.5d0*ekont*(s2d+s12d)
8266 C Derivatives in gamma(i+4)
8267 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8268 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8269 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8271 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8272 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8273 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8283 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8285 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8287 C Derivatives in gamma(i+5)
8289 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8290 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8291 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8295 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8296 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8297 s2d = scalar2(b1(1,itk),vtemp1d(1))
8299 call transpose2(AEA(1,1,2),atempd(1,1))
8300 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8301 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8305 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8306 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8308 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8309 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8310 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8320 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8321 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8323 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8324 & -0.5d0*ekont*(s2d+s12d)
8326 C Cartesian derivatives
8331 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8332 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8333 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8337 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8338 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8340 s2d = scalar2(b1(1,itk),vtemp1d(1))
8342 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8343 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8344 s8d = -(atempd(1,1)+atempd(2,2))*
8345 & scalar2(cc(1,1,itl),vtemp2(1))
8349 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8351 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8352 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8359 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8362 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8366 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8367 & - 0.5d0*(s8d+s12d)
8369 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8378 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8380 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8381 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8382 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8383 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8384 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8386 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8387 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8388 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8392 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8393 cd & 16*eel_turn6_num
8395 if (j.lt.nres-1) then
8402 if (l.lt.nres-1) then
8410 ggg1(ll)=eel_turn6*g_contij(ll,1)
8411 ggg2(ll)=eel_turn6*g_contij(ll,2)
8412 ghalf=0.5d0*ggg1(ll)
8414 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8415 & +ekont*derx_turn(ll,2,1)
8416 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8417 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8418 & +ekont*derx_turn(ll,4,1)
8419 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8420 ghalf=0.5d0*ggg2(ll)
8422 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8423 & +ekont*derx_turn(ll,2,2)
8424 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8425 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8426 & +ekont*derx_turn(ll,4,2)
8427 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8432 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8437 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8443 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8448 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8452 cd write (2,*) iii,g_corr6_loc(iii)
8455 eello_turn6=ekont*eel_turn6
8456 cd write (2,*) 'ekont',ekont
8457 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8460 crc-------------------------------------------------
8461 SUBROUTINE MATVEC2(A1,V1,V2)
8462 implicit real*8 (a-h,o-z)
8463 include 'DIMENSIONS'
8464 DIMENSION A1(2,2),V1(2),V2(2)
8468 c 3 VI=VI+A1(I,K)*V1(K)
8472 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8473 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8478 C---------------------------------------
8479 SUBROUTINE MATMAT2(A1,A2,A3)
8480 implicit real*8 (a-h,o-z)
8481 include 'DIMENSIONS'
8482 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8483 c DIMENSION AI3(2,2)
8487 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8493 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8494 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8495 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8496 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8504 c-------------------------------------------------------------------------
8505 double precision function scalar2(u,v)
8507 double precision u(2),v(2)
8510 scalar2=u(1)*v(1)+u(2)*v(2)
8514 C-----------------------------------------------------------------------------
8516 subroutine transpose2(a,at)
8518 double precision a(2,2),at(2,2)
8525 c--------------------------------------------------------------------------
8526 subroutine transpose(n,a,at)
8529 double precision a(n,n),at(n,n)
8537 C---------------------------------------------------------------------------
8538 subroutine prodmat3(a1,a2,kk,transp,prod)
8541 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8543 crc double precision auxmat(2,2),prod_(2,2)
8546 crc call transpose2(kk(1,1),auxmat(1,1))
8547 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8548 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8550 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8551 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8552 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8553 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8554 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8555 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8556 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8557 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8560 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8561 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8563 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8564 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8565 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8566 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8567 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8568 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8569 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8570 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8573 c call transpose2(a2(1,1),a2t(1,1))
8576 crc print *,((prod_(i,j),i=1,2),j=1,2)
8577 crc print *,((prod(i,j),i=1,2),j=1,2)
8581 C-----------------------------------------------------------------------------
8582 double precision function scalar(u,v)
8584 double precision u(3),v(3)
8594 C-----------------------------------------------------------------------
8595 double precision function sscale(r)
8596 double precision r,gamm
8597 include "COMMON.SPLITELE"
8598 if(r.lt.r_cut-rlamb) then
8600 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8601 gamm=(r-(r_cut-rlamb))/rlamb
8602 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8608 C-----------------------------------------------------------------------
8609 C-----------------------------------------------------------------------
8610 double precision function sscagrad(r)
8611 double precision r,gamm
8612 include "COMMON.SPLITELE"
8613 if(r.lt.r_cut-rlamb) then
8615 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8616 gamm=(r-(r_cut-rlamb))/rlamb
8617 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8623 C-----------------------------------------------------------------------
8624 C-----------------------------------------------------------------------
8625 double precision function sscalelip(r)
8626 double precision r,gamm
8627 include "COMMON.SPLITELE"
8628 C if(r.lt.r_cut-rlamb) then
8630 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8631 C gamm=(r-(r_cut-rlamb))/rlamb
8632 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8638 C-----------------------------------------------------------------------
8639 double precision function sscagradlip(r)
8640 double precision r,gamm
8641 include "COMMON.SPLITELE"
8642 C if(r.lt.r_cut-rlamb) then
8644 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8645 C gamm=(r-(r_cut-rlamb))/rlamb
8646 sscagradlip=r*(6*r-6.0d0)