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)
113 write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
114 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
115 call e_saxs(Esaxs_constr)
116 write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
117 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
118 call e_saxsC(Esaxs_constr)
119 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
124 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
125 if (constr_homology.ge.1) then
126 call e_modeller(ehomology_constr)
128 ehomology_constr=0.0d0
131 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
132 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
134 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
136 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
137 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
138 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
139 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
140 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
141 & +wbond*estr+wsccor*fact(1)*esccor+wsaxs*esaxs_constr
143 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
144 & +welec*fact(1)*(ees+evdw1)
145 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
146 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
147 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
148 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
149 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
150 & +wbond*estr+wsccor*fact(1)*esccor+wsaxs*esaxs_constr
155 energia(2)=evdw2-evdw2_14
172 energia(8)=eello_turn3
173 energia(9)=eello_turn4
182 energia(20)=edihcnstr
184 energia(22)=ehomology_constr
185 energia(26)=esaxs_constr
189 if (isnan(etot).ne.0) energia(0)=1.0d+99
191 if (isnan(etot)) energia(0)=1.0d+99
196 idumm=proc_proc(etot,i)
198 call proc_proc(etot,i)
200 if(i.eq.1)energia(0)=1.0d+99
207 call enerprint(energia,fact)
212 C Sum up the components of the Cartesian gradient.
217 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
218 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
220 & wstrain*ghpbc(j,i)+
221 & wcorr*fact(3)*gradcorr(j,i)+
222 & wel_loc*fact(2)*gel_loc(j,i)+
223 & wturn3*fact(2)*gcorr3_turn(j,i)+
224 & wturn4*fact(3)*gcorr4_turn(j,i)+
225 & wcorr5*fact(4)*gradcorr5(j,i)+
226 & wcorr6*fact(5)*gradcorr6(j,i)+
227 & wturn6*fact(5)*gcorr6_turn(j,i)+
228 & wsccor*fact(2)*gsccorc(j,i)
229 & +wliptran*gliptranc(j,i)
230 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
232 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
233 & wsccor*fact(2)*gsccorx(j,i)
238 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
239 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
241 & wcorr*fact(3)*gradcorr(j,i)+
242 & wel_loc*fact(2)*gel_loc(j,i)+
243 & wturn3*fact(2)*gcorr3_turn(j,i)+
244 & wturn4*fact(3)*gcorr4_turn(j,i)+
245 & wcorr5*fact(4)*gradcorr5(j,i)+
246 & wcorr6*fact(5)*gradcorr6(j,i)+
247 & wturn6*fact(5)*gcorr6_turn(j,i)+
248 & wsccor*fact(2)*gsccorc(j,i)
249 & +wliptran*gliptranc(j,i)
250 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
252 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
253 & wsccor*fact(1)*gsccorx(j,i)
254 & +wliptran*gliptranx(j,i)
261 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
262 & +wcorr5*fact(4)*g_corr5_loc(i)
263 & +wcorr6*fact(5)*g_corr6_loc(i)
264 & +wturn4*fact(3)*gel_loc_turn4(i)
265 & +wturn3*fact(2)*gel_loc_turn3(i)
266 & +wturn6*fact(5)*gel_loc_turn6(i)
267 & +wel_loc*fact(2)*gel_loc_loc(i)
268 c & +wsccor*fact(1)*gsccor_loc(i)
269 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
272 if (dyn_ss) call dyn_set_nss
275 C------------------------------------------------------------------------
276 subroutine enerprint(energia,fact)
277 implicit real*8 (a-h,o-z)
279 include 'DIMENSIONS.ZSCOPT'
280 include 'COMMON.IOUNITS'
281 include 'COMMON.FFIELD'
282 include 'COMMON.SBRIDGE'
283 double precision energia(0:max_ene),fact(6)
285 evdw=energia(1)+fact(6)*energia(21)
287 evdw2=energia(2)+energia(17)
299 eello_turn3=energia(8)
300 eello_turn4=energia(9)
301 eello_turn6=energia(10)
308 edihcnstr=energia(20)
310 ehomology_constr=energia(22)
311 esaxs_constr=energia(26)
313 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
315 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
316 & etors_d,wtor_d*fact(2),ehpb,wstrain,
317 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
318 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
319 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
320 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,
321 & esaxs_constr*wsaxs,ebr*nss,
323 10 format (/'Virtual-chain energies:'//
324 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
325 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
326 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
327 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
328 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
329 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
330 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
331 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
332 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
333 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
334 & ' (SS bridges & dist. cnstr.)'/
335 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
336 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
337 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
338 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
339 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
340 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
341 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
342 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
343 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
344 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
345 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
346 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
347 & 'ETOT= ',1pE16.6,' (total)')
349 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
350 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
351 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
352 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
353 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
354 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
355 & edihcnstr,ehomology_constr,esaxs_constr*wsaxs,ebr*nss,
357 10 format (/'Virtual-chain energies:'//
358 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
359 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
360 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
361 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
362 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
363 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
364 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
365 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
366 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
367 & ' (SS bridges & dist. cnstr.)'/
368 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
369 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
370 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
371 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
372 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
373 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
374 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
375 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
376 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
377 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
378 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
379 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
380 & 'ETOT= ',1pE16.6,' (total)')
384 C-----------------------------------------------------------------------
385 subroutine elj(evdw,evdw_t)
387 C This subroutine calculates the interaction energy of nonbonded side chains
388 C assuming the LJ potential of interaction.
390 implicit real*8 (a-h,o-z)
392 include 'DIMENSIONS.ZSCOPT'
393 include "DIMENSIONS.COMPAR"
394 parameter (accur=1.0d-10)
397 include 'COMMON.LOCAL'
398 include 'COMMON.CHAIN'
399 include 'COMMON.DERIV'
400 include 'COMMON.INTERACT'
401 include 'COMMON.TORSION'
402 include 'COMMON.ENEPS'
403 include 'COMMON.SBRIDGE'
404 include 'COMMON.NAMES'
405 include 'COMMON.IOUNITS'
406 include 'COMMON.CONTACTS'
410 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
413 eneps_temp(j,i)=0.0d0
420 if (itypi.eq.ntyp1) cycle
421 itypi1=iabs(itype(i+1))
428 C Calculate SC interaction energy.
431 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
432 cd & 'iend=',iend(i,iint)
433 do j=istart(i,iint),iend(i,iint)
435 if (itypj.eq.ntyp1) cycle
439 C Change 12/1/95 to calculate four-body interactions
440 rij=xj*xj+yj*yj+zj*zj
442 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
443 eps0ij=eps(itypi,itypj)
448 ij=icant(itypi,itypj)
449 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
450 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
451 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
452 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
453 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
454 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
455 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
456 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
457 if (bb.gt.0.0d0) then
464 C Calculate the components of the gradient in DC and X
466 fac=-rrij*(e1+evdwij)
471 gvdwx(k,i)=gvdwx(k,i)-gg(k)
472 gvdwx(k,j)=gvdwx(k,j)+gg(k)
476 gvdwc(l,k)=gvdwc(l,k)+gg(l)
481 C 12/1/95, revised on 5/20/97
483 C Calculate the contact function. The ith column of the array JCONT will
484 C contain the numbers of atoms that make contacts with the atom I (of numbers
485 C greater than I). The arrays FACONT and GACONT will contain the values of
486 C the contact function and its derivative.
488 C Uncomment next line, if the correlation interactions include EVDW explicitly.
489 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
490 C Uncomment next line, if the correlation interactions are contact function only
491 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
493 sigij=sigma(itypi,itypj)
494 r0ij=rs0(itypi,itypj)
496 C Check whether the SC's are not too far to make a contact.
499 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
500 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
502 if (fcont.gt.0.0D0) then
503 C If the SC-SC distance if close to sigma, apply spline.
504 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
505 cAdam & fcont1,fprimcont1)
506 cAdam fcont1=1.0d0-fcont1
507 cAdam if (fcont1.gt.0.0d0) then
508 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
509 cAdam fcont=fcont*fcont1
511 C Uncomment following 4 lines to have the geometric average of the epsilon0's
512 cga eps0ij=1.0d0/dsqrt(eps0ij)
514 cga gg(k)=gg(k)*eps0ij
516 cga eps0ij=-evdwij*eps0ij
517 C Uncomment for AL's type of SC correlation interactions.
519 num_conti=num_conti+1
521 facont(num_conti,i)=fcont*eps0ij
522 fprimcont=eps0ij*fprimcont/rij
524 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
525 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
526 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
527 C Uncomment following 3 lines for Skolnick's type of SC correlation.
528 gacont(1,num_conti,i)=-fprimcont*xj
529 gacont(2,num_conti,i)=-fprimcont*yj
530 gacont(3,num_conti,i)=-fprimcont*zj
531 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
532 cd write (iout,'(2i3,3f10.5)')
533 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
539 num_cont(i)=num_conti
544 gvdwc(j,i)=expon*gvdwc(j,i)
545 gvdwx(j,i)=expon*gvdwx(j,i)
549 C******************************************************************************
553 C To save time, the factor of EXPON has been extracted from ALL components
554 C of GVDWC and GRADX. Remember to multiply them by this factor before further
557 C******************************************************************************
560 C-----------------------------------------------------------------------------
561 subroutine eljk(evdw,evdw_t)
563 C This subroutine calculates the interaction energy of nonbonded side chains
564 C assuming the LJK potential of interaction.
566 implicit real*8 (a-h,o-z)
568 include 'DIMENSIONS.ZSCOPT'
569 include "DIMENSIONS.COMPAR"
572 include 'COMMON.LOCAL'
573 include 'COMMON.CHAIN'
574 include 'COMMON.DERIV'
575 include 'COMMON.INTERACT'
576 include 'COMMON.ENEPS'
577 include 'COMMON.IOUNITS'
578 include 'COMMON.NAMES'
583 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
586 eneps_temp(j,i)=0.0d0
593 if (itypi.eq.ntyp1) cycle
594 itypi1=iabs(itype(i+1))
599 C Calculate SC interaction energy.
602 do j=istart(i,iint),iend(i,iint)
604 if (itypj.eq.ntyp1) cycle
608 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
610 e_augm=augm(itypi,itypj)*fac_augm
613 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
614 fac=r_shift_inv**expon
618 ij=icant(itypi,itypj)
619 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
620 & /dabs(eps(itypi,itypj))
621 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
622 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
623 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
624 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
625 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
626 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
627 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
628 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
629 if (bb.gt.0.0d0) then
636 C Calculate the components of the gradient in DC and X
638 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
643 gvdwx(k,i)=gvdwx(k,i)-gg(k)
644 gvdwx(k,j)=gvdwx(k,j)+gg(k)
648 gvdwc(l,k)=gvdwc(l,k)+gg(l)
658 gvdwc(j,i)=expon*gvdwc(j,i)
659 gvdwx(j,i)=expon*gvdwx(j,i)
665 C-----------------------------------------------------------------------------
666 subroutine ebp(evdw,evdw_t)
668 C This subroutine calculates the interaction energy of nonbonded side chains
669 C assuming the Berne-Pechukas potential of interaction.
671 implicit real*8 (a-h,o-z)
673 include 'DIMENSIONS.ZSCOPT'
674 include "DIMENSIONS.COMPAR"
677 include 'COMMON.LOCAL'
678 include 'COMMON.CHAIN'
679 include 'COMMON.DERIV'
680 include 'COMMON.NAMES'
681 include 'COMMON.INTERACT'
682 include 'COMMON.ENEPS'
683 include 'COMMON.IOUNITS'
684 include 'COMMON.CALC'
686 c double precision rrsave(maxdim)
692 eneps_temp(j,i)=0.0d0
697 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
698 c if (icall.eq.0) then
706 if (itypi.eq.ntyp1) cycle
707 itypi1=iabs(itype(i+1))
711 dxi=dc_norm(1,nres+i)
712 dyi=dc_norm(2,nres+i)
713 dzi=dc_norm(3,nres+i)
714 dsci_inv=vbld_inv(i+nres)
716 C Calculate SC interaction energy.
719 do j=istart(i,iint),iend(i,iint)
722 if (itypj.eq.ntyp1) cycle
723 dscj_inv=vbld_inv(j+nres)
724 chi1=chi(itypi,itypj)
725 chi2=chi(itypj,itypi)
732 alf12=0.5D0*(alf1+alf2)
733 C For diagnostics only!!!
746 dxj=dc_norm(1,nres+j)
747 dyj=dc_norm(2,nres+j)
748 dzj=dc_norm(3,nres+j)
749 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
750 cd if (icall.eq.0) then
756 C Calculate the angle-dependent terms of energy & contributions to derivatives.
758 C Calculate whole angle-dependent part of epsilon and contributions
760 fac=(rrij*sigsq)**expon2
763 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
764 eps2der=evdwij*eps3rt
765 eps3der=evdwij*eps2rt
766 evdwij=evdwij*eps2rt*eps3rt
767 ij=icant(itypi,itypj)
768 aux=eps1*eps2rt**2*eps3rt**2
769 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
770 & /dabs(eps(itypi,itypj))
771 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
772 if (bb.gt.0.0d0) then
779 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
781 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
782 & restyp(itypi),i,restyp(itypj),j,
783 & epsi,sigm,chi1,chi2,chip1,chip2,
784 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
785 & om1,om2,om12,1.0D0/dsqrt(rrij),
788 C Calculate gradient components.
789 e1=e1*eps1*eps2rt**2*eps3rt**2
790 fac=-expon*(e1+evdwij)
793 C Calculate radial part of the gradient
797 C Calculate the angular part of the gradient and sum add the contributions
798 C to the appropriate components of the Cartesian gradient.
807 C-----------------------------------------------------------------------------
808 subroutine egb(evdw,evdw_t)
810 C This subroutine calculates the interaction energy of nonbonded side chains
811 C assuming the Gay-Berne potential of interaction.
813 implicit real*8 (a-h,o-z)
815 include 'DIMENSIONS.ZSCOPT'
816 include "DIMENSIONS.COMPAR"
819 include 'COMMON.LOCAL'
820 include 'COMMON.CHAIN'
821 include 'COMMON.DERIV'
822 include 'COMMON.NAMES'
823 include 'COMMON.INTERACT'
824 include 'COMMON.ENEPS'
825 include 'COMMON.IOUNITS'
826 include 'COMMON.CALC'
827 include 'COMMON.SBRIDGE'
830 integer icant,xshift,yshift,zshift
834 eneps_temp(j,i)=0.0d0
837 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
841 c if (icall.gt.0) lprn=.true.
845 if (itypi.eq.ntyp1) cycle
846 itypi1=iabs(itype(i+1))
850 C returning the ith atom to box
852 if (xi.lt.0) xi=xi+boxxsize
854 if (yi.lt.0) yi=yi+boxysize
856 if (zi.lt.0) zi=zi+boxzsize
857 if ((zi.gt.bordlipbot)
858 &.and.(zi.lt.bordliptop)) then
859 C the energy transfer exist
860 if (zi.lt.buflipbot) then
861 C what fraction I am in
863 & ((zi-bordlipbot)/lipbufthick)
864 C lipbufthick is thickenes of lipid buffore
865 sslipi=sscalelip(fracinbuf)
866 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
867 elseif (zi.gt.bufliptop) then
868 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
869 sslipi=sscalelip(fracinbuf)
870 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
880 dxi=dc_norm(1,nres+i)
881 dyi=dc_norm(2,nres+i)
882 dzi=dc_norm(3,nres+i)
883 dsci_inv=vbld_inv(i+nres)
885 C Calculate SC interaction energy.
888 do j=istart(i,iint),iend(i,iint)
889 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
890 call dyn_ssbond_ene(i,j,evdwij)
892 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
893 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
894 C triple bond artifac removal
895 do k=j+1,iend(i,iint)
896 C search over all next residues
897 if (dyn_ss_mask(k)) then
898 C check if they are cysteins
899 C write(iout,*) 'k=',k
900 call triple_ssbond_ene(i,j,k,evdwij)
901 C call the energy function that removes the artifical triple disulfide
902 C bond the soubroutine is located in ssMD.F
904 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
905 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
911 if (itypj.eq.ntyp1) cycle
912 dscj_inv=vbld_inv(j+nres)
913 sig0ij=sigma(itypi,itypj)
914 chi1=chi(itypi,itypj)
915 chi2=chi(itypj,itypi)
922 alf12=0.5D0*(alf1+alf2)
923 C For diagnostics only!!!
936 C returning jth atom to box
938 if (xj.lt.0) xj=xj+boxxsize
940 if (yj.lt.0) yj=yj+boxysize
942 if (zj.lt.0) zj=zj+boxzsize
943 if ((zj.gt.bordlipbot)
944 &.and.(zj.lt.bordliptop)) then
945 C the energy transfer exist
946 if (zj.lt.buflipbot) then
947 C what fraction I am in
949 & ((zj-bordlipbot)/lipbufthick)
950 C lipbufthick is thickenes of lipid buffore
951 sslipj=sscalelip(fracinbuf)
952 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
953 elseif (zj.gt.bufliptop) then
954 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
955 sslipj=sscalelip(fracinbuf)
956 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
965 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
966 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
967 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
968 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
969 C if (aa.ne.aa_aq(itypi,itypj)) then
971 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
972 C & bb_aq(itypi,itypj)-bb,
976 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
977 C checking the distance
978 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
983 C finding the closest
987 xj=xj_safe+xshift*boxxsize
988 yj=yj_safe+yshift*boxysize
989 zj=zj_safe+zshift*boxzsize
990 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
991 if(dist_temp.lt.dist_init) then
1001 if (subchap.eq.1) then
1011 dxj=dc_norm(1,nres+j)
1012 dyj=dc_norm(2,nres+j)
1013 dzj=dc_norm(3,nres+j)
1014 c write (iout,*) i,j,xj,yj,zj
1015 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1017 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1018 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1019 if (sss.le.0.0) cycle
1020 C Calculate angle-dependent terms of energy and contributions to their
1025 sig=sig0ij*dsqrt(sigsq)
1026 rij_shift=1.0D0/rij-sig+sig0ij
1027 C I hate to put IF's in the loops, but here don't have another choice!!!!
1028 if (rij_shift.le.0.0D0) then
1033 c---------------------------------------------------------------
1034 rij_shift=1.0D0/rij_shift
1035 fac=rij_shift**expon
1038 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1039 eps2der=evdwij*eps3rt
1040 eps3der=evdwij*eps2rt
1041 evdwij=evdwij*eps2rt*eps3rt
1043 evdw=evdw+evdwij*sss
1045 evdw_t=evdw_t+evdwij*sss
1047 ij=icant(itypi,itypj)
1048 aux=eps1*eps2rt**2*eps3rt**2
1049 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1050 & /dabs(eps(itypi,itypj))
1051 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1052 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1053 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1054 c & aux*e2/eps(itypi,itypj)
1056 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1060 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1061 & restyp(itypi),i,restyp(itypj),j,
1062 & epsi,sigm,chi1,chi2,chip1,chip2,
1063 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1064 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1066 write (iout,*) "partial sum", evdw, evdw_t
1071 C Calculate gradient components.
1072 e1=e1*eps1*eps2rt**2*eps3rt**2
1073 fac=-expon*(e1+evdwij)*rij_shift
1076 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1077 C Calculate the radial part of the gradient
1081 C Calculate angular part of the gradient.
1084 C write(iout,*) "partial sum", evdw, evdw_t
1091 C-----------------------------------------------------------------------------
1092 subroutine egbv(evdw,evdw_t)
1094 C This subroutine calculates the interaction energy of nonbonded side chains
1095 C assuming the Gay-Berne-Vorobjev potential of interaction.
1097 implicit real*8 (a-h,o-z)
1098 include 'DIMENSIONS'
1099 include 'DIMENSIONS.ZSCOPT'
1100 include "DIMENSIONS.COMPAR"
1101 include 'COMMON.GEO'
1102 include 'COMMON.VAR'
1103 include 'COMMON.LOCAL'
1104 include 'COMMON.CHAIN'
1105 include 'COMMON.DERIV'
1106 include 'COMMON.NAMES'
1107 include 'COMMON.INTERACT'
1108 include 'COMMON.ENEPS'
1109 include 'COMMON.IOUNITS'
1110 include 'COMMON.CALC'
1111 common /srutu/ icall
1117 eneps_temp(j,i)=0.0d0
1122 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1125 c if (icall.gt.0) lprn=.true.
1127 do i=iatsc_s,iatsc_e
1128 itypi=iabs(itype(i))
1129 if (itypi.eq.ntyp1) cycle
1130 itypi1=iabs(itype(i+1))
1134 dxi=dc_norm(1,nres+i)
1135 dyi=dc_norm(2,nres+i)
1136 dzi=dc_norm(3,nres+i)
1137 dsci_inv=vbld_inv(i+nres)
1139 C Calculate SC interaction energy.
1141 do iint=1,nint_gr(i)
1142 do j=istart(i,iint),iend(i,iint)
1144 itypj=iabs(itype(j))
1145 if (itypj.eq.ntyp1) cycle
1146 dscj_inv=vbld_inv(j+nres)
1147 sig0ij=sigma(itypi,itypj)
1148 r0ij=r0(itypi,itypj)
1149 chi1=chi(itypi,itypj)
1150 chi2=chi(itypj,itypi)
1157 alf12=0.5D0*(alf1+alf2)
1158 C For diagnostics only!!!
1171 dxj=dc_norm(1,nres+j)
1172 dyj=dc_norm(2,nres+j)
1173 dzj=dc_norm(3,nres+j)
1174 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1176 C Calculate angle-dependent terms of energy and contributions to their
1180 sig=sig0ij*dsqrt(sigsq)
1181 rij_shift=1.0D0/rij-sig+r0ij
1182 C I hate to put IF's in the loops, but here don't have another choice!!!!
1183 if (rij_shift.le.0.0D0) then
1188 c---------------------------------------------------------------
1189 rij_shift=1.0D0/rij_shift
1190 fac=rij_shift**expon
1193 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1194 eps2der=evdwij*eps3rt
1195 eps3der=evdwij*eps2rt
1196 fac_augm=rrij**expon
1197 e_augm=augm(itypi,itypj)*fac_augm
1198 evdwij=evdwij*eps2rt*eps3rt
1199 if (bb.gt.0.0d0) then
1200 evdw=evdw+evdwij+e_augm
1202 evdw_t=evdw_t+evdwij+e_augm
1204 ij=icant(itypi,itypj)
1205 aux=eps1*eps2rt**2*eps3rt**2
1206 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1207 & /dabs(eps(itypi,itypj))
1208 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1209 c eneps_temp(ij)=eneps_temp(ij)
1210 c & +(evdwij+e_augm)/eps(itypi,itypj)
1212 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1213 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1214 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1215 c & restyp(itypi),i,restyp(itypj),j,
1216 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1217 c & chi1,chi2,chip1,chip2,
1218 c & eps1,eps2rt**2,eps3rt**2,
1219 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1223 C Calculate gradient components.
1224 e1=e1*eps1*eps2rt**2*eps3rt**2
1225 fac=-expon*(e1+evdwij)*rij_shift
1227 fac=rij*fac-2*expon*rrij*e_augm
1228 C Calculate the radial part of the gradient
1232 C Calculate angular part of the gradient.
1240 C-----------------------------------------------------------------------------
1241 subroutine sc_angular
1242 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1243 C om12. Called by ebp, egb, and egbv.
1245 include 'COMMON.CALC'
1249 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1250 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1251 om12=dxi*dxj+dyi*dyj+dzi*dzj
1253 C Calculate eps1(om12) and its derivative in om12
1254 faceps1=1.0D0-om12*chiom12
1255 faceps1_inv=1.0D0/faceps1
1256 eps1=dsqrt(faceps1_inv)
1257 C Following variable is eps1*deps1/dom12
1258 eps1_om12=faceps1_inv*chiom12
1259 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1264 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1265 sigsq=1.0D0-facsig*faceps1_inv
1266 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1267 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1268 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1269 C Calculate eps2 and its derivatives in om1, om2, and om12.
1272 chipom12=chip12*om12
1273 facp=1.0D0-om12*chipom12
1275 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1276 C Following variable is the square root of eps2
1277 eps2rt=1.0D0-facp1*facp_inv
1278 C Following three variables are the derivatives of the square root of eps
1279 C in om1, om2, and om12.
1280 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1281 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1282 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1283 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1284 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1285 C Calculate whole angle-dependent part of epsilon and contributions
1286 C to its derivatives
1289 C----------------------------------------------------------------------------
1291 implicit real*8 (a-h,o-z)
1292 include 'DIMENSIONS'
1293 include 'DIMENSIONS.ZSCOPT'
1294 include 'COMMON.CHAIN'
1295 include 'COMMON.DERIV'
1296 include 'COMMON.CALC'
1297 double precision dcosom1(3),dcosom2(3)
1298 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1299 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1300 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1301 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1303 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1304 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1307 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1310 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1311 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1312 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1313 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1314 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1315 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1318 C Calculate the components of the gradient in DC and X
1322 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1327 c------------------------------------------------------------------------------
1328 subroutine vec_and_deriv
1329 implicit real*8 (a-h,o-z)
1330 include 'DIMENSIONS'
1331 include 'DIMENSIONS.ZSCOPT'
1332 include 'COMMON.IOUNITS'
1333 include 'COMMON.GEO'
1334 include 'COMMON.VAR'
1335 include 'COMMON.LOCAL'
1336 include 'COMMON.CHAIN'
1337 include 'COMMON.VECTORS'
1338 include 'COMMON.DERIV'
1339 include 'COMMON.INTERACT'
1340 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1341 C Compute the local reference systems. For reference system (i), the
1342 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1343 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1345 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1346 if (i.eq.nres-1) then
1347 C Case of the last full residue
1348 C Compute the Z-axis
1349 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1350 costh=dcos(pi-theta(nres))
1351 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1356 C Compute the derivatives of uz
1358 uzder(2,1,1)=-dc_norm(3,i-1)
1359 uzder(3,1,1)= dc_norm(2,i-1)
1360 uzder(1,2,1)= dc_norm(3,i-1)
1362 uzder(3,2,1)=-dc_norm(1,i-1)
1363 uzder(1,3,1)=-dc_norm(2,i-1)
1364 uzder(2,3,1)= dc_norm(1,i-1)
1367 uzder(2,1,2)= dc_norm(3,i)
1368 uzder(3,1,2)=-dc_norm(2,i)
1369 uzder(1,2,2)=-dc_norm(3,i)
1371 uzder(3,2,2)= dc_norm(1,i)
1372 uzder(1,3,2)= dc_norm(2,i)
1373 uzder(2,3,2)=-dc_norm(1,i)
1376 C Compute the Y-axis
1379 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1382 C Compute the derivatives of uy
1385 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1386 & -dc_norm(k,i)*dc_norm(j,i-1)
1387 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1389 uyder(j,j,1)=uyder(j,j,1)-costh
1390 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1395 uygrad(l,k,j,i)=uyder(l,k,j)
1396 uzgrad(l,k,j,i)=uzder(l,k,j)
1400 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1401 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1402 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1403 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1407 C Compute the Z-axis
1408 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1409 costh=dcos(pi-theta(i+2))
1410 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1415 C Compute the derivatives of uz
1417 uzder(2,1,1)=-dc_norm(3,i+1)
1418 uzder(3,1,1)= dc_norm(2,i+1)
1419 uzder(1,2,1)= dc_norm(3,i+1)
1421 uzder(3,2,1)=-dc_norm(1,i+1)
1422 uzder(1,3,1)=-dc_norm(2,i+1)
1423 uzder(2,3,1)= dc_norm(1,i+1)
1426 uzder(2,1,2)= dc_norm(3,i)
1427 uzder(3,1,2)=-dc_norm(2,i)
1428 uzder(1,2,2)=-dc_norm(3,i)
1430 uzder(3,2,2)= dc_norm(1,i)
1431 uzder(1,3,2)= dc_norm(2,i)
1432 uzder(2,3,2)=-dc_norm(1,i)
1435 C Compute the Y-axis
1438 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1441 C Compute the derivatives of uy
1444 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1445 & -dc_norm(k,i)*dc_norm(j,i+1)
1446 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1448 uyder(j,j,1)=uyder(j,j,1)-costh
1449 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1454 uygrad(l,k,j,i)=uyder(l,k,j)
1455 uzgrad(l,k,j,i)=uzder(l,k,j)
1459 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1460 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1461 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1462 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1468 vbld_inv_temp(1)=vbld_inv(i+1)
1469 if (i.lt.nres-1) then
1470 vbld_inv_temp(2)=vbld_inv(i+2)
1472 vbld_inv_temp(2)=vbld_inv(i)
1477 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1478 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1486 C-----------------------------------------------------------------------------
1487 subroutine vec_and_deriv_test
1488 implicit real*8 (a-h,o-z)
1489 include 'DIMENSIONS'
1490 include 'DIMENSIONS.ZSCOPT'
1491 include 'COMMON.IOUNITS'
1492 include 'COMMON.GEO'
1493 include 'COMMON.VAR'
1494 include 'COMMON.LOCAL'
1495 include 'COMMON.CHAIN'
1496 include 'COMMON.VECTORS'
1497 dimension uyder(3,3,2),uzder(3,3,2)
1498 C Compute the local reference systems. For reference system (i), the
1499 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1500 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1502 if (i.eq.nres-1) then
1503 C Case of the last full residue
1504 C Compute the Z-axis
1505 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1506 costh=dcos(pi-theta(nres))
1507 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1508 c write (iout,*) 'fac',fac,
1509 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1510 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1514 C Compute the derivatives of uz
1516 uzder(2,1,1)=-dc_norm(3,i-1)
1517 uzder(3,1,1)= dc_norm(2,i-1)
1518 uzder(1,2,1)= dc_norm(3,i-1)
1520 uzder(3,2,1)=-dc_norm(1,i-1)
1521 uzder(1,3,1)=-dc_norm(2,i-1)
1522 uzder(2,3,1)= dc_norm(1,i-1)
1525 uzder(2,1,2)= dc_norm(3,i)
1526 uzder(3,1,2)=-dc_norm(2,i)
1527 uzder(1,2,2)=-dc_norm(3,i)
1529 uzder(3,2,2)= dc_norm(1,i)
1530 uzder(1,3,2)= dc_norm(2,i)
1531 uzder(2,3,2)=-dc_norm(1,i)
1533 C Compute the Y-axis
1535 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1538 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1539 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1540 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1542 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1545 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1546 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1549 c write (iout,*) 'facy',facy,
1550 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1551 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1553 uy(k,i)=facy*uy(k,i)
1555 C Compute the derivatives of uy
1558 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1559 & -dc_norm(k,i)*dc_norm(j,i-1)
1560 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1562 c uyder(j,j,1)=uyder(j,j,1)-costh
1563 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1564 uyder(j,j,1)=uyder(j,j,1)
1565 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1566 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1572 uygrad(l,k,j,i)=uyder(l,k,j)
1573 uzgrad(l,k,j,i)=uzder(l,k,j)
1577 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1578 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1579 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1580 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1583 C Compute the Z-axis
1584 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1585 costh=dcos(pi-theta(i+2))
1586 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1587 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1591 C Compute the derivatives of uz
1593 uzder(2,1,1)=-dc_norm(3,i+1)
1594 uzder(3,1,1)= dc_norm(2,i+1)
1595 uzder(1,2,1)= dc_norm(3,i+1)
1597 uzder(3,2,1)=-dc_norm(1,i+1)
1598 uzder(1,3,1)=-dc_norm(2,i+1)
1599 uzder(2,3,1)= dc_norm(1,i+1)
1602 uzder(2,1,2)= dc_norm(3,i)
1603 uzder(3,1,2)=-dc_norm(2,i)
1604 uzder(1,2,2)=-dc_norm(3,i)
1606 uzder(3,2,2)= dc_norm(1,i)
1607 uzder(1,3,2)= dc_norm(2,i)
1608 uzder(2,3,2)=-dc_norm(1,i)
1610 C Compute the Y-axis
1612 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1613 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1614 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1616 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1619 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1620 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1623 c write (iout,*) 'facy',facy,
1624 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1625 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1627 uy(k,i)=facy*uy(k,i)
1629 C Compute the derivatives of uy
1632 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1633 & -dc_norm(k,i)*dc_norm(j,i+1)
1634 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1636 c uyder(j,j,1)=uyder(j,j,1)-costh
1637 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1638 uyder(j,j,1)=uyder(j,j,1)
1639 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1640 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1646 uygrad(l,k,j,i)=uyder(l,k,j)
1647 uzgrad(l,k,j,i)=uzder(l,k,j)
1651 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1652 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1653 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1654 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1661 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1662 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1669 C-----------------------------------------------------------------------------
1670 subroutine check_vecgrad
1671 implicit real*8 (a-h,o-z)
1672 include 'DIMENSIONS'
1673 include 'DIMENSIONS.ZSCOPT'
1674 include 'COMMON.IOUNITS'
1675 include 'COMMON.GEO'
1676 include 'COMMON.VAR'
1677 include 'COMMON.LOCAL'
1678 include 'COMMON.CHAIN'
1679 include 'COMMON.VECTORS'
1680 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1681 dimension uyt(3,maxres),uzt(3,maxres)
1682 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1683 double precision delta /1.0d-7/
1686 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1687 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1688 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1689 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1690 cd & (dc_norm(if90,i),if90=1,3)
1691 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1692 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1693 cd write(iout,'(a)')
1699 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1700 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1713 cd write (iout,*) 'i=',i
1715 erij(k)=dc_norm(k,i)
1719 dc_norm(k,i)=erij(k)
1721 dc_norm(j,i)=dc_norm(j,i)+delta
1722 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1724 c dc_norm(k,i)=dc_norm(k,i)/fac
1726 c write (iout,*) (dc_norm(k,i),k=1,3)
1727 c write (iout,*) (erij(k),k=1,3)
1730 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1731 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1732 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1733 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1735 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1736 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1737 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1740 dc_norm(k,i)=erij(k)
1743 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1744 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1745 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1746 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1747 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1748 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1749 cd write (iout,'(a)')
1754 C--------------------------------------------------------------------------
1755 subroutine set_matrices
1756 implicit real*8 (a-h,o-z)
1757 include 'DIMENSIONS'
1758 include 'DIMENSIONS.ZSCOPT'
1759 include 'COMMON.IOUNITS'
1760 include 'COMMON.GEO'
1761 include 'COMMON.VAR'
1762 include 'COMMON.LOCAL'
1763 include 'COMMON.CHAIN'
1764 include 'COMMON.DERIV'
1765 include 'COMMON.INTERACT'
1766 include 'COMMON.CONTACTS'
1767 include 'COMMON.TORSION'
1768 include 'COMMON.VECTORS'
1769 include 'COMMON.FFIELD'
1770 double precision auxvec(2),auxmat(2,2)
1772 C Compute the virtual-bond-torsional-angle dependent quantities needed
1773 C to calculate the el-loc multibody terms of various order.
1776 if (i .lt. nres+1) then
1813 if (i .gt. 3 .and. i .lt. nres+1) then
1814 obrot_der(1,i-2)=-sin1
1815 obrot_der(2,i-2)= cos1
1816 Ugder(1,1,i-2)= sin1
1817 Ugder(1,2,i-2)=-cos1
1818 Ugder(2,1,i-2)=-cos1
1819 Ugder(2,2,i-2)=-sin1
1822 obrot2_der(1,i-2)=-dwasin2
1823 obrot2_der(2,i-2)= dwacos2
1824 Ug2der(1,1,i-2)= dwasin2
1825 Ug2der(1,2,i-2)=-dwacos2
1826 Ug2der(2,1,i-2)=-dwacos2
1827 Ug2der(2,2,i-2)=-dwasin2
1829 obrot_der(1,i-2)=0.0d0
1830 obrot_der(2,i-2)=0.0d0
1831 Ugder(1,1,i-2)=0.0d0
1832 Ugder(1,2,i-2)=0.0d0
1833 Ugder(2,1,i-2)=0.0d0
1834 Ugder(2,2,i-2)=0.0d0
1835 obrot2_der(1,i-2)=0.0d0
1836 obrot2_der(2,i-2)=0.0d0
1837 Ug2der(1,1,i-2)=0.0d0
1838 Ug2der(1,2,i-2)=0.0d0
1839 Ug2der(2,1,i-2)=0.0d0
1840 Ug2der(2,2,i-2)=0.0d0
1842 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1843 if (itype(i-2).le.ntyp) then
1844 iti = itortyp(itype(i-2))
1851 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1852 if (itype(i-1).le.ntyp) then
1853 iti1 = itortyp(itype(i-1))
1860 cd write (iout,*) '*******i',i,' iti1',iti
1861 cd write (iout,*) 'b1',b1(:,iti)
1862 cd write (iout,*) 'b2',b2(:,iti)
1863 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1864 c print *,"itilde1 i iti iti1",i,iti,iti1
1865 if (i .gt. iatel_s+2) then
1866 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1867 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1868 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1869 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1870 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1871 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1872 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1882 DtUg2(l,k,i-2)=0.0d0
1886 c print *,"itilde2 i iti iti1",i,iti,iti1
1887 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1888 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1889 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1890 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1891 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1892 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1893 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1894 c print *,"itilde3 i iti iti1",i,iti,iti1
1896 muder(k,i-2)=Ub2der(k,i-2)
1898 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1899 if (itype(i-1).le.ntyp) then
1900 iti1 = itortyp(itype(i-1))
1908 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1910 C Vectors and matrices dependent on a single virtual-bond dihedral.
1911 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1912 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1913 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1914 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1915 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1916 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1917 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1918 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1919 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1920 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1921 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1923 C Matrices dependent on two consecutive virtual-bond dihedrals.
1924 C The order of matrices is from left to right.
1926 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1927 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1928 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1929 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1930 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1931 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1932 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1933 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1936 cd iti = itortyp(itype(i))
1939 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1940 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1945 C--------------------------------------------------------------------------
1946 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1948 C This subroutine calculates the average interaction energy and its gradient
1949 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1950 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1951 C The potential depends both on the distance of peptide-group centers and on
1952 C the orientation of the CA-CA virtual bonds.
1954 implicit real*8 (a-h,o-z)
1955 include 'DIMENSIONS'
1956 include 'DIMENSIONS.ZSCOPT'
1957 include 'DIMENSIONS.FREE'
1958 include 'COMMON.CONTROL'
1959 include 'COMMON.IOUNITS'
1960 include 'COMMON.GEO'
1961 include 'COMMON.VAR'
1962 include 'COMMON.LOCAL'
1963 include 'COMMON.CHAIN'
1964 include 'COMMON.DERIV'
1965 include 'COMMON.INTERACT'
1966 include 'COMMON.CONTACTS'
1967 include 'COMMON.TORSION'
1968 include 'COMMON.VECTORS'
1969 include 'COMMON.FFIELD'
1970 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1971 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1972 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1973 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1974 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1975 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1976 double precision scal_el /0.5d0/
1978 C 13-go grudnia roku pamietnego...
1979 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1980 & 0.0d0,1.0d0,0.0d0,
1981 & 0.0d0,0.0d0,1.0d0/
1982 cd write(iout,*) 'In EELEC'
1984 cd write(iout,*) 'Type',i
1985 cd write(iout,*) 'B1',B1(:,i)
1986 cd write(iout,*) 'B2',B2(:,i)
1987 cd write(iout,*) 'CC',CC(:,:,i)
1988 cd write(iout,*) 'DD',DD(:,:,i)
1989 cd write(iout,*) 'EE',EE(:,:,i)
1991 cd call check_vecgrad
1993 if (icheckgrad.eq.1) then
1995 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1997 dc_norm(k,i)=dc(k,i)*fac
1999 c write (iout,*) 'i',i,' fac',fac
2002 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2003 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2004 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2005 cd if (wel_loc.gt.0.0d0) then
2006 if (icheckgrad.eq.1) then
2007 call vec_and_deriv_test
2014 cd write (iout,*) 'i=',i
2016 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2019 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2020 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2033 cd print '(a)','Enter EELEC'
2034 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2036 gel_loc_loc(i)=0.0d0
2039 do i=iatel_s,iatel_e
2040 cAna if (i.le.1) cycle
2041 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2042 cAna & .or. ((i+2).gt.nres)
2043 cAna & .or. ((i-1).le.0)
2044 cAna & .or. itype(i+2).eq.ntyp1
2045 cAna & .or. itype(i-1).eq.ntyp1
2048 if (itel(i).eq.0) goto 1215
2052 dx_normi=dc_norm(1,i)
2053 dy_normi=dc_norm(2,i)
2054 dz_normi=dc_norm(3,i)
2055 xmedi=c(1,i)+0.5d0*dxi
2056 ymedi=c(2,i)+0.5d0*dyi
2057 zmedi=c(3,i)+0.5d0*dzi
2058 xmedi=mod(xmedi,boxxsize)
2059 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2060 ymedi=mod(ymedi,boxysize)
2061 if (ymedi.lt.0) ymedi=ymedi+boxysize
2062 zmedi=mod(zmedi,boxzsize)
2063 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2065 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2066 do j=ielstart(i),ielend(i)
2067 cAna if (j.le.1) cycle
2068 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2069 cAna & .or.((j+2).gt.nres)
2070 cAna & .or.((j-1).le.0)
2071 cAna & .or.itype(j+2).eq.ntyp1
2072 cAna & .or.itype(j-1).eq.ntyp1
2074 if (itel(j).eq.0) goto 1216
2078 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2079 aaa=app(iteli,itelj)
2080 bbb=bpp(iteli,itelj)
2081 C Diagnostics only!!!
2087 ael6i=ael6(iteli,itelj)
2088 ael3i=ael3(iteli,itelj)
2092 dx_normj=dc_norm(1,j)
2093 dy_normj=dc_norm(2,j)
2094 dz_normj=dc_norm(3,j)
2099 if (xj.lt.0) xj=xj+boxxsize
2101 if (yj.lt.0) yj=yj+boxysize
2103 if (zj.lt.0) zj=zj+boxzsize
2104 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2112 xj=xj_safe+xshift*boxxsize
2113 yj=yj_safe+yshift*boxysize
2114 zj=zj_safe+zshift*boxzsize
2115 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2116 if(dist_temp.lt.dist_init) then
2126 if (isubchap.eq.1) then
2135 rij=xj*xj+yj*yj+zj*zj
2136 sss=sscale(sqrt(rij))
2137 sssgrad=sscagrad(sqrt(rij))
2143 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2144 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2145 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2146 fac=cosa-3.0D0*cosb*cosg
2148 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2149 if (j.eq.i+2) ev1=scal_el*ev1
2154 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2157 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2158 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2159 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2161 evdw1=evdw1+evdwij*sss
2162 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2163 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2164 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2165 cd & xmedi,ymedi,zmedi,xj,yj,zj
2167 C Calculate contributions to the Cartesian gradient.
2170 facvdw=-6*rrmij*(ev1+evdwij)*sss
2171 facel=-3*rrmij*(el1+eesij)
2178 * Radial derivatives. First process both termini of the fragment (i,j)
2185 gelc(k,i)=gelc(k,i)+ghalf
2186 gelc(k,j)=gelc(k,j)+ghalf
2189 * Loop over residues i+1 thru j-1.
2193 gelc(l,k)=gelc(l,k)+ggg(l)
2201 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2202 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2205 * Loop over residues i+1 thru j-1.
2209 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2216 fac=-3*rrmij*(facvdw+facvdw+facel)
2222 * Radial derivatives. First process both termini of the fragment (i,j)
2229 gelc(k,i)=gelc(k,i)+ghalf
2230 gelc(k,j)=gelc(k,j)+ghalf
2233 * Loop over residues i+1 thru j-1.
2237 gelc(l,k)=gelc(l,k)+ggg(l)
2244 ecosa=2.0D0*fac3*fac1+fac4
2247 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2248 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2250 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2251 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2253 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2254 cd & (dcosg(k),k=1,3)
2256 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2260 gelc(k,i)=gelc(k,i)+ghalf
2261 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2262 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2263 gelc(k,j)=gelc(k,j)+ghalf
2264 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2265 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2269 gelc(l,k)=gelc(l,k)+ggg(l)
2274 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2275 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2276 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2278 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2279 C energy of a peptide unit is assumed in the form of a second-order
2280 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2281 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2282 C are computed for EVERY pair of non-contiguous peptide groups.
2284 if (j.lt.nres-1) then
2295 muij(kkk)=mu(k,i)*mu(l,j)
2298 cd write (iout,*) 'EELEC: i',i,' j',j
2299 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2300 cd write(iout,*) 'muij',muij
2301 ury=scalar(uy(1,i),erij)
2302 urz=scalar(uz(1,i),erij)
2303 vry=scalar(uy(1,j),erij)
2304 vrz=scalar(uz(1,j),erij)
2305 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2306 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2307 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2308 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2309 C For diagnostics only
2314 fac=dsqrt(-ael6i)*r3ij
2315 cd write (2,*) 'fac=',fac
2316 C For diagnostics only
2322 cd write (iout,'(4i5,4f10.5)')
2323 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2324 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2325 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2326 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2327 cd write (iout,'(4f10.5)')
2328 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2329 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2330 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2331 cd write (iout,'(2i3,9f10.5/)') i,j,
2332 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2334 C Derivatives of the elements of A in virtual-bond vectors
2335 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2342 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2343 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2344 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2345 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2346 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2347 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2348 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2349 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2350 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2351 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2352 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2353 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2363 C Compute radial contributions to the gradient
2385 C Add the contributions coming from er
2388 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2389 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2390 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2391 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2394 C Derivatives in DC(i)
2395 ghalf1=0.5d0*agg(k,1)
2396 ghalf2=0.5d0*agg(k,2)
2397 ghalf3=0.5d0*agg(k,3)
2398 ghalf4=0.5d0*agg(k,4)
2399 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2400 & -3.0d0*uryg(k,2)*vry)+ghalf1
2401 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2402 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2403 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2404 & -3.0d0*urzg(k,2)*vry)+ghalf3
2405 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2406 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2407 C Derivatives in DC(i+1)
2408 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2409 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2410 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2411 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2412 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2413 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2414 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2415 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2416 C Derivatives in DC(j)
2417 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2418 & -3.0d0*vryg(k,2)*ury)+ghalf1
2419 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2420 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2421 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2422 & -3.0d0*vryg(k,2)*urz)+ghalf3
2423 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2424 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2425 C Derivatives in DC(j+1) or DC(nres-1)
2426 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2427 & -3.0d0*vryg(k,3)*ury)
2428 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2429 & -3.0d0*vrzg(k,3)*ury)
2430 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2431 & -3.0d0*vryg(k,3)*urz)
2432 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2433 & -3.0d0*vrzg(k,3)*urz)
2438 C Derivatives in DC(i+1)
2439 cd aggi1(k,1)=agg(k,1)
2440 cd aggi1(k,2)=agg(k,2)
2441 cd aggi1(k,3)=agg(k,3)
2442 cd aggi1(k,4)=agg(k,4)
2443 C Derivatives in DC(j)
2448 C Derivatives in DC(j+1)
2453 if (j.eq.nres-1 .and. i.lt.j-2) then
2455 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2456 cd aggj1(k,l)=agg(k,l)
2462 C Check the loc-el terms by numerical integration
2472 aggi(k,l)=-aggi(k,l)
2473 aggi1(k,l)=-aggi1(k,l)
2474 aggj(k,l)=-aggj(k,l)
2475 aggj1(k,l)=-aggj1(k,l)
2478 if (j.lt.nres-1) then
2484 aggi(k,l)=-aggi(k,l)
2485 aggi1(k,l)=-aggi1(k,l)
2486 aggj(k,l)=-aggj(k,l)
2487 aggj1(k,l)=-aggj1(k,l)
2498 aggi(k,l)=-aggi(k,l)
2499 aggi1(k,l)=-aggi1(k,l)
2500 aggj(k,l)=-aggj(k,l)
2501 aggj1(k,l)=-aggj1(k,l)
2507 IF (wel_loc.gt.0.0d0) THEN
2508 C Contribution to the local-electrostatic energy coming from the i-j pair
2509 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2511 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2512 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2513 eel_loc=eel_loc+eel_loc_ij
2514 C Partial derivatives in virtual-bond dihedral angles gamma
2517 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2518 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2519 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2520 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2521 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2522 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2523 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2524 cd write(iout,*) 'agg ',agg
2525 cd write(iout,*) 'aggi ',aggi
2526 cd write(iout,*) 'aggi1',aggi1
2527 cd write(iout,*) 'aggj ',aggj
2528 cd write(iout,*) 'aggj1',aggj1
2530 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2532 ggg(l)=agg(l,1)*muij(1)+
2533 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2537 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2540 C Remaining derivatives of eello
2542 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2543 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2544 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2545 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2546 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2547 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2548 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2549 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2553 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2554 C Contributions from turns
2559 call eturn34(i,j,eello_turn3,eello_turn4)
2561 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2562 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2564 C Calculate the contact function. The ith column of the array JCONT will
2565 C contain the numbers of atoms that make contacts with the atom I (of numbers
2566 C greater than I). The arrays FACONT and GACONT will contain the values of
2567 C the contact function and its derivative.
2568 c r0ij=1.02D0*rpp(iteli,itelj)
2569 c r0ij=1.11D0*rpp(iteli,itelj)
2570 r0ij=2.20D0*rpp(iteli,itelj)
2571 c r0ij=1.55D0*rpp(iteli,itelj)
2572 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2573 if (fcont.gt.0.0D0) then
2574 num_conti=num_conti+1
2575 if (num_conti.gt.maxconts) then
2576 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2577 & ' will skip next contacts for this conf.'
2579 jcont_hb(num_conti,i)=j
2580 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2581 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2582 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2584 d_cont(num_conti,i)=rij
2585 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2586 C --- Electrostatic-interaction matrix ---
2587 a_chuj(1,1,num_conti,i)=a22
2588 a_chuj(1,2,num_conti,i)=a23
2589 a_chuj(2,1,num_conti,i)=a32
2590 a_chuj(2,2,num_conti,i)=a33
2591 C --- Gradient of rij
2593 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2596 c a_chuj(1,1,num_conti,i)=-0.61d0
2597 c a_chuj(1,2,num_conti,i)= 0.4d0
2598 c a_chuj(2,1,num_conti,i)= 0.65d0
2599 c a_chuj(2,2,num_conti,i)= 0.50d0
2600 c else if (i.eq.2) then
2601 c a_chuj(1,1,num_conti,i)= 0.0d0
2602 c a_chuj(1,2,num_conti,i)= 0.0d0
2603 c a_chuj(2,1,num_conti,i)= 0.0d0
2604 c a_chuj(2,2,num_conti,i)= 0.0d0
2606 C --- and its gradients
2607 cd write (iout,*) 'i',i,' j',j
2609 cd write (iout,*) 'iii 1 kkk',kkk
2610 cd write (iout,*) agg(kkk,:)
2613 cd write (iout,*) 'iii 2 kkk',kkk
2614 cd write (iout,*) aggi(kkk,:)
2617 cd write (iout,*) 'iii 3 kkk',kkk
2618 cd write (iout,*) aggi1(kkk,:)
2621 cd write (iout,*) 'iii 4 kkk',kkk
2622 cd write (iout,*) aggj(kkk,:)
2625 cd write (iout,*) 'iii 5 kkk',kkk
2626 cd write (iout,*) aggj1(kkk,:)
2633 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2634 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2635 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2636 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2637 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2639 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2645 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2646 C Calculate contact energies
2648 wij=cosa-3.0D0*cosb*cosg
2651 c fac3=dsqrt(-ael6i)/r0ij**3
2652 fac3=dsqrt(-ael6i)*r3ij
2653 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2654 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2656 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2657 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2658 C Diagnostics. Comment out or remove after debugging!
2659 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2660 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2661 c ees0m(num_conti,i)=0.0D0
2663 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2664 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2665 facont_hb(num_conti,i)=fcont
2667 C Angular derivatives of the contact function
2668 ees0pij1=fac3/ees0pij
2669 ees0mij1=fac3/ees0mij
2670 fac3p=-3.0D0*fac3*rrmij
2671 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2672 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2674 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2675 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2676 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2677 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2678 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2679 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2680 ecosap=ecosa1+ecosa2
2681 ecosbp=ecosb1+ecosb2
2682 ecosgp=ecosg1+ecosg2
2683 ecosam=ecosa1-ecosa2
2684 ecosbm=ecosb1-ecosb2
2685 ecosgm=ecosg1-ecosg2
2694 fprimcont=fprimcont/rij
2695 cd facont_hb(num_conti,i)=1.0D0
2696 C Following line is for diagnostics.
2699 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2700 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2703 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2704 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2706 gggp(1)=gggp(1)+ees0pijp*xj
2707 gggp(2)=gggp(2)+ees0pijp*yj
2708 gggp(3)=gggp(3)+ees0pijp*zj
2709 gggm(1)=gggm(1)+ees0mijp*xj
2710 gggm(2)=gggm(2)+ees0mijp*yj
2711 gggm(3)=gggm(3)+ees0mijp*zj
2712 C Derivatives due to the contact function
2713 gacont_hbr(1,num_conti,i)=fprimcont*xj
2714 gacont_hbr(2,num_conti,i)=fprimcont*yj
2715 gacont_hbr(3,num_conti,i)=fprimcont*zj
2717 ghalfp=0.5D0*gggp(k)
2718 ghalfm=0.5D0*gggm(k)
2719 gacontp_hb1(k,num_conti,i)=ghalfp
2720 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2721 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2722 gacontp_hb2(k,num_conti,i)=ghalfp
2723 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2724 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2725 gacontp_hb3(k,num_conti,i)=gggp(k)
2726 gacontm_hb1(k,num_conti,i)=ghalfm
2727 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2728 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2729 gacontm_hb2(k,num_conti,i)=ghalfm
2730 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2731 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2732 gacontm_hb3(k,num_conti,i)=gggm(k)
2735 C Diagnostics. Comment out or remove after debugging!
2737 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2738 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2739 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2740 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2741 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2742 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2745 endif ! num_conti.le.maxconts
2750 num_cont_hb(i)=num_conti
2754 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2755 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2757 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2758 ccc eel_loc=eel_loc+eello_turn3
2761 C-----------------------------------------------------------------------------
2762 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2763 C Third- and fourth-order contributions from turns
2764 implicit real*8 (a-h,o-z)
2765 include 'DIMENSIONS'
2766 include 'DIMENSIONS.ZSCOPT'
2767 include 'COMMON.IOUNITS'
2768 include 'COMMON.GEO'
2769 include 'COMMON.VAR'
2770 include 'COMMON.LOCAL'
2771 include 'COMMON.CHAIN'
2772 include 'COMMON.DERIV'
2773 include 'COMMON.INTERACT'
2774 include 'COMMON.CONTACTS'
2775 include 'COMMON.TORSION'
2776 include 'COMMON.VECTORS'
2777 include 'COMMON.FFIELD'
2779 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2780 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2781 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2782 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2783 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2784 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2786 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2787 C changes suggested by Ana to avoid out of bounds
2788 C & .or.((i+5).gt.nres)
2789 C & .or.((i-1).le.0)
2790 C end of changes suggested by Ana
2791 & .or. itype(i+2).eq.ntyp1
2792 & .or. itype(i+3).eq.ntyp1
2793 C & .or. itype(i+5).eq.ntyp1
2794 C & .or. itype(i).eq.ntyp1
2795 C & .or. itype(i-1).eq.ntyp1
2798 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2800 C Third-order contributions
2807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2808 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2809 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2810 call transpose2(auxmat(1,1),auxmat1(1,1))
2811 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2812 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2813 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2814 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2815 cd & ' eello_turn3_num',4*eello_turn3_num
2817 C Derivatives in gamma(i)
2818 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2819 call transpose2(auxmat2(1,1),pizda(1,1))
2820 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2821 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2822 C Derivatives in gamma(i+1)
2823 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2824 call transpose2(auxmat2(1,1),pizda(1,1))
2825 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2826 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2827 & +0.5d0*(pizda(1,1)+pizda(2,2))
2828 C Cartesian derivatives
2830 a_temp(1,1)=aggi(l,1)
2831 a_temp(1,2)=aggi(l,2)
2832 a_temp(2,1)=aggi(l,3)
2833 a_temp(2,2)=aggi(l,4)
2834 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2835 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2836 & +0.5d0*(pizda(1,1)+pizda(2,2))
2837 a_temp(1,1)=aggi1(l,1)
2838 a_temp(1,2)=aggi1(l,2)
2839 a_temp(2,1)=aggi1(l,3)
2840 a_temp(2,2)=aggi1(l,4)
2841 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2842 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2843 & +0.5d0*(pizda(1,1)+pizda(2,2))
2844 a_temp(1,1)=aggj(l,1)
2845 a_temp(1,2)=aggj(l,2)
2846 a_temp(2,1)=aggj(l,3)
2847 a_temp(2,2)=aggj(l,4)
2848 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2849 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2850 & +0.5d0*(pizda(1,1)+pizda(2,2))
2851 a_temp(1,1)=aggj1(l,1)
2852 a_temp(1,2)=aggj1(l,2)
2853 a_temp(2,1)=aggj1(l,3)
2854 a_temp(2,2)=aggj1(l,4)
2855 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2856 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2857 & +0.5d0*(pizda(1,1)+pizda(2,2))
2861 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2862 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2863 C changes suggested by Ana to avoid out of bounds
2864 C & .or.((i+5).gt.nres)
2865 C & .or.((i-1).le.0)
2866 C end of changes suggested by Ana
2867 & .or. itype(i+3).eq.ntyp1
2868 & .or. itype(i+4).eq.ntyp1
2869 C & .or. itype(i+5).eq.ntyp1
2870 & .or. itype(i).eq.ntyp1
2871 C & .or. itype(i-1).eq.ntyp1
2873 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2875 C Fourth-order contributions
2883 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2884 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2885 iti1=itortyp(itype(i+1))
2886 iti2=itortyp(itype(i+2))
2887 iti3=itortyp(itype(i+3))
2888 call transpose2(EUg(1,1,i+1),e1t(1,1))
2889 call transpose2(Eug(1,1,i+2),e2t(1,1))
2890 call transpose2(Eug(1,1,i+3),e3t(1,1))
2891 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2892 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2893 s1=scalar2(b1(1,iti2),auxvec(1))
2894 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2895 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2896 s2=scalar2(b1(1,iti1),auxvec(1))
2897 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2898 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2899 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2900 eello_turn4=eello_turn4-(s1+s2+s3)
2901 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2902 cd & ' eello_turn4_num',8*eello_turn4_num
2903 C Derivatives in gamma(i)
2905 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2906 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2907 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2908 s1=scalar2(b1(1,iti2),auxvec(1))
2909 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2910 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2911 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2912 C Derivatives in gamma(i+1)
2913 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2914 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2915 s2=scalar2(b1(1,iti1),auxvec(1))
2916 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2917 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2918 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2919 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2920 C Derivatives in gamma(i+2)
2921 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2922 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2923 s1=scalar2(b1(1,iti2),auxvec(1))
2924 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2925 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2926 s2=scalar2(b1(1,iti1),auxvec(1))
2927 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2928 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2929 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2930 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2931 C Cartesian derivatives
2932 C Derivatives of this turn contributions in DC(i+2)
2933 if (j.lt.nres-1) then
2935 a_temp(1,1)=agg(l,1)
2936 a_temp(1,2)=agg(l,2)
2937 a_temp(2,1)=agg(l,3)
2938 a_temp(2,2)=agg(l,4)
2939 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2940 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2941 s1=scalar2(b1(1,iti2),auxvec(1))
2942 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2943 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2944 s2=scalar2(b1(1,iti1),auxvec(1))
2945 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2946 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2947 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2949 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2952 C Remaining derivatives of this turn contribution
2954 a_temp(1,1)=aggi(l,1)
2955 a_temp(1,2)=aggi(l,2)
2956 a_temp(2,1)=aggi(l,3)
2957 a_temp(2,2)=aggi(l,4)
2958 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2959 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2960 s1=scalar2(b1(1,iti2),auxvec(1))
2961 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2962 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2963 s2=scalar2(b1(1,iti1),auxvec(1))
2964 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2965 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2966 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2967 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2968 a_temp(1,1)=aggi1(l,1)
2969 a_temp(1,2)=aggi1(l,2)
2970 a_temp(2,1)=aggi1(l,3)
2971 a_temp(2,2)=aggi1(l,4)
2972 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2973 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2974 s1=scalar2(b1(1,iti2),auxvec(1))
2975 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2976 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2977 s2=scalar2(b1(1,iti1),auxvec(1))
2978 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2979 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2980 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2981 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2982 a_temp(1,1)=aggj(l,1)
2983 a_temp(1,2)=aggj(l,2)
2984 a_temp(2,1)=aggj(l,3)
2985 a_temp(2,2)=aggj(l,4)
2986 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2987 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2988 s1=scalar2(b1(1,iti2),auxvec(1))
2989 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2990 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2991 s2=scalar2(b1(1,iti1),auxvec(1))
2992 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2993 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2994 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2995 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2996 a_temp(1,1)=aggj1(l,1)
2997 a_temp(1,2)=aggj1(l,2)
2998 a_temp(2,1)=aggj1(l,3)
2999 a_temp(2,2)=aggj1(l,4)
3000 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3001 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3002 s1=scalar2(b1(1,iti2),auxvec(1))
3003 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3004 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3005 s2=scalar2(b1(1,iti1),auxvec(1))
3006 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3007 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3008 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3009 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3016 C-----------------------------------------------------------------------------
3017 subroutine vecpr(u,v,w)
3018 implicit real*8(a-h,o-z)
3019 dimension u(3),v(3),w(3)
3020 w(1)=u(2)*v(3)-u(3)*v(2)
3021 w(2)=-u(1)*v(3)+u(3)*v(1)
3022 w(3)=u(1)*v(2)-u(2)*v(1)
3025 C-----------------------------------------------------------------------------
3026 subroutine unormderiv(u,ugrad,unorm,ungrad)
3027 C This subroutine computes the derivatives of a normalized vector u, given
3028 C the derivatives computed without normalization conditions, ugrad. Returns
3031 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3032 double precision vec(3)
3033 double precision scalar
3035 c write (2,*) 'ugrad',ugrad
3038 vec(i)=scalar(ugrad(1,i),u(1))
3040 c write (2,*) 'vec',vec
3043 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3046 c write (2,*) 'ungrad',ungrad
3049 C-----------------------------------------------------------------------------
3050 subroutine escp(evdw2,evdw2_14)
3052 C This subroutine calculates the excluded-volume interaction energy between
3053 C peptide-group centers and side chains and its gradient in virtual-bond and
3054 C side-chain vectors.
3056 implicit real*8 (a-h,o-z)
3057 include 'DIMENSIONS'
3058 include 'DIMENSIONS.ZSCOPT'
3059 include 'COMMON.GEO'
3060 include 'COMMON.VAR'
3061 include 'COMMON.LOCAL'
3062 include 'COMMON.CHAIN'
3063 include 'COMMON.DERIV'
3064 include 'COMMON.INTERACT'
3065 include 'COMMON.FFIELD'
3066 include 'COMMON.IOUNITS'
3070 cd print '(a)','Enter ESCP'
3071 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3072 c & ' scal14',scal14
3073 do i=iatscp_s,iatscp_e
3074 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3076 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3077 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3078 if (iteli.eq.0) goto 1225
3079 xi=0.5D0*(c(1,i)+c(1,i+1))
3080 yi=0.5D0*(c(2,i)+c(2,i+1))
3081 zi=0.5D0*(c(3,i)+c(3,i+1))
3082 C Returning the ith atom to box
3084 if (xi.lt.0) xi=xi+boxxsize
3086 if (yi.lt.0) yi=yi+boxysize
3088 if (zi.lt.0) zi=zi+boxzsize
3089 do iint=1,nscp_gr(i)
3091 do j=iscpstart(i,iint),iscpend(i,iint)
3092 itypj=iabs(itype(j))
3093 if (itypj.eq.ntyp1) cycle
3094 C Uncomment following three lines for SC-p interactions
3098 C Uncomment following three lines for Ca-p interactions
3102 C returning the jth atom to box
3104 if (xj.lt.0) xj=xj+boxxsize
3106 if (yj.lt.0) yj=yj+boxysize
3108 if (zj.lt.0) zj=zj+boxzsize
3109 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3114 C Finding the closest jth atom
3118 xj=xj_safe+xshift*boxxsize
3119 yj=yj_safe+yshift*boxysize
3120 zj=zj_safe+zshift*boxzsize
3121 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3122 if(dist_temp.lt.dist_init) then
3132 if (subchap.eq.1) then
3141 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3142 C sss is scaling function for smoothing the cutoff gradient otherwise
3143 C the gradient would not be continuouse
3144 sss=sscale(1.0d0/(dsqrt(rrij)))
3145 if (sss.le.0.0d0) cycle
3146 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3148 e1=fac*fac*aad(itypj,iteli)
3149 e2=fac*bad(itypj,iteli)
3150 if (iabs(j-i) .le. 2) then
3153 evdw2_14=evdw2_14+(e1+e2)*sss
3156 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3157 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3158 c & bad(itypj,iteli)
3159 evdw2=evdw2+evdwij*sss
3162 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3164 fac=-(evdwij+e1)*rrij*sss
3165 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3170 cd write (iout,*) 'j<i'
3171 C Uncomment following three lines for SC-p interactions
3173 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3176 cd write (iout,*) 'j>i'
3179 C Uncomment following line for SC-p interactions
3180 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3184 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3188 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3189 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3192 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3202 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3203 gradx_scp(j,i)=expon*gradx_scp(j,i)
3206 C******************************************************************************
3210 C To save time the factor EXPON has been extracted from ALL components
3211 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3214 C******************************************************************************
3217 C--------------------------------------------------------------------------
3218 subroutine edis(ehpb)
3220 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3222 implicit real*8 (a-h,o-z)
3223 include 'DIMENSIONS'
3224 include 'DIMENSIONS.FREE'
3225 include 'COMMON.SBRIDGE'
3226 include 'COMMON.CHAIN'
3227 include 'COMMON.DERIV'
3228 include 'COMMON.VAR'
3229 include 'COMMON.INTERACT'
3230 include 'COMMON.CONTROL'
3231 include 'COMMON.IOUNITS'
3232 dimension ggg(3),ggg_peak(3,100)
3237 C write (iout,*) ,"link_end",link_end,constr_dist
3238 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3239 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
3240 c & " constr_dist",constr_dist
3241 if (link_end.eq.0.and.link_end_peak.eq.0) return
3242 do i=link_start_peak,link_end_peak
3244 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
3245 c & ipeak(1,i),ipeak(2,i)
3246 do ip=ipeak(1,i),ipeak(2,i)
3251 C iii and jjj point to the residues for which the distance is assigned.
3252 if (ii.gt.nres) then
3259 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
3260 aux=dexp(-scal_peak*aux)
3261 ehpb_peak=ehpb_peak+aux
3262 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
3263 & forcon_peak(ip))*aux/dd
3265 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
3267 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
3268 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
3269 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
3271 c write (iout,*) i,ii,jj,"ehpb_peak",ehpb_peak,
3272 c & " scal_peak",scal_peak
3273 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
3274 do ip=ipeak(1,i),ipeak(2,i)
3277 ggg(j)=ggg_peak(j,iip)/ehpb_peak
3281 C iii and jjj point to the residues for which the distance is assigned.
3282 if (ii.gt.nres) then
3291 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3292 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3296 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3297 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3301 do i=link_start,link_end
3302 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3303 C CA-CA distance used in regularization of structure.
3306 C iii and jjj point to the residues for which the distance is assigned.
3307 if (ii.gt.nres) then
3314 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3315 c & dhpb(i),dhpb1(i),forcon(i)
3316 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3317 C distance and angle dependent SS bond potential.
3318 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3319 C & iabs(itype(jjj)).eq.1) then
3320 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3321 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3322 if (.not.dyn_ss .and. i.le.nss) then
3323 C 15/02/13 CC dynamic SSbond - additional check
3324 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3325 & iabs(itype(jjj)).eq.1) then
3326 call ssbond_ene(iii,jjj,eij)
3329 cd write (iout,*) "eij",eij
3330 cd & ' waga=',waga,' fac=',fac
3331 ! else if (ii.gt.nres .and. jj.gt.nres) then
3333 C Calculate the distance between the two points and its difference from the
3336 if (irestr_type(i).eq.11) then
3337 ehpb=ehpb+fordepth(i)!**4.0d0
3338 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3339 fac=fordepth(i)!**4.0d0
3340 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3341 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
3342 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3343 c & ehpb,irestr_type(i)
3344 else if (irestr_type(i).eq.10) then
3345 c AL 6//19/2018 cross-link restraints
3346 xdis = 0.5d0*(dd/forcon(i))**2
3347 expdis = dexp(-xdis)
3348 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
3349 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
3350 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
3351 c & " wboltzd",wboltzd
3352 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
3353 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
3354 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
3355 & *expdis/(aux*forcon(i)**2)
3356 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
3357 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3358 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
3359 else if (irestr_type(i).eq.2) then
3360 c Quartic restraints
3361 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3362 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3363 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3364 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
3365 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3367 c Quadratic restraints
3369 C Get the force constant corresponding to this distance.
3371 C Calculate the contribution to energy.
3372 ehpb=ehpb+0.5d0*waga*rdis*rdis
3373 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3374 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3375 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
3377 C Evaluate gradient.
3381 c Calculate Cartesian gradient
3383 ggg(j)=fac*(c(j,jj)-c(j,ii))
3385 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3386 C If this is a SC-SC distance, we need to calculate the contributions to the
3387 C Cartesian gradient in the SC vectors (ghpbx).
3390 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3391 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3395 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3396 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3402 C--------------------------------------------------------------------------
3403 subroutine ssbond_ene(i,j,eij)
3405 C Calculate the distance and angle dependent SS-bond potential energy
3406 C using a free-energy function derived based on RHF/6-31G** ab initio
3407 C calculations of diethyl disulfide.
3409 C A. Liwo and U. Kozlowska, 11/24/03
3411 implicit real*8 (a-h,o-z)
3412 include 'DIMENSIONS'
3413 include 'DIMENSIONS.ZSCOPT'
3414 include 'COMMON.SBRIDGE'
3415 include 'COMMON.CHAIN'
3416 include 'COMMON.DERIV'
3417 include 'COMMON.LOCAL'
3418 include 'COMMON.INTERACT'
3419 include 'COMMON.VAR'
3420 include 'COMMON.IOUNITS'
3421 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3422 itypi=iabs(itype(i))
3426 dxi=dc_norm(1,nres+i)
3427 dyi=dc_norm(2,nres+i)
3428 dzi=dc_norm(3,nres+i)
3429 dsci_inv=dsc_inv(itypi)
3430 itypj=iabs(itype(j))
3431 dscj_inv=dsc_inv(itypj)
3435 dxj=dc_norm(1,nres+j)
3436 dyj=dc_norm(2,nres+j)
3437 dzj=dc_norm(3,nres+j)
3438 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3443 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3444 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3445 om12=dxi*dxj+dyi*dyj+dzi*dzj
3447 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3448 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3454 deltat12=om2-om1+2.0d0
3456 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3457 & +akct*deltad*deltat12
3458 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3459 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3460 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3461 c & " deltat12",deltat12," eij",eij
3462 ed=2*akcm*deltad+akct*deltat12
3464 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3465 eom1=-2*akth*deltat1-pom1-om2*pom2
3466 eom2= 2*akth*deltat2+pom1-om1*pom2
3469 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3472 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3473 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3474 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3475 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3478 C Calculate the components of the gradient in DC and X
3482 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3487 C--------------------------------------------------------------------------
3488 c MODELLER restraint function
3489 subroutine e_modeller(ehomology_constr)
3490 implicit real*8 (a-h,o-z)
3491 include 'DIMENSIONS'
3492 include 'DIMENSIONS.ZSCOPT'
3493 include 'DIMENSIONS.FREE'
3494 integer nnn, i, j, k, ki, irec, l
3495 integer katy, odleglosci, test7
3496 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3497 real*8 distance(max_template),distancek(max_template),
3498 & min_odl,godl(max_template),dih_diff(max_template)
3501 c FP - 30/10/2014 Temporary specifications for homology restraints
3503 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3505 double precision, dimension (maxres) :: guscdiff,usc_diff
3506 double precision, dimension (max_template) ::
3507 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3510 include 'COMMON.SBRIDGE'
3511 include 'COMMON.CHAIN'
3512 include 'COMMON.GEO'
3513 include 'COMMON.DERIV'
3514 include 'COMMON.LOCAL'
3515 include 'COMMON.INTERACT'
3516 include 'COMMON.VAR'
3517 include 'COMMON.IOUNITS'
3518 include 'COMMON.CONTROL'
3519 include 'COMMON.HOMRESTR'
3521 include 'COMMON.SETUP'
3522 include 'COMMON.NAMES'
3525 distancek(i)=9999999.9
3530 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3532 C AL 5/2/14 - Introduce list of restraints
3533 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3535 write(iout,*) "------- dist restrs start -------"
3537 do ii = link_start_homo,link_end_homo
3541 c write (iout,*) "dij(",i,j,") =",dij
3543 do k=1,constr_homology
3544 if(.not.l_homo(k,ii)) then
3548 distance(k)=odl(k,ii)-dij
3549 c write (iout,*) "distance(",k,") =",distance(k)
3551 c For Gaussian-type Urestr
3553 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3554 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3555 c write (iout,*) "distancek(",k,") =",distancek(k)
3556 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3558 c For Lorentzian-type Urestr
3560 if (waga_dist.lt.0.0d0) then
3561 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3562 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3563 & (distance(k)**2+sigma_odlir(k,ii)**2))
3567 c min_odl=minval(distancek)
3568 do kk=1,constr_homology
3569 if(l_homo(kk,ii)) then
3570 min_odl=distancek(kk)
3574 do kk=1,constr_homology
3575 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3576 & min_odl=distancek(kk)
3578 c write (iout,* )"min_odl",min_odl
3580 write (iout,*) "ij dij",i,j,dij
3581 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3582 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3583 write (iout,* )"min_odl",min_odl
3588 if (waga_dist.ge.0.0d0) then
3594 do k=1,constr_homology
3595 c Nie wiem po co to liczycie jeszcze raz!
3596 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3597 c & (2*(sigma_odl(i,j,k))**2))
3598 if(.not.l_homo(k,ii)) cycle
3599 if (waga_dist.ge.0.0d0) then
3601 c For Gaussian-type Urestr
3603 godl(k)=dexp(-distancek(k)+min_odl)
3604 odleg2=odleg2+godl(k)
3606 c For Lorentzian-type Urestr
3609 odleg2=odleg2+distancek(k)
3612 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3613 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3614 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3615 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3618 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3619 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3621 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3622 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3624 if (waga_dist.ge.0.0d0) then
3626 c For Gaussian-type Urestr
3628 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3630 c For Lorentzian-type Urestr
3633 odleg=odleg+odleg2/constr_homology
3637 c write (iout,*) "odleg",odleg ! sum of -ln-s
3640 c For Gaussian-type Urestr
3642 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3644 do k=1,constr_homology
3645 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3646 c & *waga_dist)+min_odl
3647 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3649 if(.not.l_homo(k,ii)) cycle
3650 if (waga_dist.ge.0.0d0) then
3651 c For Gaussian-type Urestr
3653 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3655 c For Lorentzian-type Urestr
3658 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3659 & sigma_odlir(k,ii)**2)**2)
3661 sum_sgodl=sum_sgodl+sgodl
3663 c sgodl2=sgodl2+sgodl
3664 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3665 c write(iout,*) "constr_homology=",constr_homology
3666 c write(iout,*) i, j, k, "TEST K"
3668 if (waga_dist.ge.0.0d0) then
3670 c For Gaussian-type Urestr
3672 grad_odl3=waga_homology(iset)*waga_dist
3673 & *sum_sgodl/(sum_godl*dij)
3675 c For Lorentzian-type Urestr
3678 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3679 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3680 grad_odl3=-waga_homology(iset)*waga_dist*
3681 & sum_sgodl/(constr_homology*dij)
3684 c grad_odl3=sum_sgodl/(sum_godl*dij)
3687 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3688 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3689 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3691 ccc write(iout,*) godl, sgodl, grad_odl3
3693 c grad_odl=grad_odl+grad_odl3
3696 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3697 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3698 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3699 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3700 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3701 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3702 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3703 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3704 c if (i.eq.25.and.j.eq.27) then
3705 c write(iout,*) "jik",jik,"i",i,"j",j
3706 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3707 c write(iout,*) "grad_odl3",grad_odl3
3708 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3709 c write(iout,*) "ggodl",ggodl
3710 c write(iout,*) "ghpbc(",jik,i,")",
3711 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3716 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3717 ccc & dLOG(odleg2),"-odleg=", -odleg
3719 enddo ! ii-loop for dist
3721 write(iout,*) "------- dist restrs end -------"
3722 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3723 c & waga_d.eq.1.0d0) call sum_gradient
3725 c Pseudo-energy and gradient from dihedral-angle restraints from
3726 c homology templates
3727 c write (iout,*) "End of distance loop"
3730 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3732 write(iout,*) "------- dih restrs start -------"
3733 do i=idihconstr_start_homo,idihconstr_end_homo
3734 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3737 do i=idihconstr_start_homo,idihconstr_end_homo
3739 c betai=beta(i,i+1,i+2,i+3)
3741 c write (iout,*) "betai =",betai
3742 do k=1,constr_homology
3743 dih_diff(k)=pinorm(dih(k,i)-betai)
3744 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3745 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3746 c & -(6.28318-dih_diff(i,k))
3747 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3748 c & 6.28318+dih_diff(i,k)
3750 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3752 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3754 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3757 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3760 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3761 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3763 write (iout,*) "i",i," betai",betai," kat2",kat2
3764 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3766 if (kat2.le.1.0d-14) cycle
3767 kat=kat-dLOG(kat2/constr_homology)
3768 c write (iout,*) "kat",kat ! sum of -ln-s
3770 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3771 ccc & dLOG(kat2), "-kat=", -kat
3774 c ----------------------------------------------------------------------
3776 c ----------------------------------------------------------------------
3780 do k=1,constr_homology
3782 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3784 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3786 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3787 sum_sgdih=sum_sgdih+sgdih
3789 c grad_dih3=sum_sgdih/sum_gdih
3790 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3792 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3793 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3794 ccc & gloc(nphi+i-3,icg)
3795 gloc(i,icg)=gloc(i,icg)+grad_dih3
3797 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3799 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3800 ccc & gloc(nphi+i-3,icg)
3802 enddo ! i-loop for dih
3804 write(iout,*) "------- dih restrs end -------"
3807 c Pseudo-energy and gradient for theta angle restraints from
3808 c homology templates
3809 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3813 c For constr_homology reference structures (FP)
3815 c Uconst_back_tot=0.0d0
3818 c Econstr_back legacy
3821 c do i=ithet_start,ithet_end
3824 c do i=loc_start,loc_end
3827 duscdiffx(j,i)=0.0d0
3833 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3834 c write (iout,*) "waga_theta",waga_theta
3835 if (waga_theta.gt.0.0d0) then
3837 write (iout,*) "usampl",usampl
3838 write(iout,*) "------- theta restrs start -------"
3839 c do i=ithet_start,ithet_end
3840 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3843 c write (iout,*) "maxres",maxres,"nres",nres
3845 do i=ithet_start,ithet_end
3848 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3850 c Deviation of theta angles wrt constr_homology ref structures
3852 utheta_i=0.0d0 ! argument of Gaussian for single k
3853 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3854 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3855 c over residues in a fragment
3856 c write (iout,*) "theta(",i,")=",theta(i)
3857 do k=1,constr_homology
3859 c dtheta_i=theta(j)-thetaref(j,iref)
3860 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3861 theta_diff(k)=thetatpl(k,i)-theta(i)
3863 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3864 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3865 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3866 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3867 c Gradient for single Gaussian restraint in subr Econstr_back
3868 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3871 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3872 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3876 c Gradient for multiple Gaussian restraint
3877 sum_gtheta=gutheta_i
3879 do k=1,constr_homology
3880 c New generalized expr for multiple Gaussian from Econstr_back
3881 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3883 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3884 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3887 c Final value of gradient using same var as in Econstr_back
3888 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3889 & *waga_homology(iset)
3890 c dutheta(i)=sum_sgtheta/sum_gtheta
3892 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3894 Eval=Eval-dLOG(gutheta_i/constr_homology)
3895 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3896 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3897 c Uconst_back=Uconst_back+utheta(i)
3898 enddo ! (i-loop for theta)
3900 write(iout,*) "------- theta restrs end -------"
3904 c Deviation of local SC geometry
3906 c Separation of two i-loops (instructed by AL - 11/3/2014)
3908 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3909 c write (iout,*) "waga_d",waga_d
3912 write(iout,*) "------- SC restrs start -------"
3913 write (iout,*) "Initial duscdiff,duscdiffx"
3914 do i=loc_start,loc_end
3915 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3916 & (duscdiffx(jik,i),jik=1,3)
3919 do i=loc_start,loc_end
3920 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3921 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3922 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3923 c write(iout,*) "xxtab, yytab, zztab"
3924 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3925 do k=1,constr_homology
3927 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3928 c Original sign inverted for calc of gradients (s. Econstr_back)
3929 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3930 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3931 c write(iout,*) "dxx, dyy, dzz"
3932 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3934 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3935 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3936 c uscdiffk(k)=usc_diff(i)
3937 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3938 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3939 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3940 c & xxref(j),yyref(j),zzref(j)
3945 c Generalized expression for multiple Gaussian acc to that for a single
3946 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3948 c Original implementation
3949 c sum_guscdiff=guscdiff(i)
3951 c sum_sguscdiff=0.0d0
3952 c do k=1,constr_homology
3953 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3954 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3955 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3958 c Implementation of new expressions for gradient (Jan. 2015)
3960 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3962 do k=1,constr_homology
3964 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3965 c before. Now the drivatives should be correct
3967 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3968 c Original sign inverted for calc of gradients (s. Econstr_back)
3969 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3970 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3972 c New implementation
3974 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3975 & sigma_d(k,i) ! for the grad wrt r'
3976 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3979 c New implementation
3980 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3982 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3983 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3984 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3985 duscdiff(jik,i)=duscdiff(jik,i)+
3986 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3987 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3988 duscdiffx(jik,i)=duscdiffx(jik,i)+
3989 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3990 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3993 write(iout,*) "jik",jik,"i",i
3994 write(iout,*) "dxx, dyy, dzz"
3995 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3996 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3997 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3998 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3999 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4000 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4001 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4002 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4003 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4004 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4005 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4006 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4007 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4008 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4009 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4016 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4017 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4019 c write (iout,*) i," uscdiff",uscdiff(i)
4021 c Put together deviations from local geometry
4023 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4024 c & wfrag_back(3,i,iset)*uscdiff(i)
4025 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4026 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4027 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4028 c Uconst_back=Uconst_back+usc_diff(i)
4030 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4032 c New implment: multiplied by sum_sguscdiff
4035 enddo ! (i-loop for dscdiff)
4040 write(iout,*) "------- SC restrs end -------"
4041 write (iout,*) "------ After SC loop in e_modeller ------"
4042 do i=loc_start,loc_end
4043 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4044 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4046 if (waga_theta.eq.1.0d0) then
4047 write (iout,*) "in e_modeller after SC restr end: dutheta"
4048 do i=ithet_start,ithet_end
4049 write (iout,*) i,dutheta(i)
4052 if (waga_d.eq.1.0d0) then
4053 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4055 write (iout,*) i,(duscdiff(j,i),j=1,3)
4056 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4061 c Total energy from homology restraints
4063 write (iout,*) "odleg",odleg," kat",kat
4064 write (iout,*) "odleg",odleg," kat",kat
4065 write (iout,*) "Eval",Eval," Erot",Erot
4066 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4067 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4068 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4071 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4073 c ehomology_constr=odleg+kat
4075 c For Lorentzian-type Urestr
4078 if (waga_dist.ge.0.0d0) then
4080 c For Gaussian-type Urestr
4082 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4083 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4084 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4085 & waga_theta*Eval+waga_d*Erot
4086 c write (iout,*) "ehomology_constr=",ehomology_constr
4089 c For Lorentzian-type Urestr
4091 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4092 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4093 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4094 & waga_theta*Eval+waga_d*Erot
4095 c write (iout,*) "ehomology_constr=",ehomology_constr
4098 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4099 & "Eval",waga_theta,eval,
4100 & "Erot",waga_d,Erot
4101 write (iout,*) "ehomology_constr",ehomology_constr
4105 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4106 747 format(a12,i4,i4,i4,f8.3,f8.3)
4107 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4108 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4109 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4110 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4112 c-----------------------------------------------------------------------
4113 subroutine ebond(estr)
4115 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4117 implicit real*8 (a-h,o-z)
4118 include 'DIMENSIONS'
4119 include 'DIMENSIONS.ZSCOPT'
4120 include 'DIMENSIONS.FREE'
4121 include 'COMMON.LOCAL'
4122 include 'COMMON.GEO'
4123 include 'COMMON.INTERACT'
4124 include 'COMMON.DERIV'
4125 include 'COMMON.VAR'
4126 include 'COMMON.CHAIN'
4127 include 'COMMON.IOUNITS'
4128 include 'COMMON.NAMES'
4129 include 'COMMON.FFIELD'
4130 include 'COMMON.CONTROL'
4131 double precision u(3),ud(3)
4133 C write (iout,*) "distchainmax",distchainmax
4135 c write (iout,*) "distchainmax",distchainmax
4137 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4138 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4140 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4141 C & *dc(j,i-1)/vbld(i)
4143 C if (energy_dec) write(iout,*)
4144 C & "estr1",i,vbld(i),distchainmax,
4145 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4147 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4148 diff = vbld(i)-vbldpDUM
4149 C write(iout,*) i,diff
4151 diff = vbld(i)-vbldp0
4152 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4156 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4159 C write (iout,'(a7,i5,4f7.3)')
4160 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4162 estr=0.5d0*AKP*estr+estr1
4164 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4168 if (iti.ne.10 .and. iti.ne.ntyp1) then
4171 diff=vbld(i+nres)-vbldsc0(1,iti)
4172 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4173 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4174 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4176 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4180 diff=vbld(i+nres)-vbldsc0(j,iti)
4181 ud(j)=aksc(j,iti)*diff
4182 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4196 uprod2=uprod2*u(k)*u(k)
4200 usumsqder=usumsqder+ud(j)*uprod2
4202 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4203 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4204 estr=estr+uprod/usum
4206 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4214 C--------------------------------------------------------------------------
4215 subroutine ebend(etheta)
4217 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4218 C angles gamma and its derivatives in consecutive thetas and gammas.
4220 implicit real*8 (a-h,o-z)
4221 include 'DIMENSIONS'
4222 include 'DIMENSIONS.ZSCOPT'
4223 include 'COMMON.LOCAL'
4224 include 'COMMON.GEO'
4225 include 'COMMON.INTERACT'
4226 include 'COMMON.DERIV'
4227 include 'COMMON.VAR'
4228 include 'COMMON.CHAIN'
4229 include 'COMMON.IOUNITS'
4230 include 'COMMON.NAMES'
4231 include 'COMMON.FFIELD'
4232 common /calcthet/ term1,term2,termm,diffak,ratak,
4233 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4234 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4235 double precision y(2),z(2)
4237 time11=dexp(-2*time)
4240 c write (iout,*) "nres",nres
4241 c write (*,'(a,i2)') 'EBEND ICG=',icg
4242 c write (iout,*) ithet_start,ithet_end
4243 do i=ithet_start,ithet_end
4244 C if (itype(i-1).eq.ntyp1) cycle
4246 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4247 & .or.itype(i).eq.ntyp1) cycle
4248 C Zero the energy function and its derivative at 0 or pi.
4249 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4251 ichir1=isign(1,itype(i-2))
4252 ichir2=isign(1,itype(i))
4253 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4254 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4255 if (itype(i-1).eq.10) then
4256 itype1=isign(10,itype(i-2))
4257 ichir11=isign(1,itype(i-2))
4258 ichir12=isign(1,itype(i-2))
4259 itype2=isign(10,itype(i))
4260 ichir21=isign(1,itype(i))
4261 ichir22=isign(1,itype(i))
4268 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4272 c call proc_proc(phii,icrc)
4273 if (icrc.eq.1) phii=150.0
4284 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4288 c call proc_proc(phii1,icrc)
4289 if (icrc.eq.1) phii1=150.0
4301 C Calculate the "mean" value of theta from the part of the distribution
4302 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4303 C In following comments this theta will be referred to as t_c.
4304 thet_pred_mean=0.0d0
4306 athetk=athet(k,it,ichir1,ichir2)
4307 bthetk=bthet(k,it,ichir1,ichir2)
4309 athetk=athet(k,itype1,ichir11,ichir12)
4310 bthetk=bthet(k,itype2,ichir21,ichir22)
4312 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4314 c write (iout,*) "thet_pred_mean",thet_pred_mean
4315 dthett=thet_pred_mean*ssd
4316 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4317 c write (iout,*) "thet_pred_mean",thet_pred_mean
4318 C Derivatives of the "mean" values in gamma1 and gamma2.
4319 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4320 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4321 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4322 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4324 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4325 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4326 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4327 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4329 if (theta(i).gt.pi-delta) then
4330 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4332 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4333 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4334 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4336 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4338 else if (theta(i).lt.delta) then
4339 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4340 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4341 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4343 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4344 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4347 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4350 etheta=etheta+ethetai
4351 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4352 c & 'ebend',i,ethetai,theta(i),itype(i)
4353 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4354 c & rad2deg*phii,rad2deg*phii1,ethetai
4355 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4356 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4357 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4361 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4362 do i=1,ntheta_constr
4363 itheta=itheta_constr(i)
4364 thetiii=theta(itheta)
4365 difi=pinorm(thetiii-theta_constr0(i))
4366 if (difi.gt.theta_drange(i)) then
4367 difi=difi-theta_drange(i)
4368 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4369 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4370 & +for_thet_constr(i)*difi**3
4371 else if (difi.lt.-drange(i)) then
4373 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4374 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4375 & +for_thet_constr(i)*difi**3
4379 C if (energy_dec) then
4380 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4381 C & i,itheta,rad2deg*thetiii,
4382 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4383 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4384 C & gloc(itheta+nphi-2,icg)
4387 C Ufff.... We've done all this!!!
4390 C---------------------------------------------------------------------------
4391 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4393 implicit real*8 (a-h,o-z)
4394 include 'DIMENSIONS'
4395 include 'COMMON.LOCAL'
4396 include 'COMMON.IOUNITS'
4397 common /calcthet/ term1,term2,termm,diffak,ratak,
4398 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4399 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4400 C Calculate the contributions to both Gaussian lobes.
4401 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4402 C The "polynomial part" of the "standard deviation" of this part of
4406 sig=sig*thet_pred_mean+polthet(j,it)
4408 C Derivative of the "interior part" of the "standard deviation of the"
4409 C gamma-dependent Gaussian lobe in t_c.
4410 sigtc=3*polthet(3,it)
4412 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4415 C Set the parameters of both Gaussian lobes of the distribution.
4416 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4417 fac=sig*sig+sigc0(it)
4420 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4421 sigsqtc=-4.0D0*sigcsq*sigtc
4422 c print *,i,sig,sigtc,sigsqtc
4423 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4424 sigtc=-sigtc/(fac*fac)
4425 C Following variable is sigma(t_c)**(-2)
4426 sigcsq=sigcsq*sigcsq
4428 sig0inv=1.0D0/sig0i**2
4429 delthec=thetai-thet_pred_mean
4430 delthe0=thetai-theta0i
4431 term1=-0.5D0*sigcsq*delthec*delthec
4432 term2=-0.5D0*sig0inv*delthe0*delthe0
4433 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4434 C NaNs in taking the logarithm. We extract the largest exponent which is added
4435 C to the energy (this being the log of the distribution) at the end of energy
4436 C term evaluation for this virtual-bond angle.
4437 if (term1.gt.term2) then
4439 term2=dexp(term2-termm)
4443 term1=dexp(term1-termm)
4446 C The ratio between the gamma-independent and gamma-dependent lobes of
4447 C the distribution is a Gaussian function of thet_pred_mean too.
4448 diffak=gthet(2,it)-thet_pred_mean
4449 ratak=diffak/gthet(3,it)**2
4450 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4451 C Let's differentiate it in thet_pred_mean NOW.
4453 C Now put together the distribution terms to make complete distribution.
4454 termexp=term1+ak*term2
4455 termpre=sigc+ak*sig0i
4456 C Contribution of the bending energy from this theta is just the -log of
4457 C the sum of the contributions from the two lobes and the pre-exponential
4458 C factor. Simple enough, isn't it?
4459 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4460 C NOW the derivatives!!!
4461 C 6/6/97 Take into account the deformation.
4462 E_theta=(delthec*sigcsq*term1
4463 & +ak*delthe0*sig0inv*term2)/termexp
4464 E_tc=((sigtc+aktc*sig0i)/termpre
4465 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4466 & aktc*term2)/termexp)
4469 c-----------------------------------------------------------------------------
4470 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4471 implicit real*8 (a-h,o-z)
4472 include 'DIMENSIONS'
4473 include 'COMMON.LOCAL'
4474 include 'COMMON.IOUNITS'
4475 common /calcthet/ term1,term2,termm,diffak,ratak,
4476 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4477 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4478 delthec=thetai-thet_pred_mean
4479 delthe0=thetai-theta0i
4480 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4481 t3 = thetai-thet_pred_mean
4485 t14 = t12+t6*sigsqtc
4487 t21 = thetai-theta0i
4493 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4494 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4495 & *(-t12*t9-ak*sig0inv*t27)
4499 C--------------------------------------------------------------------------
4500 subroutine ebend(etheta)
4502 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4503 C angles gamma and its derivatives in consecutive thetas and gammas.
4504 C ab initio-derived potentials from
4505 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4507 implicit real*8 (a-h,o-z)
4508 include 'DIMENSIONS'
4509 include 'DIMENSIONS.ZSCOPT'
4510 include 'DIMENSIONS.FREE'
4511 include 'COMMON.LOCAL'
4512 include 'COMMON.GEO'
4513 include 'COMMON.INTERACT'
4514 include 'COMMON.DERIV'
4515 include 'COMMON.VAR'
4516 include 'COMMON.CHAIN'
4517 include 'COMMON.IOUNITS'
4518 include 'COMMON.NAMES'
4519 include 'COMMON.FFIELD'
4520 include 'COMMON.CONTROL'
4521 include 'COMMON.TORCNSTR'
4522 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4523 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4524 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4525 & sinph1ph2(maxdouble,maxdouble)
4526 logical lprn /.false./, lprn1 /.false./
4528 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4529 do i=ithet_start,ithet_end
4531 c print *,i,itype(i-1),itype(i),itype(i-2)
4532 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4533 & .or.(itype(i).eq.ntyp1)) cycle
4534 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4536 if (iabs(itype(i+1)).eq.20) iblock=2
4537 if (iabs(itype(i+1)).ne.20) iblock=1
4541 theti2=0.5d0*theta(i)
4542 ityp2=ithetyp((itype(i-1)))
4544 coskt(k)=dcos(k*theti2)
4545 sinkt(k)=dsin(k*theti2)
4547 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4550 if (phii.ne.phii) phii=150.0
4554 ityp1=ithetyp((itype(i-2)))
4556 cosph1(k)=dcos(k*phii)
4557 sinph1(k)=dsin(k*phii)
4561 ityp1=ithetyp(itype(i-2))
4567 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4570 if (phii1.ne.phii1) phii1=150.0
4575 ityp3=ithetyp((itype(i)))
4577 cosph2(k)=dcos(k*phii1)
4578 sinph2(k)=dsin(k*phii1)
4582 ityp3=ithetyp(itype(i))
4588 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4589 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4591 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4594 ccl=cosph1(l)*cosph2(k-l)
4595 ssl=sinph1(l)*sinph2(k-l)
4596 scl=sinph1(l)*cosph2(k-l)
4597 csl=cosph1(l)*sinph2(k-l)
4598 cosph1ph2(l,k)=ccl-ssl
4599 cosph1ph2(k,l)=ccl+ssl
4600 sinph1ph2(l,k)=scl+csl
4601 sinph1ph2(k,l)=scl-csl
4605 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4606 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4607 write (iout,*) "coskt and sinkt"
4609 write (iout,*) k,coskt(k),sinkt(k)
4613 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4614 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4617 & write (iout,*) "k",k,"
4618 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4619 & " ethetai",ethetai
4622 write (iout,*) "cosph and sinph"
4624 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4626 write (iout,*) "cosph1ph2 and sinph2ph2"
4629 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4630 & sinph1ph2(l,k),sinph1ph2(k,l)
4633 write(iout,*) "ethetai",ethetai
4637 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4638 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4639 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4640 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4641 ethetai=ethetai+sinkt(m)*aux
4642 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4643 dephii=dephii+k*sinkt(m)*(
4644 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4645 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4646 dephii1=dephii1+k*sinkt(m)*(
4647 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4648 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4650 & write (iout,*) "m",m," k",k," bbthet",
4651 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4652 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4653 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4654 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4658 & write(iout,*) "ethetai",ethetai
4662 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4663 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4664 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4665 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4666 ethetai=ethetai+sinkt(m)*aux
4667 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4668 dephii=dephii+l*sinkt(m)*(
4669 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4670 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4671 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4672 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4673 dephii1=dephii1+(k-l)*sinkt(m)*(
4674 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4675 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4676 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4677 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4679 write (iout,*) "m",m," k",k," l",l," ffthet",
4680 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4681 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4682 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4683 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4684 & " ethetai",ethetai
4685 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4686 & cosph1ph2(k,l)*sinkt(m),
4687 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4693 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4694 & i,theta(i)*rad2deg,phii*rad2deg,
4695 & phii1*rad2deg,ethetai
4696 etheta=etheta+ethetai
4697 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4698 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4699 c gloc(nphi+i-2,icg)=wang*dethetai
4700 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4704 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4705 do i=1,ntheta_constr
4706 itheta=itheta_constr(i)
4707 thetiii=theta(itheta)
4708 difi=pinorm(thetiii-theta_constr0(i))
4709 if (difi.gt.theta_drange(i)) then
4710 difi=difi-theta_drange(i)
4711 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4712 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4713 & +for_thet_constr(i)*difi**3
4714 else if (difi.lt.-drange(i)) then
4716 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4717 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4718 & +for_thet_constr(i)*difi**3
4722 C if (energy_dec) then
4723 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4724 C & i,itheta,rad2deg*thetiii,
4725 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4726 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4727 C & gloc(itheta+nphi-2,icg)
4735 c-----------------------------------------------------------------------------
4736 subroutine esc(escloc)
4737 C Calculate the local energy of a side chain and its derivatives in the
4738 C corresponding virtual-bond valence angles THETA and the spherical angles
4740 implicit real*8 (a-h,o-z)
4741 include 'DIMENSIONS'
4742 include 'DIMENSIONS.ZSCOPT'
4743 include 'COMMON.GEO'
4744 include 'COMMON.LOCAL'
4745 include 'COMMON.VAR'
4746 include 'COMMON.INTERACT'
4747 include 'COMMON.DERIV'
4748 include 'COMMON.CHAIN'
4749 include 'COMMON.IOUNITS'
4750 include 'COMMON.NAMES'
4751 include 'COMMON.FFIELD'
4752 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4753 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4754 common /sccalc/ time11,time12,time112,theti,it,nlobit
4757 C write (iout,*) 'ESC'
4758 do i=loc_start,loc_end
4760 if (it.eq.ntyp1) cycle
4761 if (it.eq.10) goto 1
4762 nlobit=nlob(iabs(it))
4763 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4764 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4765 theti=theta(i+1)-pipol
4769 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4771 if (x(2).gt.pi-delta) then
4775 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4777 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4778 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4780 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4781 & ddersc0(1),dersc(1))
4782 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4783 & ddersc0(3),dersc(3))
4785 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4787 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4788 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4789 & dersc0(2),esclocbi,dersc02)
4790 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4792 call splinthet(x(2),0.5d0*delta,ss,ssd)
4797 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4799 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4800 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4802 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4804 c write (iout,*) escloci
4805 else if (x(2).lt.delta) then
4809 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4811 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4812 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4814 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4815 & ddersc0(1),dersc(1))
4816 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4817 & ddersc0(3),dersc(3))
4819 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4821 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4822 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4823 & dersc0(2),esclocbi,dersc02)
4824 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4829 call splinthet(x(2),0.5d0*delta,ss,ssd)
4831 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4833 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4834 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4836 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4837 C write (iout,*) 'i=',i, escloci
4839 call enesc(x,escloci,dersc,ddummy,.false.)
4842 escloc=escloc+escloci
4843 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4844 write (iout,'(a6,i5,0pf7.3)')
4845 & 'escloc',i,escloci
4847 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4849 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4850 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4855 C---------------------------------------------------------------------------
4856 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4857 implicit real*8 (a-h,o-z)
4858 include 'DIMENSIONS'
4859 include 'COMMON.GEO'
4860 include 'COMMON.LOCAL'
4861 include 'COMMON.IOUNITS'
4862 common /sccalc/ time11,time12,time112,theti,it,nlobit
4863 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4864 double precision contr(maxlob,-1:1)
4866 c write (iout,*) 'it=',it,' nlobit=',nlobit
4870 if (mixed) ddersc(j)=0.0d0
4874 C Because of periodicity of the dependence of the SC energy in omega we have
4875 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4876 C To avoid underflows, first compute & store the exponents.
4884 z(k)=x(k)-censc(k,j,it)
4889 Axk=Axk+gaussc(l,k,j,it)*z(l)
4895 expfac=expfac+Ax(k,j,iii)*z(k)
4903 C As in the case of ebend, we want to avoid underflows in exponentiation and
4904 C subsequent NaNs and INFs in energy calculation.
4905 C Find the largest exponent
4909 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4913 cd print *,'it=',it,' emin=',emin
4915 C Compute the contribution to SC energy and derivatives
4919 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4920 cd print *,'j=',j,' expfac=',expfac
4921 escloc_i=escloc_i+expfac
4923 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4927 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4928 & +gaussc(k,2,j,it))*expfac
4935 dersc(1)=dersc(1)/cos(theti)**2
4936 ddersc(1)=ddersc(1)/cos(theti)**2
4939 escloci=-(dlog(escloc_i)-emin)
4941 dersc(j)=dersc(j)/escloc_i
4945 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4950 C------------------------------------------------------------------------------
4951 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4952 implicit real*8 (a-h,o-z)
4953 include 'DIMENSIONS'
4954 include 'COMMON.GEO'
4955 include 'COMMON.LOCAL'
4956 include 'COMMON.IOUNITS'
4957 common /sccalc/ time11,time12,time112,theti,it,nlobit
4958 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4959 double precision contr(maxlob)
4970 z(k)=x(k)-censc(k,j,it)
4976 Axk=Axk+gaussc(l,k,j,it)*z(l)
4982 expfac=expfac+Ax(k,j)*z(k)
4987 C As in the case of ebend, we want to avoid underflows in exponentiation and
4988 C subsequent NaNs and INFs in energy calculation.
4989 C Find the largest exponent
4992 if (emin.gt.contr(j)) emin=contr(j)
4996 C Compute the contribution to SC energy and derivatives
5000 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5001 escloc_i=escloc_i+expfac
5003 dersc(k)=dersc(k)+Ax(k,j)*expfac
5005 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5006 & +gaussc(1,2,j,it))*expfac
5010 dersc(1)=dersc(1)/cos(theti)**2
5011 dersc12=dersc12/cos(theti)**2
5012 escloci=-(dlog(escloc_i)-emin)
5014 dersc(j)=dersc(j)/escloc_i
5016 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5020 c----------------------------------------------------------------------------------
5021 subroutine esc(escloc)
5022 C Calculate the local energy of a side chain and its derivatives in the
5023 C corresponding virtual-bond valence angles THETA and the spherical angles
5024 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5025 C added by Urszula Kozlowska. 07/11/2007
5027 implicit real*8 (a-h,o-z)
5028 include 'DIMENSIONS'
5029 include 'DIMENSIONS.ZSCOPT'
5030 include 'DIMENSIONS.FREE'
5031 include 'COMMON.GEO'
5032 include 'COMMON.LOCAL'
5033 include 'COMMON.VAR'
5034 include 'COMMON.SCROT'
5035 include 'COMMON.INTERACT'
5036 include 'COMMON.DERIV'
5037 include 'COMMON.CHAIN'
5038 include 'COMMON.IOUNITS'
5039 include 'COMMON.NAMES'
5040 include 'COMMON.FFIELD'
5041 include 'COMMON.CONTROL'
5042 include 'COMMON.VECTORS'
5043 double precision x_prime(3),y_prime(3),z_prime(3)
5044 & , sumene,dsc_i,dp2_i,x(65),
5045 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5046 & de_dxx,de_dyy,de_dzz,de_dt
5047 double precision s1_t,s1_6_t,s2_t,s2_6_t
5049 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5050 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5051 & dt_dCi(3),dt_dCi1(3)
5052 common /sccalc/ time11,time12,time112,theti,it,nlobit
5055 do i=loc_start,loc_end
5056 if (itype(i).eq.ntyp1) cycle
5057 costtab(i+1) =dcos(theta(i+1))
5058 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5059 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5060 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5061 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5062 cosfac=dsqrt(cosfac2)
5063 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5064 sinfac=dsqrt(sinfac2)
5066 if (it.eq.10) goto 1
5068 C Compute the axes of tghe local cartesian coordinates system; store in
5069 c x_prime, y_prime and z_prime
5076 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5077 C & dc_norm(3,i+nres)
5079 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5080 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5083 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5086 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5087 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5088 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5089 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5090 c & " xy",scalar(x_prime(1),y_prime(1)),
5091 c & " xz",scalar(x_prime(1),z_prime(1)),
5092 c & " yy",scalar(y_prime(1),y_prime(1)),
5093 c & " yz",scalar(y_prime(1),z_prime(1)),
5094 c & " zz",scalar(z_prime(1),z_prime(1))
5096 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5097 C to local coordinate system. Store in xx, yy, zz.
5103 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5104 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5105 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5112 C Compute the energy of the ith side cbain
5114 c write (2,*) "xx",xx," yy",yy," zz",zz
5117 x(j) = sc_parmin(j,it)
5120 Cc diagnostics - remove later
5122 yy1 = dsin(alph(2))*dcos(omeg(2))
5123 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5124 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5125 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5127 C," --- ", xx_w,yy_w,zz_w
5130 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5131 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5133 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5134 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5136 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5137 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5138 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5139 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5140 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5142 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5143 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5144 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5145 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5146 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5148 dsc_i = 0.743d0+x(61)
5150 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5151 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5152 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5153 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5154 s1=(1+x(63))/(0.1d0 + dscp1)
5155 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5156 s2=(1+x(65))/(0.1d0 + dscp2)
5157 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5158 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5159 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5160 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5162 c & dscp1,dscp2,sumene
5163 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5164 escloc = escloc + sumene
5165 c write (2,*) "escloc",escloc
5166 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5168 if (.not. calc_grad) goto 1
5171 C This section to check the numerical derivatives of the energy of ith side
5172 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5173 C #define DEBUG in the code to turn it on.
5175 write (2,*) "sumene =",sumene
5179 write (2,*) xx,yy,zz
5180 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5181 de_dxx_num=(sumenep-sumene)/aincr
5183 write (2,*) "xx+ sumene from enesc=",sumenep
5186 write (2,*) xx,yy,zz
5187 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5188 de_dyy_num=(sumenep-sumene)/aincr
5190 write (2,*) "yy+ sumene from enesc=",sumenep
5193 write (2,*) xx,yy,zz
5194 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5195 de_dzz_num=(sumenep-sumene)/aincr
5197 write (2,*) "zz+ sumene from enesc=",sumenep
5198 costsave=cost2tab(i+1)
5199 sintsave=sint2tab(i+1)
5200 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5201 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5202 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5203 de_dt_num=(sumenep-sumene)/aincr
5204 write (2,*) " t+ sumene from enesc=",sumenep
5205 cost2tab(i+1)=costsave
5206 sint2tab(i+1)=sintsave
5207 C End of diagnostics section.
5210 C Compute the gradient of esc
5212 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5213 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5214 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5215 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5216 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5217 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5218 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5219 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5220 pom1=(sumene3*sint2tab(i+1)+sumene1)
5221 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5222 pom2=(sumene4*cost2tab(i+1)+sumene2)
5223 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5224 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5225 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5226 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5228 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5229 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5230 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5232 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5233 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5234 & +(pom1+pom2)*pom_dx
5236 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5239 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5240 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5241 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5243 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5244 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5245 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5246 & +x(59)*zz**2 +x(60)*xx*zz
5247 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5248 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5249 & +(pom1-pom2)*pom_dy
5251 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5254 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5255 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5256 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5257 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5258 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5259 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5260 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5261 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5263 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5266 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5267 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5268 & +pom1*pom_dt1+pom2*pom_dt2
5270 write(2,*), "de_dt = ", de_dt,de_dt_num
5274 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5275 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5276 cosfac2xx=cosfac2*xx
5277 sinfac2yy=sinfac2*yy
5279 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5281 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5283 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5284 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5285 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5286 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5287 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5288 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5289 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5290 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5291 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5292 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5296 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5297 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5298 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5299 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5302 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5303 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5304 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5306 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5307 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5311 dXX_Ctab(k,i)=dXX_Ci(k)
5312 dXX_C1tab(k,i)=dXX_Ci1(k)
5313 dYY_Ctab(k,i)=dYY_Ci(k)
5314 dYY_C1tab(k,i)=dYY_Ci1(k)
5315 dZZ_Ctab(k,i)=dZZ_Ci(k)
5316 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5317 dXX_XYZtab(k,i)=dXX_XYZ(k)
5318 dYY_XYZtab(k,i)=dYY_XYZ(k)
5319 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5323 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5324 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5325 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5326 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5327 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5329 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5330 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5331 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5332 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5333 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5334 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5335 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5336 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5338 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5339 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5341 C to check gradient call subroutine check_grad
5348 c------------------------------------------------------------------------------
5349 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5351 C This procedure calculates two-body contact function g(rij) and its derivative:
5354 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5357 C where x=(rij-r0ij)/delta
5359 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5362 double precision rij,r0ij,eps0ij,fcont,fprimcont
5363 double precision x,x2,x4,delta
5367 if (x.lt.-1.0D0) then
5370 else if (x.le.1.0D0) then
5373 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5374 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5381 c------------------------------------------------------------------------------
5382 subroutine splinthet(theti,delta,ss,ssder)
5383 implicit real*8 (a-h,o-z)
5384 include 'DIMENSIONS'
5385 include 'DIMENSIONS.ZSCOPT'
5386 include 'COMMON.VAR'
5387 include 'COMMON.GEO'
5390 if (theti.gt.pipol) then
5391 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5393 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5398 c------------------------------------------------------------------------------
5399 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5401 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5402 double precision ksi,ksi2,ksi3,a1,a2,a3
5403 a1=fprim0*delta/(f1-f0)
5409 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5410 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5413 c------------------------------------------------------------------------------
5414 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5416 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5417 double precision ksi,ksi2,ksi3,a1,a2,a3
5422 a2=3*(f1x-f0x)-2*fprim0x*delta
5423 a3=fprim0x*delta-2*(f1x-f0x)
5424 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5427 C-----------------------------------------------------------------------------
5429 C-----------------------------------------------------------------------------
5430 subroutine etor(etors,edihcnstr,fact)
5431 implicit real*8 (a-h,o-z)
5432 include 'DIMENSIONS'
5433 include 'DIMENSIONS.ZSCOPT'
5434 include 'COMMON.VAR'
5435 include 'COMMON.GEO'
5436 include 'COMMON.LOCAL'
5437 include 'COMMON.TORSION'
5438 include 'COMMON.INTERACT'
5439 include 'COMMON.DERIV'
5440 include 'COMMON.CHAIN'
5441 include 'COMMON.NAMES'
5442 include 'COMMON.IOUNITS'
5443 include 'COMMON.FFIELD'
5444 include 'COMMON.TORCNSTR'
5446 C Set lprn=.true. for debugging
5450 do i=iphi_start,iphi_end
5451 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5452 & .or. itype(i).eq.ntyp1) cycle
5453 itori=itortyp(itype(i-2))
5454 itori1=itortyp(itype(i-1))
5457 C Proline-Proline pair is a special case...
5458 if (itori.eq.3 .and. itori1.eq.3) then
5459 if (phii.gt.-dwapi3) then
5461 fac=1.0D0/(1.0D0-cosphi)
5462 etorsi=v1(1,3,3)*fac
5463 etorsi=etorsi+etorsi
5464 etors=etors+etorsi-v1(1,3,3)
5465 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5468 v1ij=v1(j+1,itori,itori1)
5469 v2ij=v2(j+1,itori,itori1)
5472 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5473 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5477 v1ij=v1(j,itori,itori1)
5478 v2ij=v2(j,itori,itori1)
5481 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5482 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5486 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5487 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5488 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5489 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5490 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5492 ! 6/20/98 - dihedral angle constraints
5495 itori=idih_constr(i)
5498 if (difi.gt.drange(i)) then
5500 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5501 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5502 else if (difi.lt.-drange(i)) then
5504 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5505 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5507 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5508 C & i,itori,rad2deg*phii,
5509 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5511 ! write (iout,*) 'edihcnstr',edihcnstr
5514 c------------------------------------------------------------------------------
5516 subroutine etor(etors,edihcnstr,fact)
5517 implicit real*8 (a-h,o-z)
5518 include 'DIMENSIONS'
5519 include 'DIMENSIONS.ZSCOPT'
5520 include 'COMMON.VAR'
5521 include 'COMMON.GEO'
5522 include 'COMMON.LOCAL'
5523 include 'COMMON.TORSION'
5524 include 'COMMON.INTERACT'
5525 include 'COMMON.DERIV'
5526 include 'COMMON.CHAIN'
5527 include 'COMMON.NAMES'
5528 include 'COMMON.IOUNITS'
5529 include 'COMMON.FFIELD'
5530 include 'COMMON.TORCNSTR'
5532 C Set lprn=.true. for debugging
5536 do i=iphi_start,iphi_end
5538 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5539 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5540 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5541 C & .or. itype(i).eq.ntyp1) cycle
5542 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5543 if (iabs(itype(i)).eq.20) then
5548 itori=itortyp(itype(i-2))
5549 itori1=itortyp(itype(i-1))
5552 C Regular cosine and sine terms
5553 do j=1,nterm(itori,itori1,iblock)
5554 v1ij=v1(j,itori,itori1,iblock)
5555 v2ij=v2(j,itori,itori1,iblock)
5558 etors=etors+v1ij*cosphi+v2ij*sinphi
5559 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5563 C E = SUM ----------------------------------- - v1
5564 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5566 cosphi=dcos(0.5d0*phii)
5567 sinphi=dsin(0.5d0*phii)
5568 do j=1,nlor(itori,itori1,iblock)
5569 vl1ij=vlor1(j,itori,itori1)
5570 vl2ij=vlor2(j,itori,itori1)
5571 vl3ij=vlor3(j,itori,itori1)
5572 pom=vl2ij*cosphi+vl3ij*sinphi
5573 pom1=1.0d0/(pom*pom+1.0d0)
5574 etors=etors+vl1ij*pom1
5575 c if (energy_dec) etors_ii=etors_ii+
5578 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5580 C Subtract the constant term
5581 etors=etors-v0(itori,itori1,iblock)
5583 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5584 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5585 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5586 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5587 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5590 ! 6/20/98 - dihedral angle constraints
5593 itori=idih_constr(i)
5595 difi=pinorm(phii-phi0(i))
5597 if (difi.gt.drange(i)) then
5599 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5600 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5601 edihi=0.25d0*ftors(i)*difi**4
5602 else if (difi.lt.-drange(i)) then
5604 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5605 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5606 edihi=0.25d0*ftors(i)*difi**4
5610 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5611 & i,itori,rad2deg*phii,
5612 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5613 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5615 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5616 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5618 ! write (iout,*) 'edihcnstr',edihcnstr
5621 c----------------------------------------------------------------------------
5622 subroutine etor_d(etors_d,fact2)
5623 C 6/23/01 Compute double torsional energy
5624 implicit real*8 (a-h,o-z)
5625 include 'DIMENSIONS'
5626 include 'DIMENSIONS.ZSCOPT'
5627 include 'COMMON.VAR'
5628 include 'COMMON.GEO'
5629 include 'COMMON.LOCAL'
5630 include 'COMMON.TORSION'
5631 include 'COMMON.INTERACT'
5632 include 'COMMON.DERIV'
5633 include 'COMMON.CHAIN'
5634 include 'COMMON.NAMES'
5635 include 'COMMON.IOUNITS'
5636 include 'COMMON.FFIELD'
5637 include 'COMMON.TORCNSTR'
5639 C Set lprn=.true. for debugging
5643 do i=iphi_start,iphi_end-1
5645 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5646 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5647 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5648 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5649 & (itype(i+1).eq.ntyp1)) cycle
5650 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5652 itori=itortyp(itype(i-2))
5653 itori1=itortyp(itype(i-1))
5654 itori2=itortyp(itype(i))
5660 if (iabs(itype(i+1)).eq.20) iblock=2
5661 C Regular cosine and sine terms
5662 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5663 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5664 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5665 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5666 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5667 cosphi1=dcos(j*phii)
5668 sinphi1=dsin(j*phii)
5669 cosphi2=dcos(j*phii1)
5670 sinphi2=dsin(j*phii1)
5671 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5672 & v2cij*cosphi2+v2sij*sinphi2
5673 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5674 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5676 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5678 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5679 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5680 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5681 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5682 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5683 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5684 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5685 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5686 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5687 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5688 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5689 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5690 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5691 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5694 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5695 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5701 c------------------------------------------------------------------------------
5702 subroutine eback_sc_corr(esccor)
5703 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5704 c conformational states; temporarily implemented as differences
5705 c between UNRES torsional potentials (dependent on three types of
5706 c residues) and the torsional potentials dependent on all 20 types
5707 c of residues computed from AM1 energy surfaces of terminally-blocked
5708 c amino-acid residues.
5709 implicit real*8 (a-h,o-z)
5710 include 'DIMENSIONS'
5711 include 'DIMENSIONS.ZSCOPT'
5712 include 'DIMENSIONS.FREE'
5713 include 'COMMON.VAR'
5714 include 'COMMON.GEO'
5715 include 'COMMON.LOCAL'
5716 include 'COMMON.TORSION'
5717 include 'COMMON.SCCOR'
5718 include 'COMMON.INTERACT'
5719 include 'COMMON.DERIV'
5720 include 'COMMON.CHAIN'
5721 include 'COMMON.NAMES'
5722 include 'COMMON.IOUNITS'
5723 include 'COMMON.FFIELD'
5724 include 'COMMON.CONTROL'
5726 C Set lprn=.true. for debugging
5729 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5731 do i=itau_start,itau_end
5732 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5734 isccori=isccortyp(itype(i-2))
5735 isccori1=isccortyp(itype(i-1))
5737 do intertyp=1,3 !intertyp
5738 cc Added 09 May 2012 (Adasko)
5739 cc Intertyp means interaction type of backbone mainchain correlation:
5740 c 1 = SC...Ca...Ca...Ca
5741 c 2 = Ca...Ca...Ca...SC
5742 c 3 = SC...Ca...Ca...SCi
5744 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5745 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5746 & (itype(i-1).eq.ntyp1)))
5747 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5748 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5749 & .or.(itype(i).eq.ntyp1)))
5750 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5751 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5752 & (itype(i-3).eq.ntyp1)))) cycle
5753 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5754 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5756 do j=1,nterm_sccor(isccori,isccori1)
5757 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5758 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5759 cosphi=dcos(j*tauangle(intertyp,i))
5760 sinphi=dsin(j*tauangle(intertyp,i))
5761 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5762 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5764 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5765 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5766 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5768 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5769 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5770 & (v1sccor(j,1,itori,itori1),j=1,6)
5771 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5772 c gsccor_loc(i-3)=gloci
5777 c------------------------------------------------------------------------------
5778 subroutine multibody(ecorr)
5779 C This subroutine calculates multi-body contributions to energy following
5780 C the idea of Skolnick et al. If side chains I and J make a contact and
5781 C at the same time side chains I+1 and J+1 make a contact, an extra
5782 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5783 implicit real*8 (a-h,o-z)
5784 include 'DIMENSIONS'
5785 include 'COMMON.IOUNITS'
5786 include 'COMMON.DERIV'
5787 include 'COMMON.INTERACT'
5788 include 'COMMON.CONTACTS'
5789 double precision gx(3),gx1(3)
5792 C Set lprn=.true. for debugging
5796 write (iout,'(a)') 'Contact function values:'
5798 write (iout,'(i2,20(1x,i2,f10.5))')
5799 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5814 num_conti=num_cont(i)
5815 num_conti1=num_cont(i1)
5820 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5821 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5822 cd & ' ishift=',ishift
5823 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5824 C The system gains extra energy.
5825 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5826 endif ! j1==j+-ishift
5835 c------------------------------------------------------------------------------
5836 double precision function esccorr(i,j,k,l,jj,kk)
5837 implicit real*8 (a-h,o-z)
5838 include 'DIMENSIONS'
5839 include 'COMMON.IOUNITS'
5840 include 'COMMON.DERIV'
5841 include 'COMMON.INTERACT'
5842 include 'COMMON.CONTACTS'
5843 double precision gx(3),gx1(3)
5848 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5849 C Calculate the multi-body contribution to energy.
5850 C Calculate multi-body contributions to the gradient.
5851 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5852 cd & k,l,(gacont(m,kk,k),m=1,3)
5854 gx(m) =ekl*gacont(m,jj,i)
5855 gx1(m)=eij*gacont(m,kk,k)
5856 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5857 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5858 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5859 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5863 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5868 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5874 c------------------------------------------------------------------------------
5876 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5877 implicit real*8 (a-h,o-z)
5878 include 'DIMENSIONS'
5879 integer dimen1,dimen2,atom,indx
5880 double precision buffer(dimen1,dimen2)
5881 double precision zapas
5882 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5883 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5884 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5885 num_kont=num_cont_hb(atom)
5889 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5892 buffer(i,indx+22)=facont_hb(i,atom)
5893 buffer(i,indx+23)=ees0p(i,atom)
5894 buffer(i,indx+24)=ees0m(i,atom)
5895 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5897 buffer(1,indx+26)=dfloat(num_kont)
5900 c------------------------------------------------------------------------------
5901 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5902 implicit real*8 (a-h,o-z)
5903 include 'DIMENSIONS'
5904 integer dimen1,dimen2,atom,indx
5905 double precision buffer(dimen1,dimen2)
5906 double precision zapas
5907 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5908 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5909 & ees0m(ntyp,maxres),
5910 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5911 num_kont=buffer(1,indx+26)
5912 num_kont_old=num_cont_hb(atom)
5913 num_cont_hb(atom)=num_kont+num_kont_old
5918 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5921 facont_hb(ii,atom)=buffer(i,indx+22)
5922 ees0p(ii,atom)=buffer(i,indx+23)
5923 ees0m(ii,atom)=buffer(i,indx+24)
5924 jcont_hb(ii,atom)=buffer(i,indx+25)
5928 c------------------------------------------------------------------------------
5930 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5931 C This subroutine calculates multi-body contributions to hydrogen-bonding
5932 implicit real*8 (a-h,o-z)
5933 include 'DIMENSIONS'
5934 include 'DIMENSIONS.ZSCOPT'
5935 include 'COMMON.IOUNITS'
5937 include 'COMMON.INFO'
5939 include 'COMMON.FFIELD'
5940 include 'COMMON.DERIV'
5941 include 'COMMON.INTERACT'
5942 include 'COMMON.CONTACTS'
5944 parameter (max_cont=maxconts)
5945 parameter (max_dim=2*(8*3+2))
5946 parameter (msglen1=max_cont*max_dim*4)
5947 parameter (msglen2=2*msglen1)
5948 integer source,CorrelType,CorrelID,Error
5949 double precision buffer(max_cont,max_dim)
5951 double precision gx(3),gx1(3)
5954 C Set lprn=.true. for debugging
5959 if (fgProcs.le.1) goto 30
5961 write (iout,'(a)') 'Contact function values:'
5963 write (iout,'(2i3,50(1x,i2,f5.2))')
5964 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5965 & j=1,num_cont_hb(i))
5968 C Caution! Following code assumes that electrostatic interactions concerning
5969 C a given atom are split among at most two processors!
5979 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5982 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5983 if (MyRank.gt.0) then
5984 C Send correlation contributions to the preceding processor
5986 nn=num_cont_hb(iatel_s)
5987 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5988 cd write (iout,*) 'The BUFFER array:'
5990 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5992 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5994 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5995 C Clear the contacts of the atom passed to the neighboring processor
5996 nn=num_cont_hb(iatel_s+1)
5998 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6000 num_cont_hb(iatel_s)=0
6002 cd write (iout,*) 'Processor ',MyID,MyRank,
6003 cd & ' is sending correlation contribution to processor',MyID-1,
6004 cd & ' msglen=',msglen
6005 cd write (*,*) 'Processor ',MyID,MyRank,
6006 cd & ' is sending correlation contribution to processor',MyID-1,
6007 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6008 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6009 cd write (iout,*) 'Processor ',MyID,
6010 cd & ' has sent correlation contribution to processor',MyID-1,
6011 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6012 cd write (*,*) 'Processor ',MyID,
6013 cd & ' has sent correlation contribution to processor',MyID-1,
6014 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6016 endif ! (MyRank.gt.0)
6020 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6021 if (MyRank.lt.fgProcs-1) then
6022 C Receive correlation contributions from the next processor
6024 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6025 cd write (iout,*) 'Processor',MyID,
6026 cd & ' is receiving correlation contribution from processor',MyID+1,
6027 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6028 cd write (*,*) 'Processor',MyID,
6029 cd & ' is receiving correlation contribution from processor',MyID+1,
6030 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6032 do while (nbytes.le.0)
6033 call mp_probe(MyID+1,CorrelType,nbytes)
6035 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6036 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6037 cd write (iout,*) 'Processor',MyID,
6038 cd & ' has received correlation contribution from processor',MyID+1,
6039 cd & ' msglen=',msglen,' nbytes=',nbytes
6040 cd write (iout,*) 'The received BUFFER array:'
6042 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6044 if (msglen.eq.msglen1) then
6045 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6046 else if (msglen.eq.msglen2) then
6047 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6048 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6051 & 'ERROR!!!! message length changed while processing correlations.'
6053 & 'ERROR!!!! message length changed while processing correlations.'
6054 call mp_stopall(Error)
6055 endif ! msglen.eq.msglen1
6056 endif ! MyRank.lt.fgProcs-1
6063 write (iout,'(a)') 'Contact function values:'
6065 write (iout,'(2i3,50(1x,i2,f5.2))')
6066 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6067 & j=1,num_cont_hb(i))
6071 C Remove the loop below after debugging !!!
6078 C Calculate the local-electrostatic correlation terms
6079 do i=iatel_s,iatel_e+1
6081 num_conti=num_cont_hb(i)
6082 num_conti1=num_cont_hb(i+1)
6087 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6088 c & ' jj=',jj,' kk=',kk
6089 if (j1.eq.j+1 .or. j1.eq.j-1) then
6090 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6091 C The system gains extra energy.
6092 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6094 else if (j1.eq.j) then
6095 C Contacts I-J and I-(J+1) occur simultaneously.
6096 C The system loses extra energy.
6097 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6102 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6103 c & ' jj=',jj,' kk=',kk
6105 C Contacts I-J and (I+1)-J occur simultaneously.
6106 C The system loses extra energy.
6107 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6114 c------------------------------------------------------------------------------
6115 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6117 C This subroutine calculates multi-body contributions to hydrogen-bonding
6118 implicit real*8 (a-h,o-z)
6119 include 'DIMENSIONS'
6120 include 'DIMENSIONS.ZSCOPT'
6121 include 'COMMON.IOUNITS'
6123 include 'COMMON.INFO'
6125 include 'COMMON.FFIELD'
6126 include 'COMMON.DERIV'
6127 include 'COMMON.INTERACT'
6128 include 'COMMON.CONTACTS'
6130 parameter (max_cont=maxconts)
6131 parameter (max_dim=2*(8*3+2))
6132 parameter (msglen1=max_cont*max_dim*4)
6133 parameter (msglen2=2*msglen1)
6134 integer source,CorrelType,CorrelID,Error
6135 double precision buffer(max_cont,max_dim)
6137 double precision gx(3),gx1(3)
6140 C Set lprn=.true. for debugging
6147 if (fgProcs.le.1) goto 30
6149 write (iout,'(a)') 'Contact function values:'
6151 write (iout,'(2i3,50(1x,i2,f5.2))')
6152 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6153 & j=1,num_cont_hb(i))
6156 C Caution! Following code assumes that electrostatic interactions concerning
6157 C a given atom are split among at most two processors!
6167 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6170 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6171 if (MyRank.gt.0) then
6172 C Send correlation contributions to the preceding processor
6174 nn=num_cont_hb(iatel_s)
6175 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6176 cd write (iout,*) 'The BUFFER array:'
6178 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6180 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6182 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6183 C Clear the contacts of the atom passed to the neighboring processor
6184 nn=num_cont_hb(iatel_s+1)
6186 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6188 num_cont_hb(iatel_s)=0
6190 cd write (iout,*) 'Processor ',MyID,MyRank,
6191 cd & ' is sending correlation contribution to processor',MyID-1,
6192 cd & ' msglen=',msglen
6193 cd write (*,*) 'Processor ',MyID,MyRank,
6194 cd & ' is sending correlation contribution to processor',MyID-1,
6195 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6196 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6197 cd write (iout,*) 'Processor ',MyID,
6198 cd & ' has sent correlation contribution to processor',MyID-1,
6199 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6200 cd write (*,*) 'Processor ',MyID,
6201 cd & ' has sent correlation contribution to processor',MyID-1,
6202 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6204 endif ! (MyRank.gt.0)
6208 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6209 if (MyRank.lt.fgProcs-1) then
6210 C Receive correlation contributions from the next processor
6212 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6213 cd write (iout,*) 'Processor',MyID,
6214 cd & ' is receiving correlation contribution from processor',MyID+1,
6215 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6216 cd write (*,*) 'Processor',MyID,
6217 cd & ' is receiving correlation contribution from processor',MyID+1,
6218 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6220 do while (nbytes.le.0)
6221 call mp_probe(MyID+1,CorrelType,nbytes)
6223 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6224 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6225 cd write (iout,*) 'Processor',MyID,
6226 cd & ' has received correlation contribution from processor',MyID+1,
6227 cd & ' msglen=',msglen,' nbytes=',nbytes
6228 cd write (iout,*) 'The received BUFFER array:'
6230 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6232 if (msglen.eq.msglen1) then
6233 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6234 else if (msglen.eq.msglen2) then
6235 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6236 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6239 & 'ERROR!!!! message length changed while processing correlations.'
6241 & 'ERROR!!!! message length changed while processing correlations.'
6242 call mp_stopall(Error)
6243 endif ! msglen.eq.msglen1
6244 endif ! MyRank.lt.fgProcs-1
6251 write (iout,'(a)') 'Contact function values:'
6253 write (iout,'(2i3,50(1x,i2,f5.2))')
6254 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6255 & j=1,num_cont_hb(i))
6261 C Remove the loop below after debugging !!!
6268 C Calculate the dipole-dipole interaction energies
6269 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6270 do i=iatel_s,iatel_e+1
6271 num_conti=num_cont_hb(i)
6278 C Calculate the local-electrostatic correlation terms
6279 do i=iatel_s,iatel_e+1
6281 num_conti=num_cont_hb(i)
6282 num_conti1=num_cont_hb(i+1)
6287 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6288 c & ' jj=',jj,' kk=',kk
6289 if (j1.eq.j+1 .or. j1.eq.j-1) then
6290 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6291 C The system gains extra energy.
6293 sqd1=dsqrt(d_cont(jj,i))
6294 sqd2=dsqrt(d_cont(kk,i1))
6295 sred_geom = sqd1*sqd2
6296 IF (sred_geom.lt.cutoff_corr) THEN
6297 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6299 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6300 c & ' jj=',jj,' kk=',kk
6301 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6302 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6304 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6305 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6308 cd write (iout,*) 'sred_geom=',sred_geom,
6309 cd & ' ekont=',ekont,' fprim=',fprimcont
6310 call calc_eello(i,j,i+1,j1,jj,kk)
6311 if (wcorr4.gt.0.0d0)
6312 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6313 if (wcorr5.gt.0.0d0)
6314 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6315 c print *,"wcorr5",ecorr5
6316 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6317 cd write(2,*)'ijkl',i,j,i+1,j1
6318 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6319 & .or. wturn6.eq.0.0d0))then
6320 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6321 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6322 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6323 cd & 'ecorr6=',ecorr6
6324 cd write (iout,'(4e15.5)') sred_geom,
6325 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6326 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6327 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6328 else if (wturn6.gt.0.0d0
6329 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6330 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6331 eturn6=eturn6+eello_turn6(i,jj,kk)
6332 cd write (2,*) 'multibody_eello:eturn6',eturn6
6333 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6340 else if (j1.eq.j) then
6341 C Contacts I-J and I-(J+1) occur simultaneously.
6342 C The system loses extra energy.
6343 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6348 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6349 c & ' jj=',jj,' kk=',kk
6351 C Contacts I-J and (I+1)-J occur simultaneously.
6352 C The system loses extra energy.
6353 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6358 write (iout,*) "eturn6",eturn6,ecorr6
6361 c------------------------------------------------------------------------------
6362 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6363 implicit real*8 (a-h,o-z)
6364 include 'DIMENSIONS'
6365 include 'COMMON.IOUNITS'
6366 include 'COMMON.DERIV'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.CONTACTS'
6369 double precision gx(3),gx1(3)
6379 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6380 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6381 C Following 4 lines for diagnostics.
6386 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6388 c write (iout,*)'Contacts have occurred for peptide groups',
6389 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6390 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6391 C Calculate the multi-body contribution to energy.
6392 ecorr=ecorr+ekont*ees
6394 C Calculate multi-body contributions to the gradient.
6396 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6397 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6398 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6399 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6400 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6401 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6402 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6403 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6404 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6405 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6406 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6407 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6408 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6409 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6413 gradcorr(ll,m)=gradcorr(ll,m)+
6414 & ees*ekl*gacont_hbr(ll,jj,i)-
6415 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6416 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6421 gradcorr(ll,m)=gradcorr(ll,m)+
6422 & ees*eij*gacont_hbr(ll,kk,k)-
6423 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6424 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6431 C---------------------------------------------------------------------------
6432 subroutine dipole(i,j,jj)
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.FFIELD'
6439 include 'COMMON.DERIV'
6440 include 'COMMON.INTERACT'
6441 include 'COMMON.CONTACTS'
6442 include 'COMMON.TORSION'
6443 include 'COMMON.VAR'
6444 include 'COMMON.GEO'
6445 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6447 iti1 = itortyp(itype(i+1))
6448 if (j.lt.nres-1) then
6449 if (itype(j).le.ntyp) then
6450 itj1 = itortyp(itype(j+1))
6458 dipi(iii,1)=Ub2(iii,i)
6459 dipderi(iii)=Ub2der(iii,i)
6460 dipi(iii,2)=b1(iii,iti1)
6461 dipj(iii,1)=Ub2(iii,j)
6462 dipderj(iii)=Ub2der(iii,j)
6463 dipj(iii,2)=b1(iii,itj1)
6467 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6470 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6473 if (.not.calc_grad) return
6478 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6482 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6487 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6488 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6490 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6492 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6494 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6498 C---------------------------------------------------------------------------
6499 subroutine calc_eello(i,j,k,l,jj,kk)
6501 C This subroutine computes matrices and vectors needed to calculate
6502 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6504 implicit real*8 (a-h,o-z)
6505 include 'DIMENSIONS'
6506 include 'DIMENSIONS.ZSCOPT'
6507 include 'COMMON.IOUNITS'
6508 include 'COMMON.CHAIN'
6509 include 'COMMON.DERIV'
6510 include 'COMMON.INTERACT'
6511 include 'COMMON.CONTACTS'
6512 include 'COMMON.TORSION'
6513 include 'COMMON.VAR'
6514 include 'COMMON.GEO'
6515 include 'COMMON.FFIELD'
6516 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6517 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6520 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6521 cd & ' jj=',jj,' kk=',kk
6522 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6525 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6526 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6529 call transpose2(aa1(1,1),aa1t(1,1))
6530 call transpose2(aa2(1,1),aa2t(1,1))
6533 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6534 & aa1tder(1,1,lll,kkk))
6535 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6536 & aa2tder(1,1,lll,kkk))
6540 C parallel orientation of the two CA-CA-CA frames.
6541 if (i.gt.1 .and. itype(i).le.ntyp) then
6542 iti=itortyp(itype(i))
6546 itk1=itortyp(itype(k+1))
6547 itj=itortyp(itype(j))
6548 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6549 itl1=itortyp(itype(l+1))
6553 C A1 kernel(j+1) A2T
6555 cd write (iout,'(3f10.5,5x,3f10.5)')
6556 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6558 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6559 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6560 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6561 C Following matrices are needed only for 6-th order cumulants
6562 IF (wcorr6.gt.0.0d0) THEN
6563 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6564 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6565 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6566 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6567 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6568 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6569 & ADtEAderx(1,1,1,1,1,1))
6571 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6572 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6573 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6574 & ADtEA1derx(1,1,1,1,1,1))
6576 C End 6-th order cumulants
6579 cd write (2,*) 'In calc_eello6'
6581 cd write (2,*) 'iii=',iii
6583 cd write (2,*) 'kkk=',kkk
6585 cd write (2,'(3(2f10.5),5x)')
6586 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6591 call transpose2(EUgder(1,1,k),auxmat(1,1))
6592 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6593 call transpose2(EUg(1,1,k),auxmat(1,1))
6594 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6595 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6599 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6600 & EAEAderx(1,1,lll,kkk,iii,1))
6604 C A1T kernel(i+1) A2
6605 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6606 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6607 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6608 C Following matrices are needed only for 6-th order cumulants
6609 IF (wcorr6.gt.0.0d0) THEN
6610 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6611 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6612 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6613 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6614 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6615 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6616 & ADtEAderx(1,1,1,1,1,2))
6617 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6618 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6619 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6620 & ADtEA1derx(1,1,1,1,1,2))
6622 C End 6-th order cumulants
6623 call transpose2(EUgder(1,1,l),auxmat(1,1))
6624 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6625 call transpose2(EUg(1,1,l),auxmat(1,1))
6626 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6627 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6631 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6632 & EAEAderx(1,1,lll,kkk,iii,2))
6637 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6638 C They are needed only when the fifth- or the sixth-order cumulants are
6640 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6641 call transpose2(AEA(1,1,1),auxmat(1,1))
6642 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6643 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6644 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6645 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6646 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6647 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6648 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6649 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6650 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6651 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6652 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6653 call transpose2(AEA(1,1,2),auxmat(1,1))
6654 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6655 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6656 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6657 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6658 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6659 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6660 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6661 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6662 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6663 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6664 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6665 C Calculate the Cartesian derivatives of the vectors.
6669 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6670 call matvec2(auxmat(1,1),b1(1,iti),
6671 & AEAb1derx(1,lll,kkk,iii,1,1))
6672 call matvec2(auxmat(1,1),Ub2(1,i),
6673 & AEAb2derx(1,lll,kkk,iii,1,1))
6674 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6675 & AEAb1derx(1,lll,kkk,iii,2,1))
6676 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6677 & AEAb2derx(1,lll,kkk,iii,2,1))
6678 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6679 call matvec2(auxmat(1,1),b1(1,itj),
6680 & AEAb1derx(1,lll,kkk,iii,1,2))
6681 call matvec2(auxmat(1,1),Ub2(1,j),
6682 & AEAb2derx(1,lll,kkk,iii,1,2))
6683 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6684 & AEAb1derx(1,lll,kkk,iii,2,2))
6685 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6686 & AEAb2derx(1,lll,kkk,iii,2,2))
6693 C Antiparallel orientation of the two CA-CA-CA frames.
6694 if (i.gt.1 .and. itype(i).le.ntyp) then
6695 iti=itortyp(itype(i))
6699 itk1=itortyp(itype(k+1))
6700 itl=itortyp(itype(l))
6701 itj=itortyp(itype(j))
6702 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6703 itj1=itortyp(itype(j+1))
6707 C A2 kernel(j-1)T A1T
6708 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6709 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6710 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6711 C Following matrices are needed only for 6-th order cumulants
6712 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6713 & j.eq.i+4 .and. l.eq.i+3)) THEN
6714 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6715 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6716 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6717 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6718 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6719 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6720 & ADtEAderx(1,1,1,1,1,1))
6721 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6722 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6723 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6724 & ADtEA1derx(1,1,1,1,1,1))
6726 C End 6-th order cumulants
6727 call transpose2(EUgder(1,1,k),auxmat(1,1))
6728 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6729 call transpose2(EUg(1,1,k),auxmat(1,1))
6730 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6731 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6735 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6736 & EAEAderx(1,1,lll,kkk,iii,1))
6740 C A2T kernel(i+1)T A1
6741 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6742 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6743 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6744 C Following matrices are needed only for 6-th order cumulants
6745 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6746 & j.eq.i+4 .and. l.eq.i+3)) THEN
6747 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6748 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6749 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6750 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6751 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6752 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6753 & ADtEAderx(1,1,1,1,1,2))
6754 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6755 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6756 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6757 & ADtEA1derx(1,1,1,1,1,2))
6759 C End 6-th order cumulants
6760 call transpose2(EUgder(1,1,j),auxmat(1,1))
6761 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6762 call transpose2(EUg(1,1,j),auxmat(1,1))
6763 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6764 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6768 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6769 & EAEAderx(1,1,lll,kkk,iii,2))
6774 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6775 C They are needed only when the fifth- or the sixth-order cumulants are
6777 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6778 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6779 call transpose2(AEA(1,1,1),auxmat(1,1))
6780 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6781 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6782 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6783 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6784 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6785 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6786 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6787 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6788 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6789 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6790 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6791 call transpose2(AEA(1,1,2),auxmat(1,1))
6792 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6793 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6794 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6795 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6796 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6797 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6798 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6799 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6800 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6801 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6802 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6803 C Calculate the Cartesian derivatives of the vectors.
6807 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6808 call matvec2(auxmat(1,1),b1(1,iti),
6809 & AEAb1derx(1,lll,kkk,iii,1,1))
6810 call matvec2(auxmat(1,1),Ub2(1,i),
6811 & AEAb2derx(1,lll,kkk,iii,1,1))
6812 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6813 & AEAb1derx(1,lll,kkk,iii,2,1))
6814 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6815 & AEAb2derx(1,lll,kkk,iii,2,1))
6816 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6817 call matvec2(auxmat(1,1),b1(1,itl),
6818 & AEAb1derx(1,lll,kkk,iii,1,2))
6819 call matvec2(auxmat(1,1),Ub2(1,l),
6820 & AEAb2derx(1,lll,kkk,iii,1,2))
6821 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6822 & AEAb1derx(1,lll,kkk,iii,2,2))
6823 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6824 & AEAb2derx(1,lll,kkk,iii,2,2))
6833 C---------------------------------------------------------------------------
6834 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6835 & KK,KKderg,AKA,AKAderg,AKAderx)
6839 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6840 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6841 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6846 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6848 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6851 cd if (lprn) write (2,*) 'In kernel'
6853 cd if (lprn) write (2,*) 'kkk=',kkk
6855 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6856 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6858 cd write (2,*) 'lll=',lll
6859 cd write (2,*) 'iii=1'
6861 cd write (2,'(3(2f10.5),5x)')
6862 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6865 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6866 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6868 cd write (2,*) 'lll=',lll
6869 cd write (2,*) 'iii=2'
6871 cd write (2,'(3(2f10.5),5x)')
6872 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6879 C---------------------------------------------------------------------------
6880 double precision function eello4(i,j,k,l,jj,kk)
6881 implicit real*8 (a-h,o-z)
6882 include 'DIMENSIONS'
6883 include 'DIMENSIONS.ZSCOPT'
6884 include 'COMMON.IOUNITS'
6885 include 'COMMON.CHAIN'
6886 include 'COMMON.DERIV'
6887 include 'COMMON.INTERACT'
6888 include 'COMMON.CONTACTS'
6889 include 'COMMON.TORSION'
6890 include 'COMMON.VAR'
6891 include 'COMMON.GEO'
6892 double precision pizda(2,2),ggg1(3),ggg2(3)
6893 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6897 cd print *,'eello4:',i,j,k,l,jj,kk
6898 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6899 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6900 cold eij=facont_hb(jj,i)
6901 cold ekl=facont_hb(kk,k)
6903 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6905 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6906 gcorr_loc(k-1)=gcorr_loc(k-1)
6907 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6909 gcorr_loc(l-1)=gcorr_loc(l-1)
6910 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6912 gcorr_loc(j-1)=gcorr_loc(j-1)
6913 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6918 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6919 & -EAEAderx(2,2,lll,kkk,iii,1)
6920 cd derx(lll,kkk,iii)=0.0d0
6924 cd gcorr_loc(l-1)=0.0d0
6925 cd gcorr_loc(j-1)=0.0d0
6926 cd gcorr_loc(k-1)=0.0d0
6928 cd write (iout,*)'Contacts have occurred for peptide groups',
6929 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6930 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6931 if (j.lt.nres-1) then
6938 if (l.lt.nres-1) then
6946 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6947 ggg1(ll)=eel4*g_contij(ll,1)
6948 ggg2(ll)=eel4*g_contij(ll,2)
6949 ghalf=0.5d0*ggg1(ll)
6951 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6952 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6953 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6954 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6955 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6956 ghalf=0.5d0*ggg2(ll)
6958 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6959 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6960 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6961 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6966 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6967 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6972 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6973 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6979 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6984 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6988 cd write (2,*) iii,gcorr_loc(iii)
6992 cd write (2,*) 'ekont',ekont
6993 cd write (iout,*) 'eello4',ekont*eel4
6996 C---------------------------------------------------------------------------
6997 double precision function eello5(i,j,k,l,jj,kk)
6998 implicit real*8 (a-h,o-z)
6999 include 'DIMENSIONS'
7000 include 'DIMENSIONS.ZSCOPT'
7001 include 'COMMON.IOUNITS'
7002 include 'COMMON.CHAIN'
7003 include 'COMMON.DERIV'
7004 include 'COMMON.INTERACT'
7005 include 'COMMON.CONTACTS'
7006 include 'COMMON.TORSION'
7007 include 'COMMON.VAR'
7008 include 'COMMON.GEO'
7009 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7010 double precision ggg1(3),ggg2(3)
7011 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7016 C /l\ / \ \ / \ / \ / C
7017 C / \ / \ \ / \ / \ / C
7018 C j| o |l1 | o | o| o | | o |o C
7019 C \ |/k\| |/ \| / |/ \| |/ \| C
7020 C \i/ \ / \ / / \ / \ C
7022 C (I) (II) (III) (IV) C
7024 C eello5_1 eello5_2 eello5_3 eello5_4 C
7026 C Antiparallel chains C
7029 C /j\ / \ \ / \ / \ / C
7030 C / \ / \ \ / \ / \ / C
7031 C j1| o |l | o | o| o | | o |o C
7032 C \ |/k\| |/ \| / |/ \| |/ \| C
7033 C \i/ \ / \ / / \ / \ C
7035 C (I) (II) (III) (IV) C
7037 C eello5_1 eello5_2 eello5_3 eello5_4 C
7039 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7041 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7042 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7047 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7049 itk=itortyp(itype(k))
7050 itl=itortyp(itype(l))
7051 itj=itortyp(itype(j))
7056 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7057 cd & eel5_3_num,eel5_4_num)
7061 derx(lll,kkk,iii)=0.0d0
7065 cd eij=facont_hb(jj,i)
7066 cd ekl=facont_hb(kk,k)
7068 cd write (iout,*)'Contacts have occurred for peptide groups',
7069 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7071 C Contribution from the graph I.
7072 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7073 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7074 call transpose2(EUg(1,1,k),auxmat(1,1))
7075 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7076 vv(1)=pizda(1,1)-pizda(2,2)
7077 vv(2)=pizda(1,2)+pizda(2,1)
7078 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7079 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7081 C Explicit gradient in virtual-dihedral angles.
7082 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7083 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7084 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7085 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7086 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7087 vv(1)=pizda(1,1)-pizda(2,2)
7088 vv(2)=pizda(1,2)+pizda(2,1)
7089 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7090 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7091 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7092 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7093 vv(1)=pizda(1,1)-pizda(2,2)
7094 vv(2)=pizda(1,2)+pizda(2,1)
7096 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7097 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7098 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7100 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7101 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7102 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7104 C Cartesian gradient
7108 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7110 vv(1)=pizda(1,1)-pizda(2,2)
7111 vv(2)=pizda(1,2)+pizda(2,1)
7112 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7113 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7114 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7121 C Contribution from graph II
7122 call transpose2(EE(1,1,itk),auxmat(1,1))
7123 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7124 vv(1)=pizda(1,1)+pizda(2,2)
7125 vv(2)=pizda(2,1)-pizda(1,2)
7126 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7127 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7129 C Explicit gradient in virtual-dihedral angles.
7130 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7131 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7132 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7133 vv(1)=pizda(1,1)+pizda(2,2)
7134 vv(2)=pizda(2,1)-pizda(1,2)
7136 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7137 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7138 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7140 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7141 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7142 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7144 C Cartesian gradient
7148 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7150 vv(1)=pizda(1,1)+pizda(2,2)
7151 vv(2)=pizda(2,1)-pizda(1,2)
7152 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7153 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7154 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7163 C Parallel orientation
7164 C Contribution from graph III
7165 call transpose2(EUg(1,1,l),auxmat(1,1))
7166 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7167 vv(1)=pizda(1,1)-pizda(2,2)
7168 vv(2)=pizda(1,2)+pizda(2,1)
7169 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7170 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7172 C Explicit gradient in virtual-dihedral angles.
7173 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7174 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7175 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7176 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7177 vv(1)=pizda(1,1)-pizda(2,2)
7178 vv(2)=pizda(1,2)+pizda(2,1)
7179 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7180 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7181 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7182 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7183 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7184 vv(1)=pizda(1,1)-pizda(2,2)
7185 vv(2)=pizda(1,2)+pizda(2,1)
7186 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7187 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7188 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7189 C Cartesian gradient
7193 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7195 vv(1)=pizda(1,1)-pizda(2,2)
7196 vv(2)=pizda(1,2)+pizda(2,1)
7197 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7198 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7199 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7205 C Contribution from graph IV
7207 call transpose2(EE(1,1,itl),auxmat(1,1))
7208 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7209 vv(1)=pizda(1,1)+pizda(2,2)
7210 vv(2)=pizda(2,1)-pizda(1,2)
7211 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7212 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7214 C Explicit gradient in virtual-dihedral angles.
7215 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7216 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7217 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7218 vv(1)=pizda(1,1)+pizda(2,2)
7219 vv(2)=pizda(2,1)-pizda(1,2)
7220 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7221 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7222 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7223 C Cartesian gradient
7227 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7229 vv(1)=pizda(1,1)+pizda(2,2)
7230 vv(2)=pizda(2,1)-pizda(1,2)
7231 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7232 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7233 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7239 C Antiparallel orientation
7240 C Contribution from graph III
7242 call transpose2(EUg(1,1,j),auxmat(1,1))
7243 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7244 vv(1)=pizda(1,1)-pizda(2,2)
7245 vv(2)=pizda(1,2)+pizda(2,1)
7246 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7247 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7249 C Explicit gradient in virtual-dihedral angles.
7250 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7251 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7252 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7253 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7254 vv(1)=pizda(1,1)-pizda(2,2)
7255 vv(2)=pizda(1,2)+pizda(2,1)
7256 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7257 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7258 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7259 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7260 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7261 vv(1)=pizda(1,1)-pizda(2,2)
7262 vv(2)=pizda(1,2)+pizda(2,1)
7263 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7264 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7265 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7266 C Cartesian gradient
7270 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7272 vv(1)=pizda(1,1)-pizda(2,2)
7273 vv(2)=pizda(1,2)+pizda(2,1)
7274 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7275 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7276 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7282 C Contribution from graph IV
7284 call transpose2(EE(1,1,itj),auxmat(1,1))
7285 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7286 vv(1)=pizda(1,1)+pizda(2,2)
7287 vv(2)=pizda(2,1)-pizda(1,2)
7288 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7289 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7291 C Explicit gradient in virtual-dihedral angles.
7292 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7293 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7294 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7295 vv(1)=pizda(1,1)+pizda(2,2)
7296 vv(2)=pizda(2,1)-pizda(1,2)
7297 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7298 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7299 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7300 C Cartesian gradient
7304 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7306 vv(1)=pizda(1,1)+pizda(2,2)
7307 vv(2)=pizda(2,1)-pizda(1,2)
7308 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7309 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7310 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7317 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7318 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7319 cd write (2,*) 'ijkl',i,j,k,l
7320 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7321 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7323 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7324 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7325 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7326 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7328 if (j.lt.nres-1) then
7335 if (l.lt.nres-1) then
7345 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7347 ggg1(ll)=eel5*g_contij(ll,1)
7348 ggg2(ll)=eel5*g_contij(ll,2)
7349 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7350 ghalf=0.5d0*ggg1(ll)
7352 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7353 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7354 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7355 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7356 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7357 ghalf=0.5d0*ggg2(ll)
7359 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7360 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7361 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7362 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7367 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7368 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7373 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7374 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7380 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7385 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7389 cd write (2,*) iii,g_corr5_loc(iii)
7393 cd write (2,*) 'ekont',ekont
7394 cd write (iout,*) 'eello5',ekont*eel5
7397 c--------------------------------------------------------------------------
7398 double precision function eello6(i,j,k,l,jj,kk)
7399 implicit real*8 (a-h,o-z)
7400 include 'DIMENSIONS'
7401 include 'DIMENSIONS.ZSCOPT'
7402 include 'COMMON.IOUNITS'
7403 include 'COMMON.CHAIN'
7404 include 'COMMON.DERIV'
7405 include 'COMMON.INTERACT'
7406 include 'COMMON.CONTACTS'
7407 include 'COMMON.TORSION'
7408 include 'COMMON.VAR'
7409 include 'COMMON.GEO'
7410 include 'COMMON.FFIELD'
7411 double precision ggg1(3),ggg2(3)
7412 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7417 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7425 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7426 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7430 derx(lll,kkk,iii)=0.0d0
7434 cd eij=facont_hb(jj,i)
7435 cd ekl=facont_hb(kk,k)
7441 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7442 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7443 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7444 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7445 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7446 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7448 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7449 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7450 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7451 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7452 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7453 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7457 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7459 C If turn contributions are considered, they will be handled separately.
7460 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7461 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7462 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7463 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7464 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7465 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7466 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7469 if (j.lt.nres-1) then
7476 if (l.lt.nres-1) then
7484 ggg1(ll)=eel6*g_contij(ll,1)
7485 ggg2(ll)=eel6*g_contij(ll,2)
7486 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7487 ghalf=0.5d0*ggg1(ll)
7489 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7490 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7491 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7492 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7493 ghalf=0.5d0*ggg2(ll)
7494 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7496 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7497 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7498 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7499 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7504 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7505 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7510 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7511 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7517 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7522 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7526 cd write (2,*) iii,g_corr6_loc(iii)
7530 cd write (2,*) 'ekont',ekont
7531 cd write (iout,*) 'eello6',ekont*eel6
7534 c--------------------------------------------------------------------------
7535 double precision function eello6_graph1(i,j,k,l,imat,swap)
7536 implicit real*8 (a-h,o-z)
7537 include 'DIMENSIONS'
7538 include 'DIMENSIONS.ZSCOPT'
7539 include 'COMMON.IOUNITS'
7540 include 'COMMON.CHAIN'
7541 include 'COMMON.DERIV'
7542 include 'COMMON.INTERACT'
7543 include 'COMMON.CONTACTS'
7544 include 'COMMON.TORSION'
7545 include 'COMMON.VAR'
7546 include 'COMMON.GEO'
7547 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7551 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7553 C Parallel Antiparallel C
7559 C \ j|/k\| / \ |/k\|l / C
7564 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7565 itk=itortyp(itype(k))
7566 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7567 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7568 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7569 call transpose2(EUgC(1,1,k),auxmat(1,1))
7570 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7571 vv1(1)=pizda1(1,1)-pizda1(2,2)
7572 vv1(2)=pizda1(1,2)+pizda1(2,1)
7573 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7574 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7575 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7576 s5=scalar2(vv(1),Dtobr2(1,i))
7577 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7578 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7579 if (.not. calc_grad) return
7580 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7581 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7582 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7583 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7584 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7585 & +scalar2(vv(1),Dtobr2der(1,i)))
7586 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7587 vv1(1)=pizda1(1,1)-pizda1(2,2)
7588 vv1(2)=pizda1(1,2)+pizda1(2,1)
7589 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7590 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7592 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7593 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7594 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7595 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7596 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7598 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7599 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7600 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7601 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7602 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7604 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7605 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7606 vv1(1)=pizda1(1,1)-pizda1(2,2)
7607 vv1(2)=pizda1(1,2)+pizda1(2,1)
7608 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7609 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7610 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7611 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7620 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7621 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7622 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7623 call transpose2(EUgC(1,1,k),auxmat(1,1))
7624 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7626 vv1(1)=pizda1(1,1)-pizda1(2,2)
7627 vv1(2)=pizda1(1,2)+pizda1(2,1)
7628 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7629 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7630 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7631 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7632 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7633 s5=scalar2(vv(1),Dtobr2(1,i))
7634 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7640 c----------------------------------------------------------------------------
7641 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7642 implicit real*8 (a-h,o-z)
7643 include 'DIMENSIONS'
7644 include 'DIMENSIONS.ZSCOPT'
7645 include 'COMMON.IOUNITS'
7646 include 'COMMON.CHAIN'
7647 include 'COMMON.DERIV'
7648 include 'COMMON.INTERACT'
7649 include 'COMMON.CONTACTS'
7650 include 'COMMON.TORSION'
7651 include 'COMMON.VAR'
7652 include 'COMMON.GEO'
7654 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7655 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7660 C Parallel Antiparallel C
7666 C \ j|/k\| \ |/k\|l C
7671 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7672 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7673 C AL 7/4/01 s1 would occur in the sixth-order moment,
7674 C but not in a cluster cumulant
7676 s1=dip(1,jj,i)*dip(1,kk,k)
7678 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7679 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7680 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7681 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7682 call transpose2(EUg(1,1,k),auxmat(1,1))
7683 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7684 vv(1)=pizda(1,1)-pizda(2,2)
7685 vv(2)=pizda(1,2)+pizda(2,1)
7686 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7687 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7689 eello6_graph2=-(s1+s2+s3+s4)
7691 eello6_graph2=-(s2+s3+s4)
7694 if (.not. calc_grad) return
7695 C Derivatives in gamma(i-1)
7698 s1=dipderg(1,jj,i)*dip(1,kk,k)
7700 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7701 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7702 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7703 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7705 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7707 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7709 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7711 C Derivatives in gamma(k-1)
7713 s1=dip(1,jj,i)*dipderg(1,kk,k)
7715 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7716 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7717 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7718 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7719 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7720 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7725 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7727 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7729 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7730 C Derivatives in gamma(j-1) or gamma(l-1)
7733 s1=dipderg(3,jj,i)*dip(1,kk,k)
7735 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7736 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7737 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7738 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7739 vv(1)=pizda(1,1)-pizda(2,2)
7740 vv(2)=pizda(1,2)+pizda(2,1)
7741 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7744 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7746 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7749 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7750 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7752 C Derivatives in gamma(l-1) or gamma(j-1)
7755 s1=dip(1,jj,i)*dipderg(3,kk,k)
7757 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7758 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7759 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7760 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7761 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7762 vv(1)=pizda(1,1)-pizda(2,2)
7763 vv(2)=pizda(1,2)+pizda(2,1)
7764 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7767 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7769 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7772 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7773 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7775 C Cartesian derivatives.
7777 write (2,*) 'In eello6_graph2'
7779 write (2,*) 'iii=',iii
7781 write (2,*) 'kkk=',kkk
7783 write (2,'(3(2f10.5),5x)')
7784 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7794 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7796 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7799 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7801 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7802 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7804 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7805 call transpose2(EUg(1,1,k),auxmat(1,1))
7806 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7808 vv(1)=pizda(1,1)-pizda(2,2)
7809 vv(2)=pizda(1,2)+pizda(2,1)
7810 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7811 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7813 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7815 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7818 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7820 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7827 c----------------------------------------------------------------------------
7828 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7829 implicit real*8 (a-h,o-z)
7830 include 'DIMENSIONS'
7831 include 'DIMENSIONS.ZSCOPT'
7832 include 'COMMON.IOUNITS'
7833 include 'COMMON.CHAIN'
7834 include 'COMMON.DERIV'
7835 include 'COMMON.INTERACT'
7836 include 'COMMON.CONTACTS'
7837 include 'COMMON.TORSION'
7838 include 'COMMON.VAR'
7839 include 'COMMON.GEO'
7840 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7842 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7844 C Parallel Antiparallel C
7850 C j|/k\| / |/k\|l / C
7855 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7857 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7858 C energy moment and not to the cluster cumulant.
7859 iti=itortyp(itype(i))
7860 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7861 itj1=itortyp(itype(j+1))
7865 itk=itortyp(itype(k))
7866 itk1=itortyp(itype(k+1))
7867 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7868 itl1=itortyp(itype(l+1))
7873 s1=dip(4,jj,i)*dip(4,kk,k)
7875 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7876 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7877 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7878 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7879 call transpose2(EE(1,1,itk),auxmat(1,1))
7880 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7881 vv(1)=pizda(1,1)+pizda(2,2)
7882 vv(2)=pizda(2,1)-pizda(1,2)
7883 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7884 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7886 eello6_graph3=-(s1+s2+s3+s4)
7888 eello6_graph3=-(s2+s3+s4)
7891 if (.not. calc_grad) return
7892 C Derivatives in gamma(k-1)
7893 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7894 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7895 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7896 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7897 C Derivatives in gamma(l-1)
7898 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7899 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7900 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7901 vv(1)=pizda(1,1)+pizda(2,2)
7902 vv(2)=pizda(2,1)-pizda(1,2)
7903 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7904 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7905 C Cartesian derivatives.
7911 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7913 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7916 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7918 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7919 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7921 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7922 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7924 vv(1)=pizda(1,1)+pizda(2,2)
7925 vv(2)=pizda(2,1)-pizda(1,2)
7926 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7928 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7930 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7933 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7935 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7937 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7943 c----------------------------------------------------------------------------
7944 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7945 implicit real*8 (a-h,o-z)
7946 include 'DIMENSIONS'
7947 include 'DIMENSIONS.ZSCOPT'
7948 include 'COMMON.IOUNITS'
7949 include 'COMMON.CHAIN'
7950 include 'COMMON.DERIV'
7951 include 'COMMON.INTERACT'
7952 include 'COMMON.CONTACTS'
7953 include 'COMMON.TORSION'
7954 include 'COMMON.VAR'
7955 include 'COMMON.GEO'
7956 include 'COMMON.FFIELD'
7957 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7958 & auxvec1(2),auxmat1(2,2)
7960 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7962 C Parallel Antiparallel C
7968 C \ j|/k\| \ |/k\|l C
7973 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7975 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7976 C energy moment and not to the cluster cumulant.
7977 cd write (2,*) 'eello_graph4: wturn6',wturn6
7978 iti=itortyp(itype(i))
7979 itj=itortyp(itype(j))
7980 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7981 itj1=itortyp(itype(j+1))
7985 itk=itortyp(itype(k))
7986 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7987 itk1=itortyp(itype(k+1))
7991 itl=itortyp(itype(l))
7992 if (l.lt.nres-1) then
7993 itl1=itortyp(itype(l+1))
7997 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7998 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7999 cd & ' itl',itl,' itl1',itl1
8002 s1=dip(3,jj,i)*dip(3,kk,k)
8004 s1=dip(2,jj,j)*dip(2,kk,l)
8007 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8008 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8010 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8011 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8013 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8014 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8016 call transpose2(EUg(1,1,k),auxmat(1,1))
8017 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8018 vv(1)=pizda(1,1)-pizda(2,2)
8019 vv(2)=pizda(2,1)+pizda(1,2)
8020 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8021 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8023 eello6_graph4=-(s1+s2+s3+s4)
8025 eello6_graph4=-(s2+s3+s4)
8027 if (.not. calc_grad) return
8028 C Derivatives in gamma(i-1)
8032 s1=dipderg(2,jj,i)*dip(3,kk,k)
8034 s1=dipderg(4,jj,j)*dip(2,kk,l)
8037 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8039 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8040 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8042 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8043 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8045 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8046 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8047 cd write (2,*) 'turn6 derivatives'
8049 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8051 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8055 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8057 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8061 C Derivatives in gamma(k-1)
8064 s1=dip(3,jj,i)*dipderg(2,kk,k)
8066 s1=dip(2,jj,j)*dipderg(4,kk,l)
8069 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8070 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8072 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8073 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8075 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8076 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8078 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8079 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(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))
8083 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8085 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8087 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8091 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8093 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8096 C Derivatives in gamma(j-1) or gamma(l-1)
8097 if (l.eq.j+1 .and. l.gt.1) then
8098 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8099 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8100 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8101 vv(1)=pizda(1,1)-pizda(2,2)
8102 vv(2)=pizda(2,1)+pizda(1,2)
8103 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8104 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8105 else if (j.gt.1) then
8106 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8107 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8108 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8109 vv(1)=pizda(1,1)-pizda(2,2)
8110 vv(2)=pizda(2,1)+pizda(1,2)
8111 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8112 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8113 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8115 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8118 C Cartesian derivatives.
8125 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8127 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8131 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8133 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8137 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8139 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8141 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8142 & b1(1,itj1),auxvec(1))
8143 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8145 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8146 & b1(1,itl1),auxvec(1))
8147 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8149 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8151 vv(1)=pizda(1,1)-pizda(2,2)
8152 vv(2)=pizda(2,1)+pizda(1,2)
8153 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8155 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8157 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8160 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8163 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8166 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8168 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8174 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8179 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8181 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8189 c----------------------------------------------------------------------------
8190 double precision function eello_turn6(i,jj,kk)
8191 implicit real*8 (a-h,o-z)
8192 include 'DIMENSIONS'
8193 include 'DIMENSIONS.ZSCOPT'
8194 include 'COMMON.IOUNITS'
8195 include 'COMMON.CHAIN'
8196 include 'COMMON.DERIV'
8197 include 'COMMON.INTERACT'
8198 include 'COMMON.CONTACTS'
8199 include 'COMMON.TORSION'
8200 include 'COMMON.VAR'
8201 include 'COMMON.GEO'
8202 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8203 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8205 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8206 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8207 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8208 C the respective energy moment and not to the cluster cumulant.
8213 iti=itortyp(itype(i))
8214 itk=itortyp(itype(k))
8215 itk1=itortyp(itype(k+1))
8216 itl=itortyp(itype(l))
8217 itj=itortyp(itype(j))
8218 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8219 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8220 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8225 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8227 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8231 derx_turn(lll,kkk,iii)=0.0d0
8238 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8240 cd write (2,*) 'eello6_5',eello6_5
8242 call transpose2(AEA(1,1,1),auxmat(1,1))
8243 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8244 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8245 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8249 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8250 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8251 s2 = scalar2(b1(1,itk),vtemp1(1))
8253 call transpose2(AEA(1,1,2),atemp(1,1))
8254 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8255 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8256 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8260 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8261 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8262 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8264 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8265 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8266 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8267 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8268 ss13 = scalar2(b1(1,itk),vtemp4(1))
8269 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8273 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8279 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8281 C Derivatives in gamma(i+2)
8283 call transpose2(AEA(1,1,1),auxmatd(1,1))
8284 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8285 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8286 call transpose2(AEAderg(1,1,2),atempd(1,1))
8287 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8288 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8292 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8293 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8294 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8300 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8301 C Derivatives in gamma(i+3)
8303 call transpose2(AEA(1,1,1),auxmatd(1,1))
8304 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8305 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8306 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8310 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8311 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8312 s2d = scalar2(b1(1,itk),vtemp1d(1))
8314 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8315 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8317 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8319 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8320 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8321 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8331 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8332 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8334 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8335 & -0.5d0*ekont*(s2d+s12d)
8337 C Derivatives in gamma(i+4)
8338 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8339 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8340 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8342 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8343 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8344 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8354 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8356 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8358 C Derivatives in gamma(i+5)
8360 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8361 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8362 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8366 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8367 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8368 s2d = scalar2(b1(1,itk),vtemp1d(1))
8370 call transpose2(AEA(1,1,2),atempd(1,1))
8371 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8372 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8376 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8377 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8379 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8380 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8381 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8391 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8392 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8394 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8395 & -0.5d0*ekont*(s2d+s12d)
8397 C Cartesian derivatives
8402 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8403 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8404 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8408 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8409 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8411 s2d = scalar2(b1(1,itk),vtemp1d(1))
8413 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8414 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8415 s8d = -(atempd(1,1)+atempd(2,2))*
8416 & scalar2(cc(1,1,itl),vtemp2(1))
8420 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8422 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8423 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8430 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8433 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8437 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8438 & - 0.5d0*(s8d+s12d)
8440 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8449 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8451 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8452 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8453 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8454 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8455 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8457 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8458 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8459 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8463 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8464 cd & 16*eel_turn6_num
8466 if (j.lt.nres-1) then
8473 if (l.lt.nres-1) then
8481 ggg1(ll)=eel_turn6*g_contij(ll,1)
8482 ggg2(ll)=eel_turn6*g_contij(ll,2)
8483 ghalf=0.5d0*ggg1(ll)
8485 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8486 & +ekont*derx_turn(ll,2,1)
8487 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8488 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8489 & +ekont*derx_turn(ll,4,1)
8490 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8491 ghalf=0.5d0*ggg2(ll)
8493 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8494 & +ekont*derx_turn(ll,2,2)
8495 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8496 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8497 & +ekont*derx_turn(ll,4,2)
8498 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8503 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8508 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8514 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8519 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8523 cd write (2,*) iii,g_corr6_loc(iii)
8526 eello_turn6=ekont*eel_turn6
8527 cd write (2,*) 'ekont',ekont
8528 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8531 crc-------------------------------------------------
8532 SUBROUTINE MATVEC2(A1,V1,V2)
8533 implicit real*8 (a-h,o-z)
8534 include 'DIMENSIONS'
8535 DIMENSION A1(2,2),V1(2),V2(2)
8539 c 3 VI=VI+A1(I,K)*V1(K)
8543 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8544 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8549 C---------------------------------------
8550 SUBROUTINE MATMAT2(A1,A2,A3)
8551 implicit real*8 (a-h,o-z)
8552 include 'DIMENSIONS'
8553 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8554 c DIMENSION AI3(2,2)
8558 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8564 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8565 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8566 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8567 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8575 c-------------------------------------------------------------------------
8576 double precision function scalar2(u,v)
8578 double precision u(2),v(2)
8581 scalar2=u(1)*v(1)+u(2)*v(2)
8585 C-----------------------------------------------------------------------------
8587 subroutine transpose2(a,at)
8589 double precision a(2,2),at(2,2)
8596 c--------------------------------------------------------------------------
8597 subroutine transpose(n,a,at)
8600 double precision a(n,n),at(n,n)
8608 C---------------------------------------------------------------------------
8609 subroutine prodmat3(a1,a2,kk,transp,prod)
8612 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8614 crc double precision auxmat(2,2),prod_(2,2)
8617 crc call transpose2(kk(1,1),auxmat(1,1))
8618 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8619 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8621 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8622 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8623 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8624 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8625 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8626 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8627 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8628 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8631 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8632 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8634 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8635 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8636 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8637 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8638 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8639 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8640 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8641 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8644 c call transpose2(a2(1,1),a2t(1,1))
8647 crc print *,((prod_(i,j),i=1,2),j=1,2)
8648 crc print *,((prod(i,j),i=1,2),j=1,2)
8652 C-----------------------------------------------------------------------------
8653 double precision function scalar(u,v)
8655 double precision u(3),v(3)
8665 C-----------------------------------------------------------------------
8666 double precision function sscale(r)
8667 double precision r,gamm
8668 include "COMMON.SPLITELE"
8669 if(r.lt.r_cut-rlamb) then
8671 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8672 gamm=(r-(r_cut-rlamb))/rlamb
8673 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8679 C-----------------------------------------------------------------------
8680 C-----------------------------------------------------------------------
8681 double precision function sscagrad(r)
8682 double precision r,gamm
8683 include "COMMON.SPLITELE"
8684 if(r.lt.r_cut-rlamb) then
8686 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8687 gamm=(r-(r_cut-rlamb))/rlamb
8688 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8694 C-----------------------------------------------------------------------
8695 C-----------------------------------------------------------------------
8696 double precision function sscalelip(r)
8697 double precision r,gamm
8698 include "COMMON.SPLITELE"
8699 C if(r.lt.r_cut-rlamb) then
8701 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8702 C gamm=(r-(r_cut-rlamb))/rlamb
8703 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8709 C-----------------------------------------------------------------------
8710 double precision function sscagradlip(r)
8711 double precision r,gamm
8712 include "COMMON.SPLITELE"
8713 C if(r.lt.r_cut-rlamb) then
8715 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8716 C gamm=(r-(r_cut-rlamb))/rlamb
8717 sscagradlip=r*(6*r-6.0d0)
8723 c----------------------------------------------------------------------------
8724 double precision function sscale2(r,r_cut,r0,rlamb)
8726 double precision r,gamm,r_cut,r0,rlamb,rr
8728 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
8729 c write (2,*) "rr",rr
8730 if(rr.lt.r_cut-rlamb) then
8732 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8733 gamm=(rr-(r_cut-rlamb))/rlamb
8734 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8740 C-----------------------------------------------------------------------
8741 double precision function sscalgrad2(r,r_cut,r0,rlamb)
8743 double precision r,gamm,r_cut,r0,rlamb,rr
8745 if(rr.lt.r_cut-rlamb) then
8747 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8748 gamm=(rr-(r_cut-rlamb))/rlamb
8750 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
8752 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
8759 c----------------------------------------------------------------------------
8760 subroutine e_saxs(Esaxs_constr)
8762 include 'DIMENSIONS'
8763 include 'DIMENSIONS.ZSCOPT'
8764 include 'DIMENSIONS.FREE'
8767 include "COMMON.SETUP"
8770 include 'COMMON.SBRIDGE'
8771 include 'COMMON.CHAIN'
8772 include 'COMMON.GEO'
8773 include 'COMMON.LOCAL'
8774 include 'COMMON.INTERACT'
8775 include 'COMMON.VAR'
8776 include 'COMMON.IOUNITS'
8777 include 'COMMON.DERIV'
8778 include 'COMMON.CONTROL'
8779 include 'COMMON.NAMES'
8780 include 'COMMON.FFIELD'
8781 include 'COMMON.LANGEVIN'
8783 double precision Esaxs_constr
8784 integer i,iint,j,k,l
8785 double precision PgradC(maxSAXS,3,maxres),
8786 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
8788 double precision PgradC_(maxSAXS,3,maxres),
8789 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
8791 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
8792 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
8793 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
8794 & auxX,auxX1,CACAgrad,Cnorm
8795 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
8796 double precision dist
8798 c SAXS restraint penalty function
8800 write(iout,*) "------- SAXS penalty function start -------"
8801 write (iout,*) "nsaxs",nsaxs
8802 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
8803 write (iout,*) "Psaxs"
8805 write (iout,'(i5,e15.5)') i, Psaxs(i)
8808 Esaxs_constr = 0.0d0
8818 do i=iatsc_s,iatsc_e
8819 if (itype(i).eq.ntyp1) cycle
8820 do iint=1,nint_gr(i)
8821 do j=istart(i,iint),iend(i,iint)
8822 if (itype(j).eq.ntyp1) cycle
8825 dijCASC=dist(i,j+nres)
8826 dijSCCA=dist(i+nres,j)
8827 dijSCSC=dist(i+nres,j+nres)
8828 sigma2CACA=2.0d0/(pstok**2)
8829 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
8830 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
8831 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
8834 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8835 if (itype(j).ne.10) then
8836 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
8840 if (itype(i).ne.10) then
8841 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
8845 if (itype(i).ne.10 .and. itype(j).ne.10) then
8846 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
8850 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
8852 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8854 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8855 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
8856 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
8857 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
8860 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8861 PgradC(k,l,i) = PgradC(k,l,i)-aux
8862 PgradC(k,l,j) = PgradC(k,l,j)+aux
8864 if (itype(j).ne.10) then
8865 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
8866 PgradC(k,l,i) = PgradC(k,l,i)-aux
8867 PgradC(k,l,j) = PgradC(k,l,j)+aux
8868 PgradX(k,l,j) = PgradX(k,l,j)+aux
8871 if (itype(i).ne.10) then
8872 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
8873 PgradX(k,l,i) = PgradX(k,l,i)-aux
8874 PgradC(k,l,i) = PgradC(k,l,i)-aux
8875 PgradC(k,l,j) = PgradC(k,l,j)+aux
8878 if (itype(i).ne.10 .and. itype(j).ne.10) then
8879 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
8880 PgradC(k,l,i) = PgradC(k,l,i)-aux
8881 PgradC(k,l,j) = PgradC(k,l,j)+aux
8882 PgradX(k,l,i) = PgradX(k,l,i)-aux
8883 PgradX(k,l,j) = PgradX(k,l,j)+aux
8889 sigma2CACA=scal_rad**2*0.25d0/
8890 & (restok(itype(j))**2+restok(itype(i))**2)
8892 IF (saxs_cutoff.eq.0) THEN
8895 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8896 Pcalc(k) = Pcalc(k)+expCACA
8897 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8899 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8900 PgradC(k,l,i) = PgradC(k,l,i)-aux
8901 PgradC(k,l,j) = PgradC(k,l,j)+aux
8905 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
8908 c write (2,*) "ijk",i,j,k
8909 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
8910 if (sss2.eq.0.0d0) cycle
8911 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
8912 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
8913 Pcalc(k) = Pcalc(k)+expCACA
8915 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8917 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
8918 & ssgrad2*expCACA/sss2
8921 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8922 PgradC(k,l,i) = PgradC(k,l,i)+aux
8923 PgradC(k,l,j) = PgradC(k,l,j)-aux
8932 if (nfgtasks.gt.1) then
8933 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
8934 & MPI_SUM,king,FG_COMM,IERR)
8935 if (fg_rank.eq.king) then
8937 Pcalc(k) = Pcalc_(k)
8940 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
8941 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8942 if (fg_rank.eq.king) then
8946 PgradC(k,l,i) = PgradC_(k,l,i)
8952 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
8953 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8954 if (fg_rank.eq.king) then
8958 PgradX(k,l,i) = PgradX_(k,l,i)
8967 if (fg_rank.eq.king) then
8971 Cnorm = Cnorm + Pcalc(k)
8973 Esaxs_constr = dlog(Cnorm)-wsaxs0
8975 if (Pcalc(k).gt.0.0d0)
8976 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
8978 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
8982 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
8992 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
8993 auxC1 = auxC1+PgradC(k,l,i)
8995 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
8996 auxX1 = auxX1+PgradX(k,l,i)
8999 gsaxsC(l,i) = auxC - auxC1/Cnorm
9001 gsaxsX(l,i) = auxX - auxX1/Cnorm
9003 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9004 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9012 c----------------------------------------------------------------------------
9013 subroutine e_saxsC(Esaxs_constr)
9015 include 'DIMENSIONS'
9016 include 'DIMENSIONS.ZSCOPT'
9017 include 'DIMENSIONS.FREE'
9020 include "COMMON.SETUP"
9023 include 'COMMON.SBRIDGE'
9024 include 'COMMON.CHAIN'
9025 include 'COMMON.GEO'
9026 include 'COMMON.LOCAL'
9027 include 'COMMON.INTERACT'
9028 include 'COMMON.VAR'
9029 include 'COMMON.IOUNITS'
9030 include 'COMMON.DERIV'
9031 include 'COMMON.CONTROL'
9032 include 'COMMON.NAMES'
9033 include 'COMMON.FFIELD'
9034 include 'COMMON.LANGEVIN'
9036 double precision Esaxs_constr
9037 integer i,iint,j,k,l
9038 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
9040 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9042 double precision dk,dijCASPH,dijSCSPH,
9043 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9044 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9046 c SAXS restraint penalty function
9048 write(iout,*) "------- SAXS penalty function start -------"
9049 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9050 & " isaxs_end",isaxs_end
9051 write (iout,*) "nnt",nnt," ntc",nct
9053 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9054 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9057 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9060 Esaxs_constr = 0.0d0
9062 do j=isaxs_start,isaxs_end
9074 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9076 if (itype(i).ne.10) then
9078 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9081 sigma2CA=2.0d0/pstok**2
9082 sigma2SC=4.0d0/restok(itype(i))**2
9083 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9084 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9085 Pcalc = Pcalc+expCASPH+expSCSPH
9087 write(*,*) "processor i j Pcalc",
9088 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
9090 CASPHgrad = sigma2CA*expCASPH
9091 SCSPHgrad = sigma2SC*expSCSPH
9093 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9094 PgradX(l,i) = PgradX(l,i) + aux
9095 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9100 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
9101 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
9104 logPtot = logPtot - dlog(Pcalc)
9105 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
9106 c & " logPtot",logPtot
9109 if (nfgtasks.gt.1) then
9110 c write (iout,*) "logPtot before reduction",logPtot
9111 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9112 & MPI_SUM,king,FG_COMM,IERR)
9114 c write (iout,*) "logPtot after reduction",logPtot
9115 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9116 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9117 if (fg_rank.eq.king) then
9120 gsaxsC(l,i) = gsaxsC_(l,i)
9124 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9125 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9126 if (fg_rank.eq.king) then
9129 gsaxsX(l,i) = gsaxsX_(l,i)
9135 Esaxs_constr = logPtot