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'
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) return
3242 do i=link_start,link_end
3243 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3244 C CA-CA distance used in regularization of structure.
3247 C iii and jjj point to the residues for which the distance is assigned.
3248 if (ii.gt.nres) then
3255 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3256 c & dhpb(i),dhpb1(i),forcon(i)
3257 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3258 C distance and angle dependent SS bond potential.
3259 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3260 C & iabs(itype(jjj)).eq.1) then
3261 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3262 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3263 if (.not.dyn_ss .and. i.le.nss) then
3264 C 15/02/13 CC dynamic SSbond - additional check
3265 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3266 & iabs(itype(jjj)).eq.1) then
3267 call ssbond_ene(iii,jjj,eij)
3270 cd write (iout,*) "eij",eij
3271 cd & ' waga=',waga,' fac=',fac
3272 ! else if (ii.gt.nres .and. jj.gt.nres) then
3274 C Calculate the distance between the two points and its difference from the
3277 if (irestr_type(i).eq.11) then
3278 ehpb=ehpb+fordepth(i)!**4.0d0
3279 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3280 fac=fordepth(i)!**4.0d0
3281 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3282 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
3283 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3284 c & ehpb,irestr_type(i)
3285 else if (irestr_type(i).eq.10) then
3286 c AL 6//19/2018 cross-link restraints
3287 xdis = 0.5d0*(dd/forcon(i))**2
3288 expdis = dexp(-xdis)
3289 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
3290 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
3291 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
3292 c & " wboltzd",wboltzd
3293 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
3294 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
3295 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
3296 & *expdis/(aux*forcon(i)**2)
3297 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
3298 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3299 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
3300 else if (irestr_type(i).eq.2) then
3301 c Quartic restraints
3302 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3303 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3304 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3305 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
3306 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3308 c Quadratic restraints
3310 C Get the force constant corresponding to this distance.
3312 C Calculate the contribution to energy.
3313 ehpb=ehpb+0.5d0*waga*rdis*rdis
3314 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3315 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3316 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
3318 C Evaluate gradient.
3322 c Calculate Cartesian gradient
3324 ggg(j)=fac*(c(j,jj)-c(j,ii))
3326 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3327 C If this is a SC-SC distance, we need to calculate the contributions to the
3328 C Cartesian gradient in the SC vectors (ghpbx).
3331 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3332 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3336 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3337 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3343 C--------------------------------------------------------------------------
3344 subroutine ssbond_ene(i,j,eij)
3346 C Calculate the distance and angle dependent SS-bond potential energy
3347 C using a free-energy function derived based on RHF/6-31G** ab initio
3348 C calculations of diethyl disulfide.
3350 C A. Liwo and U. Kozlowska, 11/24/03
3352 implicit real*8 (a-h,o-z)
3353 include 'DIMENSIONS'
3354 include 'DIMENSIONS.ZSCOPT'
3355 include 'COMMON.SBRIDGE'
3356 include 'COMMON.CHAIN'
3357 include 'COMMON.DERIV'
3358 include 'COMMON.LOCAL'
3359 include 'COMMON.INTERACT'
3360 include 'COMMON.VAR'
3361 include 'COMMON.IOUNITS'
3362 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3363 itypi=iabs(itype(i))
3367 dxi=dc_norm(1,nres+i)
3368 dyi=dc_norm(2,nres+i)
3369 dzi=dc_norm(3,nres+i)
3370 dsci_inv=dsc_inv(itypi)
3371 itypj=iabs(itype(j))
3372 dscj_inv=dsc_inv(itypj)
3376 dxj=dc_norm(1,nres+j)
3377 dyj=dc_norm(2,nres+j)
3378 dzj=dc_norm(3,nres+j)
3379 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3384 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3385 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3386 om12=dxi*dxj+dyi*dyj+dzi*dzj
3388 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3389 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3395 deltat12=om2-om1+2.0d0
3397 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3398 & +akct*deltad*deltat12
3399 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3400 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3401 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3402 c & " deltat12",deltat12," eij",eij
3403 ed=2*akcm*deltad+akct*deltat12
3405 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3406 eom1=-2*akth*deltat1-pom1-om2*pom2
3407 eom2= 2*akth*deltat2+pom1-om1*pom2
3410 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3413 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3414 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3415 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3416 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3419 C Calculate the components of the gradient in DC and X
3423 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3428 C--------------------------------------------------------------------------
3429 c MODELLER restraint function
3430 subroutine e_modeller(ehomology_constr)
3431 implicit real*8 (a-h,o-z)
3432 include 'DIMENSIONS'
3433 include 'DIMENSIONS.ZSCOPT'
3434 include 'DIMENSIONS.FREE'
3435 integer nnn, i, j, k, ki, irec, l
3436 integer katy, odleglosci, test7
3437 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3438 real*8 distance(max_template),distancek(max_template),
3439 & min_odl,godl(max_template),dih_diff(max_template)
3442 c FP - 30/10/2014 Temporary specifications for homology restraints
3444 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3446 double precision, dimension (maxres) :: guscdiff,usc_diff
3447 double precision, dimension (max_template) ::
3448 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3451 include 'COMMON.SBRIDGE'
3452 include 'COMMON.CHAIN'
3453 include 'COMMON.GEO'
3454 include 'COMMON.DERIV'
3455 include 'COMMON.LOCAL'
3456 include 'COMMON.INTERACT'
3457 include 'COMMON.VAR'
3458 include 'COMMON.IOUNITS'
3459 include 'COMMON.CONTROL'
3460 include 'COMMON.HOMRESTR'
3462 include 'COMMON.SETUP'
3463 include 'COMMON.NAMES'
3466 distancek(i)=9999999.9
3471 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3473 C AL 5/2/14 - Introduce list of restraints
3474 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3476 write(iout,*) "------- dist restrs start -------"
3478 do ii = link_start_homo,link_end_homo
3482 c write (iout,*) "dij(",i,j,") =",dij
3484 do k=1,constr_homology
3485 if(.not.l_homo(k,ii)) then
3489 distance(k)=odl(k,ii)-dij
3490 c write (iout,*) "distance(",k,") =",distance(k)
3492 c For Gaussian-type Urestr
3494 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3495 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3496 c write (iout,*) "distancek(",k,") =",distancek(k)
3497 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3499 c For Lorentzian-type Urestr
3501 if (waga_dist.lt.0.0d0) then
3502 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3503 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3504 & (distance(k)**2+sigma_odlir(k,ii)**2))
3508 c min_odl=minval(distancek)
3509 do kk=1,constr_homology
3510 if(l_homo(kk,ii)) then
3511 min_odl=distancek(kk)
3515 do kk=1,constr_homology
3516 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3517 & min_odl=distancek(kk)
3519 c write (iout,* )"min_odl",min_odl
3521 write (iout,*) "ij dij",i,j,dij
3522 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3523 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3524 write (iout,* )"min_odl",min_odl
3529 if (waga_dist.ge.0.0d0) then
3535 do k=1,constr_homology
3536 c Nie wiem po co to liczycie jeszcze raz!
3537 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3538 c & (2*(sigma_odl(i,j,k))**2))
3539 if(.not.l_homo(k,ii)) cycle
3540 if (waga_dist.ge.0.0d0) then
3542 c For Gaussian-type Urestr
3544 godl(k)=dexp(-distancek(k)+min_odl)
3545 odleg2=odleg2+godl(k)
3547 c For Lorentzian-type Urestr
3550 odleg2=odleg2+distancek(k)
3553 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3554 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3555 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3556 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3559 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3560 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3562 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3563 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3565 if (waga_dist.ge.0.0d0) then
3567 c For Gaussian-type Urestr
3569 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3571 c For Lorentzian-type Urestr
3574 odleg=odleg+odleg2/constr_homology
3578 c write (iout,*) "odleg",odleg ! sum of -ln-s
3581 c For Gaussian-type Urestr
3583 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3585 do k=1,constr_homology
3586 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3587 c & *waga_dist)+min_odl
3588 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3590 if(.not.l_homo(k,ii)) cycle
3591 if (waga_dist.ge.0.0d0) then
3592 c For Gaussian-type Urestr
3594 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3596 c For Lorentzian-type Urestr
3599 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3600 & sigma_odlir(k,ii)**2)**2)
3602 sum_sgodl=sum_sgodl+sgodl
3604 c sgodl2=sgodl2+sgodl
3605 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3606 c write(iout,*) "constr_homology=",constr_homology
3607 c write(iout,*) i, j, k, "TEST K"
3609 if (waga_dist.ge.0.0d0) then
3611 c For Gaussian-type Urestr
3613 grad_odl3=waga_homology(iset)*waga_dist
3614 & *sum_sgodl/(sum_godl*dij)
3616 c For Lorentzian-type Urestr
3619 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3620 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3621 grad_odl3=-waga_homology(iset)*waga_dist*
3622 & sum_sgodl/(constr_homology*dij)
3625 c grad_odl3=sum_sgodl/(sum_godl*dij)
3628 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3629 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3630 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3632 ccc write(iout,*) godl, sgodl, grad_odl3
3634 c grad_odl=grad_odl+grad_odl3
3637 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3638 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3639 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3640 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3641 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3642 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3643 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3644 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3645 c if (i.eq.25.and.j.eq.27) then
3646 c write(iout,*) "jik",jik,"i",i,"j",j
3647 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3648 c write(iout,*) "grad_odl3",grad_odl3
3649 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3650 c write(iout,*) "ggodl",ggodl
3651 c write(iout,*) "ghpbc(",jik,i,")",
3652 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3657 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3658 ccc & dLOG(odleg2),"-odleg=", -odleg
3660 enddo ! ii-loop for dist
3662 write(iout,*) "------- dist restrs end -------"
3663 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3664 c & waga_d.eq.1.0d0) call sum_gradient
3666 c Pseudo-energy and gradient from dihedral-angle restraints from
3667 c homology templates
3668 c write (iout,*) "End of distance loop"
3671 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3673 write(iout,*) "------- dih restrs start -------"
3674 do i=idihconstr_start_homo,idihconstr_end_homo
3675 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3678 do i=idihconstr_start_homo,idihconstr_end_homo
3680 c betai=beta(i,i+1,i+2,i+3)
3682 c write (iout,*) "betai =",betai
3683 do k=1,constr_homology
3684 dih_diff(k)=pinorm(dih(k,i)-betai)
3685 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3686 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3687 c & -(6.28318-dih_diff(i,k))
3688 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3689 c & 6.28318+dih_diff(i,k)
3691 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3693 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3695 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3698 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3701 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3702 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3704 write (iout,*) "i",i," betai",betai," kat2",kat2
3705 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3707 if (kat2.le.1.0d-14) cycle
3708 kat=kat-dLOG(kat2/constr_homology)
3709 c write (iout,*) "kat",kat ! sum of -ln-s
3711 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3712 ccc & dLOG(kat2), "-kat=", -kat
3715 c ----------------------------------------------------------------------
3717 c ----------------------------------------------------------------------
3721 do k=1,constr_homology
3723 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3725 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3727 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3728 sum_sgdih=sum_sgdih+sgdih
3730 c grad_dih3=sum_sgdih/sum_gdih
3731 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3733 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3734 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3735 ccc & gloc(nphi+i-3,icg)
3736 gloc(i,icg)=gloc(i,icg)+grad_dih3
3738 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3740 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3741 ccc & gloc(nphi+i-3,icg)
3743 enddo ! i-loop for dih
3745 write(iout,*) "------- dih restrs end -------"
3748 c Pseudo-energy and gradient for theta angle restraints from
3749 c homology templates
3750 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3754 c For constr_homology reference structures (FP)
3756 c Uconst_back_tot=0.0d0
3759 c Econstr_back legacy
3762 c do i=ithet_start,ithet_end
3765 c do i=loc_start,loc_end
3768 duscdiffx(j,i)=0.0d0
3774 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3775 c write (iout,*) "waga_theta",waga_theta
3776 if (waga_theta.gt.0.0d0) then
3778 write (iout,*) "usampl",usampl
3779 write(iout,*) "------- theta restrs start -------"
3780 c do i=ithet_start,ithet_end
3781 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3784 c write (iout,*) "maxres",maxres,"nres",nres
3786 do i=ithet_start,ithet_end
3789 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3791 c Deviation of theta angles wrt constr_homology ref structures
3793 utheta_i=0.0d0 ! argument of Gaussian for single k
3794 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3795 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3796 c over residues in a fragment
3797 c write (iout,*) "theta(",i,")=",theta(i)
3798 do k=1,constr_homology
3800 c dtheta_i=theta(j)-thetaref(j,iref)
3801 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3802 theta_diff(k)=thetatpl(k,i)-theta(i)
3804 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3805 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3806 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3807 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3808 c Gradient for single Gaussian restraint in subr Econstr_back
3809 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3812 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3813 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3817 c Gradient for multiple Gaussian restraint
3818 sum_gtheta=gutheta_i
3820 do k=1,constr_homology
3821 c New generalized expr for multiple Gaussian from Econstr_back
3822 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3824 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3825 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3828 c Final value of gradient using same var as in Econstr_back
3829 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3830 & *waga_homology(iset)
3831 c dutheta(i)=sum_sgtheta/sum_gtheta
3833 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3835 Eval=Eval-dLOG(gutheta_i/constr_homology)
3836 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3837 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3838 c Uconst_back=Uconst_back+utheta(i)
3839 enddo ! (i-loop for theta)
3841 write(iout,*) "------- theta restrs end -------"
3845 c Deviation of local SC geometry
3847 c Separation of two i-loops (instructed by AL - 11/3/2014)
3849 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3850 c write (iout,*) "waga_d",waga_d
3853 write(iout,*) "------- SC restrs start -------"
3854 write (iout,*) "Initial duscdiff,duscdiffx"
3855 do i=loc_start,loc_end
3856 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3857 & (duscdiffx(jik,i),jik=1,3)
3860 do i=loc_start,loc_end
3861 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3862 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3863 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3864 c write(iout,*) "xxtab, yytab, zztab"
3865 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3866 do k=1,constr_homology
3868 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3869 c Original sign inverted for calc of gradients (s. Econstr_back)
3870 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3871 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3872 c write(iout,*) "dxx, dyy, dzz"
3873 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3875 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3876 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3877 c uscdiffk(k)=usc_diff(i)
3878 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3879 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3880 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3881 c & xxref(j),yyref(j),zzref(j)
3886 c Generalized expression for multiple Gaussian acc to that for a single
3887 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3889 c Original implementation
3890 c sum_guscdiff=guscdiff(i)
3892 c sum_sguscdiff=0.0d0
3893 c do k=1,constr_homology
3894 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3895 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3896 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3899 c Implementation of new expressions for gradient (Jan. 2015)
3901 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3903 do k=1,constr_homology
3905 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3906 c before. Now the drivatives should be correct
3908 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3909 c Original sign inverted for calc of gradients (s. Econstr_back)
3910 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3911 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3913 c New implementation
3915 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3916 & sigma_d(k,i) ! for the grad wrt r'
3917 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3920 c New implementation
3921 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3923 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3924 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3925 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3926 duscdiff(jik,i)=duscdiff(jik,i)+
3927 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3928 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3929 duscdiffx(jik,i)=duscdiffx(jik,i)+
3930 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3931 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3934 write(iout,*) "jik",jik,"i",i
3935 write(iout,*) "dxx, dyy, dzz"
3936 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3937 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3938 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3939 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3940 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3941 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3942 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3943 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3944 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3945 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3946 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3947 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3948 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3949 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3950 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3957 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3958 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3960 c write (iout,*) i," uscdiff",uscdiff(i)
3962 c Put together deviations from local geometry
3964 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3965 c & wfrag_back(3,i,iset)*uscdiff(i)
3966 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3967 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3968 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3969 c Uconst_back=Uconst_back+usc_diff(i)
3971 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3973 c New implment: multiplied by sum_sguscdiff
3976 enddo ! (i-loop for dscdiff)
3981 write(iout,*) "------- SC restrs end -------"
3982 write (iout,*) "------ After SC loop in e_modeller ------"
3983 do i=loc_start,loc_end
3984 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3985 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3987 if (waga_theta.eq.1.0d0) then
3988 write (iout,*) "in e_modeller after SC restr end: dutheta"
3989 do i=ithet_start,ithet_end
3990 write (iout,*) i,dutheta(i)
3993 if (waga_d.eq.1.0d0) then
3994 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3996 write (iout,*) i,(duscdiff(j,i),j=1,3)
3997 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4002 c Total energy from homology restraints
4004 write (iout,*) "odleg",odleg," kat",kat
4005 write (iout,*) "odleg",odleg," kat",kat
4006 write (iout,*) "Eval",Eval," Erot",Erot
4007 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4008 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4009 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4012 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4014 c ehomology_constr=odleg+kat
4016 c For Lorentzian-type Urestr
4019 if (waga_dist.ge.0.0d0) then
4021 c For Gaussian-type Urestr
4023 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4024 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4025 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4026 & waga_theta*Eval+waga_d*Erot
4027 c write (iout,*) "ehomology_constr=",ehomology_constr
4030 c For Lorentzian-type Urestr
4032 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4033 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4034 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4035 & waga_theta*Eval+waga_d*Erot
4036 c write (iout,*) "ehomology_constr=",ehomology_constr
4039 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4040 & "Eval",waga_theta,eval,
4041 & "Erot",waga_d,Erot
4042 write (iout,*) "ehomology_constr",ehomology_constr
4046 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4047 747 format(a12,i4,i4,i4,f8.3,f8.3)
4048 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4049 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4050 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4051 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4053 c-----------------------------------------------------------------------
4054 subroutine ebond(estr)
4056 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4058 implicit real*8 (a-h,o-z)
4059 include 'DIMENSIONS'
4060 include 'DIMENSIONS.ZSCOPT'
4061 include 'DIMENSIONS.FREE'
4062 include 'COMMON.LOCAL'
4063 include 'COMMON.GEO'
4064 include 'COMMON.INTERACT'
4065 include 'COMMON.DERIV'
4066 include 'COMMON.VAR'
4067 include 'COMMON.CHAIN'
4068 include 'COMMON.IOUNITS'
4069 include 'COMMON.NAMES'
4070 include 'COMMON.FFIELD'
4071 include 'COMMON.CONTROL'
4072 logical energy_dec /.false./
4073 double precision u(3),ud(3)
4075 C write (iout,*) "distchainmax",distchainmax
4077 c write (iout,*) "distchainmax",distchainmax
4079 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4080 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4082 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4083 C & *dc(j,i-1)/vbld(i)
4085 C if (energy_dec) write(iout,*)
4086 C & "estr1",i,vbld(i),distchainmax,
4087 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4089 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4090 diff = vbld(i)-vbldpDUM
4091 C write(iout,*) i,diff
4093 diff = vbld(i)-vbldp0
4094 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4098 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4101 C write (iout,'(a7,i5,4f7.3)')
4102 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4104 estr=0.5d0*AKP*estr+estr1
4106 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4110 if (iti.ne.10 .and. iti.ne.ntyp1) then
4113 diff=vbld(i+nres)-vbldsc0(1,iti)
4114 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4115 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4116 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4118 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4122 diff=vbld(i+nres)-vbldsc0(j,iti)
4123 ud(j)=aksc(j,iti)*diff
4124 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4138 uprod2=uprod2*u(k)*u(k)
4142 usumsqder=usumsqder+ud(j)*uprod2
4144 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4145 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4146 estr=estr+uprod/usum
4148 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4156 C--------------------------------------------------------------------------
4157 subroutine ebend(etheta)
4159 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4160 C angles gamma and its derivatives in consecutive thetas and gammas.
4162 implicit real*8 (a-h,o-z)
4163 include 'DIMENSIONS'
4164 include 'DIMENSIONS.ZSCOPT'
4165 include 'COMMON.LOCAL'
4166 include 'COMMON.GEO'
4167 include 'COMMON.INTERACT'
4168 include 'COMMON.DERIV'
4169 include 'COMMON.VAR'
4170 include 'COMMON.CHAIN'
4171 include 'COMMON.IOUNITS'
4172 include 'COMMON.NAMES'
4173 include 'COMMON.FFIELD'
4174 common /calcthet/ term1,term2,termm,diffak,ratak,
4175 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4176 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4177 double precision y(2),z(2)
4179 time11=dexp(-2*time)
4182 c write (iout,*) "nres",nres
4183 c write (*,'(a,i2)') 'EBEND ICG=',icg
4184 c write (iout,*) ithet_start,ithet_end
4185 do i=ithet_start,ithet_end
4186 C if (itype(i-1).eq.ntyp1) cycle
4188 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4189 & .or.itype(i).eq.ntyp1) cycle
4190 C Zero the energy function and its derivative at 0 or pi.
4191 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4193 ichir1=isign(1,itype(i-2))
4194 ichir2=isign(1,itype(i))
4195 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4196 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4197 if (itype(i-1).eq.10) then
4198 itype1=isign(10,itype(i-2))
4199 ichir11=isign(1,itype(i-2))
4200 ichir12=isign(1,itype(i-2))
4201 itype2=isign(10,itype(i))
4202 ichir21=isign(1,itype(i))
4203 ichir22=isign(1,itype(i))
4210 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4214 c call proc_proc(phii,icrc)
4215 if (icrc.eq.1) phii=150.0
4226 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4230 c call proc_proc(phii1,icrc)
4231 if (icrc.eq.1) phii1=150.0
4243 C Calculate the "mean" value of theta from the part of the distribution
4244 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4245 C In following comments this theta will be referred to as t_c.
4246 thet_pred_mean=0.0d0
4248 athetk=athet(k,it,ichir1,ichir2)
4249 bthetk=bthet(k,it,ichir1,ichir2)
4251 athetk=athet(k,itype1,ichir11,ichir12)
4252 bthetk=bthet(k,itype2,ichir21,ichir22)
4254 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4256 c write (iout,*) "thet_pred_mean",thet_pred_mean
4257 dthett=thet_pred_mean*ssd
4258 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4259 c write (iout,*) "thet_pred_mean",thet_pred_mean
4260 C Derivatives of the "mean" values in gamma1 and gamma2.
4261 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4262 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4263 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4264 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4266 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4267 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4268 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4269 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4271 if (theta(i).gt.pi-delta) then
4272 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4274 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4275 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4276 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4278 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4280 else if (theta(i).lt.delta) then
4281 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4282 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4283 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4285 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4286 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4289 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4292 etheta=etheta+ethetai
4293 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4294 c & 'ebend',i,ethetai,theta(i),itype(i)
4295 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4296 c & rad2deg*phii,rad2deg*phii1,ethetai
4297 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4298 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4299 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4303 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4304 do i=1,ntheta_constr
4305 itheta=itheta_constr(i)
4306 thetiii=theta(itheta)
4307 difi=pinorm(thetiii-theta_constr0(i))
4308 if (difi.gt.theta_drange(i)) then
4309 difi=difi-theta_drange(i)
4310 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4311 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4312 & +for_thet_constr(i)*difi**3
4313 else if (difi.lt.-drange(i)) then
4315 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4316 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4317 & +for_thet_constr(i)*difi**3
4321 C if (energy_dec) then
4322 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4323 C & i,itheta,rad2deg*thetiii,
4324 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4325 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4326 C & gloc(itheta+nphi-2,icg)
4329 C Ufff.... We've done all this!!!
4332 C---------------------------------------------------------------------------
4333 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4335 implicit real*8 (a-h,o-z)
4336 include 'DIMENSIONS'
4337 include 'COMMON.LOCAL'
4338 include 'COMMON.IOUNITS'
4339 common /calcthet/ term1,term2,termm,diffak,ratak,
4340 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4341 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4342 C Calculate the contributions to both Gaussian lobes.
4343 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4344 C The "polynomial part" of the "standard deviation" of this part of
4348 sig=sig*thet_pred_mean+polthet(j,it)
4350 C Derivative of the "interior part" of the "standard deviation of the"
4351 C gamma-dependent Gaussian lobe in t_c.
4352 sigtc=3*polthet(3,it)
4354 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4357 C Set the parameters of both Gaussian lobes of the distribution.
4358 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4359 fac=sig*sig+sigc0(it)
4362 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4363 sigsqtc=-4.0D0*sigcsq*sigtc
4364 c print *,i,sig,sigtc,sigsqtc
4365 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4366 sigtc=-sigtc/(fac*fac)
4367 C Following variable is sigma(t_c)**(-2)
4368 sigcsq=sigcsq*sigcsq
4370 sig0inv=1.0D0/sig0i**2
4371 delthec=thetai-thet_pred_mean
4372 delthe0=thetai-theta0i
4373 term1=-0.5D0*sigcsq*delthec*delthec
4374 term2=-0.5D0*sig0inv*delthe0*delthe0
4375 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4376 C NaNs in taking the logarithm. We extract the largest exponent which is added
4377 C to the energy (this being the log of the distribution) at the end of energy
4378 C term evaluation for this virtual-bond angle.
4379 if (term1.gt.term2) then
4381 term2=dexp(term2-termm)
4385 term1=dexp(term1-termm)
4388 C The ratio between the gamma-independent and gamma-dependent lobes of
4389 C the distribution is a Gaussian function of thet_pred_mean too.
4390 diffak=gthet(2,it)-thet_pred_mean
4391 ratak=diffak/gthet(3,it)**2
4392 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4393 C Let's differentiate it in thet_pred_mean NOW.
4395 C Now put together the distribution terms to make complete distribution.
4396 termexp=term1+ak*term2
4397 termpre=sigc+ak*sig0i
4398 C Contribution of the bending energy from this theta is just the -log of
4399 C the sum of the contributions from the two lobes and the pre-exponential
4400 C factor. Simple enough, isn't it?
4401 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4402 C NOW the derivatives!!!
4403 C 6/6/97 Take into account the deformation.
4404 E_theta=(delthec*sigcsq*term1
4405 & +ak*delthe0*sig0inv*term2)/termexp
4406 E_tc=((sigtc+aktc*sig0i)/termpre
4407 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4408 & aktc*term2)/termexp)
4411 c-----------------------------------------------------------------------------
4412 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4413 implicit real*8 (a-h,o-z)
4414 include 'DIMENSIONS'
4415 include 'COMMON.LOCAL'
4416 include 'COMMON.IOUNITS'
4417 common /calcthet/ term1,term2,termm,diffak,ratak,
4418 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4419 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4420 delthec=thetai-thet_pred_mean
4421 delthe0=thetai-theta0i
4422 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4423 t3 = thetai-thet_pred_mean
4427 t14 = t12+t6*sigsqtc
4429 t21 = thetai-theta0i
4435 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4436 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4437 & *(-t12*t9-ak*sig0inv*t27)
4441 C--------------------------------------------------------------------------
4442 subroutine ebend(etheta)
4444 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4445 C angles gamma and its derivatives in consecutive thetas and gammas.
4446 C ab initio-derived potentials from
4447 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4449 implicit real*8 (a-h,o-z)
4450 include 'DIMENSIONS'
4451 include 'DIMENSIONS.ZSCOPT'
4452 include 'DIMENSIONS.FREE'
4453 include 'COMMON.LOCAL'
4454 include 'COMMON.GEO'
4455 include 'COMMON.INTERACT'
4456 include 'COMMON.DERIV'
4457 include 'COMMON.VAR'
4458 include 'COMMON.CHAIN'
4459 include 'COMMON.IOUNITS'
4460 include 'COMMON.NAMES'
4461 include 'COMMON.FFIELD'
4462 include 'COMMON.CONTROL'
4463 include 'COMMON.TORCNSTR'
4464 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4465 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4466 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4467 & sinph1ph2(maxdouble,maxdouble)
4468 logical lprn /.false./, lprn1 /.false./
4470 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4471 do i=ithet_start,ithet_end
4473 c print *,i,itype(i-1),itype(i),itype(i-2)
4474 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4475 & .or.(itype(i).eq.ntyp1)) cycle
4476 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4478 if (iabs(itype(i+1)).eq.20) iblock=2
4479 if (iabs(itype(i+1)).ne.20) iblock=1
4483 theti2=0.5d0*theta(i)
4484 ityp2=ithetyp((itype(i-1)))
4486 coskt(k)=dcos(k*theti2)
4487 sinkt(k)=dsin(k*theti2)
4489 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4492 if (phii.ne.phii) phii=150.0
4496 ityp1=ithetyp((itype(i-2)))
4498 cosph1(k)=dcos(k*phii)
4499 sinph1(k)=dsin(k*phii)
4503 ityp1=ithetyp(itype(i-2))
4509 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4512 if (phii1.ne.phii1) phii1=150.0
4517 ityp3=ithetyp((itype(i)))
4519 cosph2(k)=dcos(k*phii1)
4520 sinph2(k)=dsin(k*phii1)
4524 ityp3=ithetyp(itype(i))
4530 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4531 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4533 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4536 ccl=cosph1(l)*cosph2(k-l)
4537 ssl=sinph1(l)*sinph2(k-l)
4538 scl=sinph1(l)*cosph2(k-l)
4539 csl=cosph1(l)*sinph2(k-l)
4540 cosph1ph2(l,k)=ccl-ssl
4541 cosph1ph2(k,l)=ccl+ssl
4542 sinph1ph2(l,k)=scl+csl
4543 sinph1ph2(k,l)=scl-csl
4547 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4548 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4549 write (iout,*) "coskt and sinkt"
4551 write (iout,*) k,coskt(k),sinkt(k)
4555 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4556 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4559 & write (iout,*) "k",k,"
4560 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4561 & " ethetai",ethetai
4564 write (iout,*) "cosph and sinph"
4566 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4568 write (iout,*) "cosph1ph2 and sinph2ph2"
4571 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4572 & sinph1ph2(l,k),sinph1ph2(k,l)
4575 write(iout,*) "ethetai",ethetai
4579 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4580 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4581 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4582 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4583 ethetai=ethetai+sinkt(m)*aux
4584 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4585 dephii=dephii+k*sinkt(m)*(
4586 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4587 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4588 dephii1=dephii1+k*sinkt(m)*(
4589 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4590 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4592 & write (iout,*) "m",m," k",k," bbthet",
4593 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4594 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4595 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4596 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4600 & write(iout,*) "ethetai",ethetai
4604 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4605 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4606 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4607 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4608 ethetai=ethetai+sinkt(m)*aux
4609 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4610 dephii=dephii+l*sinkt(m)*(
4611 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4612 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4613 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4614 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4615 dephii1=dephii1+(k-l)*sinkt(m)*(
4616 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4617 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4618 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4619 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4621 write (iout,*) "m",m," k",k," l",l," ffthet",
4622 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4623 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4624 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4625 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4626 & " ethetai",ethetai
4627 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4628 & cosph1ph2(k,l)*sinkt(m),
4629 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4635 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4636 & i,theta(i)*rad2deg,phii*rad2deg,
4637 & phii1*rad2deg,ethetai
4638 etheta=etheta+ethetai
4639 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4640 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4641 c gloc(nphi+i-2,icg)=wang*dethetai
4642 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4646 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4647 do i=1,ntheta_constr
4648 itheta=itheta_constr(i)
4649 thetiii=theta(itheta)
4650 difi=pinorm(thetiii-theta_constr0(i))
4651 if (difi.gt.theta_drange(i)) then
4652 difi=difi-theta_drange(i)
4653 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4654 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4655 & +for_thet_constr(i)*difi**3
4656 else if (difi.lt.-drange(i)) then
4658 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4659 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4660 & +for_thet_constr(i)*difi**3
4664 C if (energy_dec) then
4665 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4666 C & i,itheta,rad2deg*thetiii,
4667 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4668 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4669 C & gloc(itheta+nphi-2,icg)
4677 c-----------------------------------------------------------------------------
4678 subroutine esc(escloc)
4679 C Calculate the local energy of a side chain and its derivatives in the
4680 C corresponding virtual-bond valence angles THETA and the spherical angles
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'DIMENSIONS.ZSCOPT'
4685 include 'COMMON.GEO'
4686 include 'COMMON.LOCAL'
4687 include 'COMMON.VAR'
4688 include 'COMMON.INTERACT'
4689 include 'COMMON.DERIV'
4690 include 'COMMON.CHAIN'
4691 include 'COMMON.IOUNITS'
4692 include 'COMMON.NAMES'
4693 include 'COMMON.FFIELD'
4694 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4695 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4696 common /sccalc/ time11,time12,time112,theti,it,nlobit
4699 C write (iout,*) 'ESC'
4700 do i=loc_start,loc_end
4702 if (it.eq.ntyp1) cycle
4703 if (it.eq.10) goto 1
4704 nlobit=nlob(iabs(it))
4705 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4706 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4707 theti=theta(i+1)-pipol
4711 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4713 if (x(2).gt.pi-delta) then
4717 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4719 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4720 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4722 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4723 & ddersc0(1),dersc(1))
4724 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4725 & ddersc0(3),dersc(3))
4727 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4729 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4730 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4731 & dersc0(2),esclocbi,dersc02)
4732 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4734 call splinthet(x(2),0.5d0*delta,ss,ssd)
4739 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4741 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4742 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4744 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4746 c write (iout,*) escloci
4747 else if (x(2).lt.delta) then
4751 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4753 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4754 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4756 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4757 & ddersc0(1),dersc(1))
4758 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4759 & ddersc0(3),dersc(3))
4761 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4763 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4764 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4765 & dersc0(2),esclocbi,dersc02)
4766 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4771 call splinthet(x(2),0.5d0*delta,ss,ssd)
4773 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4775 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4776 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4778 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4779 C write (iout,*) 'i=',i, escloci
4781 call enesc(x,escloci,dersc,ddummy,.false.)
4784 escloc=escloc+escloci
4785 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4786 write (iout,'(a6,i5,0pf7.3)')
4787 & 'escloc',i,escloci
4789 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4791 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4792 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4797 C---------------------------------------------------------------------------
4798 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4799 implicit real*8 (a-h,o-z)
4800 include 'DIMENSIONS'
4801 include 'COMMON.GEO'
4802 include 'COMMON.LOCAL'
4803 include 'COMMON.IOUNITS'
4804 common /sccalc/ time11,time12,time112,theti,it,nlobit
4805 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4806 double precision contr(maxlob,-1:1)
4808 c write (iout,*) 'it=',it,' nlobit=',nlobit
4812 if (mixed) ddersc(j)=0.0d0
4816 C Because of periodicity of the dependence of the SC energy in omega we have
4817 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4818 C To avoid underflows, first compute & store the exponents.
4826 z(k)=x(k)-censc(k,j,it)
4831 Axk=Axk+gaussc(l,k,j,it)*z(l)
4837 expfac=expfac+Ax(k,j,iii)*z(k)
4845 C As in the case of ebend, we want to avoid underflows in exponentiation and
4846 C subsequent NaNs and INFs in energy calculation.
4847 C Find the largest exponent
4851 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4855 cd print *,'it=',it,' emin=',emin
4857 C Compute the contribution to SC energy and derivatives
4861 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4862 cd print *,'j=',j,' expfac=',expfac
4863 escloc_i=escloc_i+expfac
4865 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4869 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4870 & +gaussc(k,2,j,it))*expfac
4877 dersc(1)=dersc(1)/cos(theti)**2
4878 ddersc(1)=ddersc(1)/cos(theti)**2
4881 escloci=-(dlog(escloc_i)-emin)
4883 dersc(j)=dersc(j)/escloc_i
4887 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4892 C------------------------------------------------------------------------------
4893 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4894 implicit real*8 (a-h,o-z)
4895 include 'DIMENSIONS'
4896 include 'COMMON.GEO'
4897 include 'COMMON.LOCAL'
4898 include 'COMMON.IOUNITS'
4899 common /sccalc/ time11,time12,time112,theti,it,nlobit
4900 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4901 double precision contr(maxlob)
4912 z(k)=x(k)-censc(k,j,it)
4918 Axk=Axk+gaussc(l,k,j,it)*z(l)
4924 expfac=expfac+Ax(k,j)*z(k)
4929 C As in the case of ebend, we want to avoid underflows in exponentiation and
4930 C subsequent NaNs and INFs in energy calculation.
4931 C Find the largest exponent
4934 if (emin.gt.contr(j)) emin=contr(j)
4938 C Compute the contribution to SC energy and derivatives
4942 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4943 escloc_i=escloc_i+expfac
4945 dersc(k)=dersc(k)+Ax(k,j)*expfac
4947 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4948 & +gaussc(1,2,j,it))*expfac
4952 dersc(1)=dersc(1)/cos(theti)**2
4953 dersc12=dersc12/cos(theti)**2
4954 escloci=-(dlog(escloc_i)-emin)
4956 dersc(j)=dersc(j)/escloc_i
4958 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4962 c----------------------------------------------------------------------------------
4963 subroutine esc(escloc)
4964 C Calculate the local energy of a side chain and its derivatives in the
4965 C corresponding virtual-bond valence angles THETA and the spherical angles
4966 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4967 C added by Urszula Kozlowska. 07/11/2007
4969 implicit real*8 (a-h,o-z)
4970 include 'DIMENSIONS'
4971 include 'DIMENSIONS.ZSCOPT'
4972 include 'DIMENSIONS.FREE'
4973 include 'COMMON.GEO'
4974 include 'COMMON.LOCAL'
4975 include 'COMMON.VAR'
4976 include 'COMMON.SCROT'
4977 include 'COMMON.INTERACT'
4978 include 'COMMON.DERIV'
4979 include 'COMMON.CHAIN'
4980 include 'COMMON.IOUNITS'
4981 include 'COMMON.NAMES'
4982 include 'COMMON.FFIELD'
4983 include 'COMMON.CONTROL'
4984 include 'COMMON.VECTORS'
4985 double precision x_prime(3),y_prime(3),z_prime(3)
4986 & , sumene,dsc_i,dp2_i,x(65),
4987 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4988 & de_dxx,de_dyy,de_dzz,de_dt
4989 double precision s1_t,s1_6_t,s2_t,s2_6_t
4991 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4992 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4993 & dt_dCi(3),dt_dCi1(3)
4994 common /sccalc/ time11,time12,time112,theti,it,nlobit
4997 do i=loc_start,loc_end
4998 if (itype(i).eq.ntyp1) cycle
4999 costtab(i+1) =dcos(theta(i+1))
5000 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5001 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5002 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5003 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5004 cosfac=dsqrt(cosfac2)
5005 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5006 sinfac=dsqrt(sinfac2)
5008 if (it.eq.10) goto 1
5010 C Compute the axes of tghe local cartesian coordinates system; store in
5011 c x_prime, y_prime and z_prime
5018 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5019 C & dc_norm(3,i+nres)
5021 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5022 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5025 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5028 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5029 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5030 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5031 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5032 c & " xy",scalar(x_prime(1),y_prime(1)),
5033 c & " xz",scalar(x_prime(1),z_prime(1)),
5034 c & " yy",scalar(y_prime(1),y_prime(1)),
5035 c & " yz",scalar(y_prime(1),z_prime(1)),
5036 c & " zz",scalar(z_prime(1),z_prime(1))
5038 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5039 C to local coordinate system. Store in xx, yy, zz.
5045 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5046 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5047 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5054 C Compute the energy of the ith side cbain
5056 c write (2,*) "xx",xx," yy",yy," zz",zz
5059 x(j) = sc_parmin(j,it)
5062 Cc diagnostics - remove later
5064 yy1 = dsin(alph(2))*dcos(omeg(2))
5065 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5066 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5067 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5069 C," --- ", xx_w,yy_w,zz_w
5072 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5073 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5075 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5076 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5078 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5079 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5080 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5081 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5082 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5084 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5085 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5086 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5087 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5088 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5090 dsc_i = 0.743d0+x(61)
5092 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5093 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5094 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5095 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5096 s1=(1+x(63))/(0.1d0 + dscp1)
5097 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5098 s2=(1+x(65))/(0.1d0 + dscp2)
5099 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5100 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5101 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5102 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5104 c & dscp1,dscp2,sumene
5105 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5106 escloc = escloc + sumene
5107 c write (2,*) "escloc",escloc
5108 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5110 if (.not. calc_grad) goto 1
5113 C This section to check the numerical derivatives of the energy of ith side
5114 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5115 C #define DEBUG in the code to turn it on.
5117 write (2,*) "sumene =",sumene
5121 write (2,*) xx,yy,zz
5122 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5123 de_dxx_num=(sumenep-sumene)/aincr
5125 write (2,*) "xx+ sumene from enesc=",sumenep
5128 write (2,*) xx,yy,zz
5129 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5130 de_dyy_num=(sumenep-sumene)/aincr
5132 write (2,*) "yy+ sumene from enesc=",sumenep
5135 write (2,*) xx,yy,zz
5136 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5137 de_dzz_num=(sumenep-sumene)/aincr
5139 write (2,*) "zz+ sumene from enesc=",sumenep
5140 costsave=cost2tab(i+1)
5141 sintsave=sint2tab(i+1)
5142 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5143 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5144 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5145 de_dt_num=(sumenep-sumene)/aincr
5146 write (2,*) " t+ sumene from enesc=",sumenep
5147 cost2tab(i+1)=costsave
5148 sint2tab(i+1)=sintsave
5149 C End of diagnostics section.
5152 C Compute the gradient of esc
5154 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5155 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5156 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5157 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5158 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5159 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5160 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5161 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5162 pom1=(sumene3*sint2tab(i+1)+sumene1)
5163 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5164 pom2=(sumene4*cost2tab(i+1)+sumene2)
5165 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5166 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5167 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5168 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5170 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5171 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5172 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5174 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5175 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5176 & +(pom1+pom2)*pom_dx
5178 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5181 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5182 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5183 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5185 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5186 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5187 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5188 & +x(59)*zz**2 +x(60)*xx*zz
5189 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5190 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5191 & +(pom1-pom2)*pom_dy
5193 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5196 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5197 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5198 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5199 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5200 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5201 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5202 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5203 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5205 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5208 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5209 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5210 & +pom1*pom_dt1+pom2*pom_dt2
5212 write(2,*), "de_dt = ", de_dt,de_dt_num
5216 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5217 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5218 cosfac2xx=cosfac2*xx
5219 sinfac2yy=sinfac2*yy
5221 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5223 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5225 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5226 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5227 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5228 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5229 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5230 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5231 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5232 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5233 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5234 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5238 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5239 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5240 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5241 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5244 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5245 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5246 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5248 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5249 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5253 dXX_Ctab(k,i)=dXX_Ci(k)
5254 dXX_C1tab(k,i)=dXX_Ci1(k)
5255 dYY_Ctab(k,i)=dYY_Ci(k)
5256 dYY_C1tab(k,i)=dYY_Ci1(k)
5257 dZZ_Ctab(k,i)=dZZ_Ci(k)
5258 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5259 dXX_XYZtab(k,i)=dXX_XYZ(k)
5260 dYY_XYZtab(k,i)=dYY_XYZ(k)
5261 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5265 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5266 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5267 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5268 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5269 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5271 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5272 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5273 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5274 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5275 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5276 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5277 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5278 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5280 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5281 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5283 C to check gradient call subroutine check_grad
5290 c------------------------------------------------------------------------------
5291 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5293 C This procedure calculates two-body contact function g(rij) and its derivative:
5296 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5299 C where x=(rij-r0ij)/delta
5301 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5304 double precision rij,r0ij,eps0ij,fcont,fprimcont
5305 double precision x,x2,x4,delta
5309 if (x.lt.-1.0D0) then
5312 else if (x.le.1.0D0) then
5315 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5316 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5323 c------------------------------------------------------------------------------
5324 subroutine splinthet(theti,delta,ss,ssder)
5325 implicit real*8 (a-h,o-z)
5326 include 'DIMENSIONS'
5327 include 'DIMENSIONS.ZSCOPT'
5328 include 'COMMON.VAR'
5329 include 'COMMON.GEO'
5332 if (theti.gt.pipol) then
5333 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5335 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5340 c------------------------------------------------------------------------------
5341 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5343 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5344 double precision ksi,ksi2,ksi3,a1,a2,a3
5345 a1=fprim0*delta/(f1-f0)
5351 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5352 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5355 c------------------------------------------------------------------------------
5356 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5358 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5359 double precision ksi,ksi2,ksi3,a1,a2,a3
5364 a2=3*(f1x-f0x)-2*fprim0x*delta
5365 a3=fprim0x*delta-2*(f1x-f0x)
5366 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5369 C-----------------------------------------------------------------------------
5371 C-----------------------------------------------------------------------------
5372 subroutine etor(etors,edihcnstr,fact)
5373 implicit real*8 (a-h,o-z)
5374 include 'DIMENSIONS'
5375 include 'DIMENSIONS.ZSCOPT'
5376 include 'COMMON.VAR'
5377 include 'COMMON.GEO'
5378 include 'COMMON.LOCAL'
5379 include 'COMMON.TORSION'
5380 include 'COMMON.INTERACT'
5381 include 'COMMON.DERIV'
5382 include 'COMMON.CHAIN'
5383 include 'COMMON.NAMES'
5384 include 'COMMON.IOUNITS'
5385 include 'COMMON.FFIELD'
5386 include 'COMMON.TORCNSTR'
5388 C Set lprn=.true. for debugging
5392 do i=iphi_start,iphi_end
5393 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5394 & .or. itype(i).eq.ntyp1) cycle
5395 itori=itortyp(itype(i-2))
5396 itori1=itortyp(itype(i-1))
5399 C Proline-Proline pair is a special case...
5400 if (itori.eq.3 .and. itori1.eq.3) then
5401 if (phii.gt.-dwapi3) then
5403 fac=1.0D0/(1.0D0-cosphi)
5404 etorsi=v1(1,3,3)*fac
5405 etorsi=etorsi+etorsi
5406 etors=etors+etorsi-v1(1,3,3)
5407 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5410 v1ij=v1(j+1,itori,itori1)
5411 v2ij=v2(j+1,itori,itori1)
5414 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5415 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5419 v1ij=v1(j,itori,itori1)
5420 v2ij=v2(j,itori,itori1)
5423 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5424 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5428 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5429 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5430 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5431 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5432 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5434 ! 6/20/98 - dihedral angle constraints
5437 itori=idih_constr(i)
5440 if (difi.gt.drange(i)) then
5442 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5443 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5444 else if (difi.lt.-drange(i)) then
5446 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5447 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5449 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5450 C & i,itori,rad2deg*phii,
5451 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5453 ! write (iout,*) 'edihcnstr',edihcnstr
5456 c------------------------------------------------------------------------------
5458 subroutine etor(etors,edihcnstr,fact)
5459 implicit real*8 (a-h,o-z)
5460 include 'DIMENSIONS'
5461 include 'DIMENSIONS.ZSCOPT'
5462 include 'COMMON.VAR'
5463 include 'COMMON.GEO'
5464 include 'COMMON.LOCAL'
5465 include 'COMMON.TORSION'
5466 include 'COMMON.INTERACT'
5467 include 'COMMON.DERIV'
5468 include 'COMMON.CHAIN'
5469 include 'COMMON.NAMES'
5470 include 'COMMON.IOUNITS'
5471 include 'COMMON.FFIELD'
5472 include 'COMMON.TORCNSTR'
5474 C Set lprn=.true. for debugging
5478 do i=iphi_start,iphi_end
5480 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5481 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5482 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5483 C & .or. itype(i).eq.ntyp1) cycle
5484 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5485 if (iabs(itype(i)).eq.20) then
5490 itori=itortyp(itype(i-2))
5491 itori1=itortyp(itype(i-1))
5494 C Regular cosine and sine terms
5495 do j=1,nterm(itori,itori1,iblock)
5496 v1ij=v1(j,itori,itori1,iblock)
5497 v2ij=v2(j,itori,itori1,iblock)
5500 etors=etors+v1ij*cosphi+v2ij*sinphi
5501 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5505 C E = SUM ----------------------------------- - v1
5506 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5508 cosphi=dcos(0.5d0*phii)
5509 sinphi=dsin(0.5d0*phii)
5510 do j=1,nlor(itori,itori1,iblock)
5511 vl1ij=vlor1(j,itori,itori1)
5512 vl2ij=vlor2(j,itori,itori1)
5513 vl3ij=vlor3(j,itori,itori1)
5514 pom=vl2ij*cosphi+vl3ij*sinphi
5515 pom1=1.0d0/(pom*pom+1.0d0)
5516 etors=etors+vl1ij*pom1
5517 c if (energy_dec) etors_ii=etors_ii+
5520 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5522 C Subtract the constant term
5523 etors=etors-v0(itori,itori1,iblock)
5525 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5526 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5527 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5528 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5529 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5532 ! 6/20/98 - dihedral angle constraints
5535 itori=idih_constr(i)
5537 difi=pinorm(phii-phi0(i))
5539 if (difi.gt.drange(i)) then
5541 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5542 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5543 edihi=0.25d0*ftors(i)*difi**4
5544 else if (difi.lt.-drange(i)) then
5546 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5547 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5548 edihi=0.25d0*ftors(i)*difi**4
5552 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5553 & i,itori,rad2deg*phii,
5554 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5555 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5557 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5558 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5560 ! write (iout,*) 'edihcnstr',edihcnstr
5563 c----------------------------------------------------------------------------
5564 subroutine etor_d(etors_d,fact2)
5565 C 6/23/01 Compute double torsional energy
5566 implicit real*8 (a-h,o-z)
5567 include 'DIMENSIONS'
5568 include 'DIMENSIONS.ZSCOPT'
5569 include 'COMMON.VAR'
5570 include 'COMMON.GEO'
5571 include 'COMMON.LOCAL'
5572 include 'COMMON.TORSION'
5573 include 'COMMON.INTERACT'
5574 include 'COMMON.DERIV'
5575 include 'COMMON.CHAIN'
5576 include 'COMMON.NAMES'
5577 include 'COMMON.IOUNITS'
5578 include 'COMMON.FFIELD'
5579 include 'COMMON.TORCNSTR'
5581 C Set lprn=.true. for debugging
5585 do i=iphi_start,iphi_end-1
5587 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5588 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5589 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5590 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5591 & (itype(i+1).eq.ntyp1)) cycle
5592 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5594 itori=itortyp(itype(i-2))
5595 itori1=itortyp(itype(i-1))
5596 itori2=itortyp(itype(i))
5602 if (iabs(itype(i+1)).eq.20) iblock=2
5603 C Regular cosine and sine terms
5604 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5605 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5606 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5607 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5608 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5609 cosphi1=dcos(j*phii)
5610 sinphi1=dsin(j*phii)
5611 cosphi2=dcos(j*phii1)
5612 sinphi2=dsin(j*phii1)
5613 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5614 & v2cij*cosphi2+v2sij*sinphi2
5615 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5616 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5618 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5620 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5621 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5622 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5623 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5624 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5625 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5626 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5627 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5628 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5629 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5630 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5631 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5632 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5633 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5636 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5637 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5643 c------------------------------------------------------------------------------
5644 subroutine eback_sc_corr(esccor)
5645 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5646 c conformational states; temporarily implemented as differences
5647 c between UNRES torsional potentials (dependent on three types of
5648 c residues) and the torsional potentials dependent on all 20 types
5649 c of residues computed from AM1 energy surfaces of terminally-blocked
5650 c amino-acid residues.
5651 implicit real*8 (a-h,o-z)
5652 include 'DIMENSIONS'
5653 include 'DIMENSIONS.ZSCOPT'
5654 include 'DIMENSIONS.FREE'
5655 include 'COMMON.VAR'
5656 include 'COMMON.GEO'
5657 include 'COMMON.LOCAL'
5658 include 'COMMON.TORSION'
5659 include 'COMMON.SCCOR'
5660 include 'COMMON.INTERACT'
5661 include 'COMMON.DERIV'
5662 include 'COMMON.CHAIN'
5663 include 'COMMON.NAMES'
5664 include 'COMMON.IOUNITS'
5665 include 'COMMON.FFIELD'
5666 include 'COMMON.CONTROL'
5668 C Set lprn=.true. for debugging
5671 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5673 do i=itau_start,itau_end
5674 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5676 isccori=isccortyp(itype(i-2))
5677 isccori1=isccortyp(itype(i-1))
5679 do intertyp=1,3 !intertyp
5680 cc Added 09 May 2012 (Adasko)
5681 cc Intertyp means interaction type of backbone mainchain correlation:
5682 c 1 = SC...Ca...Ca...Ca
5683 c 2 = Ca...Ca...Ca...SC
5684 c 3 = SC...Ca...Ca...SCi
5686 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5687 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5688 & (itype(i-1).eq.ntyp1)))
5689 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5690 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5691 & .or.(itype(i).eq.ntyp1)))
5692 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5693 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5694 & (itype(i-3).eq.ntyp1)))) cycle
5695 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5696 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5698 do j=1,nterm_sccor(isccori,isccori1)
5699 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5700 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5701 cosphi=dcos(j*tauangle(intertyp,i))
5702 sinphi=dsin(j*tauangle(intertyp,i))
5703 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5704 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5706 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5707 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5708 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5710 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5711 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5712 & (v1sccor(j,1,itori,itori1),j=1,6)
5713 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5714 c gsccor_loc(i-3)=gloci
5719 c------------------------------------------------------------------------------
5720 subroutine multibody(ecorr)
5721 C This subroutine calculates multi-body contributions to energy following
5722 C the idea of Skolnick et al. If side chains I and J make a contact and
5723 C at the same time side chains I+1 and J+1 make a contact, an extra
5724 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5725 implicit real*8 (a-h,o-z)
5726 include 'DIMENSIONS'
5727 include 'COMMON.IOUNITS'
5728 include 'COMMON.DERIV'
5729 include 'COMMON.INTERACT'
5730 include 'COMMON.CONTACTS'
5731 double precision gx(3),gx1(3)
5734 C Set lprn=.true. for debugging
5738 write (iout,'(a)') 'Contact function values:'
5740 write (iout,'(i2,20(1x,i2,f10.5))')
5741 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5756 num_conti=num_cont(i)
5757 num_conti1=num_cont(i1)
5762 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5763 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5764 cd & ' ishift=',ishift
5765 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5766 C The system gains extra energy.
5767 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5768 endif ! j1==j+-ishift
5777 c------------------------------------------------------------------------------
5778 double precision function esccorr(i,j,k,l,jj,kk)
5779 implicit real*8 (a-h,o-z)
5780 include 'DIMENSIONS'
5781 include 'COMMON.IOUNITS'
5782 include 'COMMON.DERIV'
5783 include 'COMMON.INTERACT'
5784 include 'COMMON.CONTACTS'
5785 double precision gx(3),gx1(3)
5790 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5791 C Calculate the multi-body contribution to energy.
5792 C Calculate multi-body contributions to the gradient.
5793 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5794 cd & k,l,(gacont(m,kk,k),m=1,3)
5796 gx(m) =ekl*gacont(m,jj,i)
5797 gx1(m)=eij*gacont(m,kk,k)
5798 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5799 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5800 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5801 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5805 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5810 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5816 c------------------------------------------------------------------------------
5818 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5819 implicit real*8 (a-h,o-z)
5820 include 'DIMENSIONS'
5821 integer dimen1,dimen2,atom,indx
5822 double precision buffer(dimen1,dimen2)
5823 double precision zapas
5824 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5825 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5826 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5827 num_kont=num_cont_hb(atom)
5831 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5834 buffer(i,indx+22)=facont_hb(i,atom)
5835 buffer(i,indx+23)=ees0p(i,atom)
5836 buffer(i,indx+24)=ees0m(i,atom)
5837 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5839 buffer(1,indx+26)=dfloat(num_kont)
5842 c------------------------------------------------------------------------------
5843 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5844 implicit real*8 (a-h,o-z)
5845 include 'DIMENSIONS'
5846 integer dimen1,dimen2,atom,indx
5847 double precision buffer(dimen1,dimen2)
5848 double precision zapas
5849 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5850 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5851 & ees0m(ntyp,maxres),
5852 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5853 num_kont=buffer(1,indx+26)
5854 num_kont_old=num_cont_hb(atom)
5855 num_cont_hb(atom)=num_kont+num_kont_old
5860 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5863 facont_hb(ii,atom)=buffer(i,indx+22)
5864 ees0p(ii,atom)=buffer(i,indx+23)
5865 ees0m(ii,atom)=buffer(i,indx+24)
5866 jcont_hb(ii,atom)=buffer(i,indx+25)
5870 c------------------------------------------------------------------------------
5872 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5873 C This subroutine calculates multi-body contributions to hydrogen-bonding
5874 implicit real*8 (a-h,o-z)
5875 include 'DIMENSIONS'
5876 include 'DIMENSIONS.ZSCOPT'
5877 include 'COMMON.IOUNITS'
5879 include 'COMMON.INFO'
5881 include 'COMMON.FFIELD'
5882 include 'COMMON.DERIV'
5883 include 'COMMON.INTERACT'
5884 include 'COMMON.CONTACTS'
5886 parameter (max_cont=maxconts)
5887 parameter (max_dim=2*(8*3+2))
5888 parameter (msglen1=max_cont*max_dim*4)
5889 parameter (msglen2=2*msglen1)
5890 integer source,CorrelType,CorrelID,Error
5891 double precision buffer(max_cont,max_dim)
5893 double precision gx(3),gx1(3)
5896 C Set lprn=.true. for debugging
5901 if (fgProcs.le.1) goto 30
5903 write (iout,'(a)') 'Contact function values:'
5905 write (iout,'(2i3,50(1x,i2,f5.2))')
5906 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5907 & j=1,num_cont_hb(i))
5910 C Caution! Following code assumes that electrostatic interactions concerning
5911 C a given atom are split among at most two processors!
5921 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5924 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5925 if (MyRank.gt.0) then
5926 C Send correlation contributions to the preceding processor
5928 nn=num_cont_hb(iatel_s)
5929 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5930 cd write (iout,*) 'The BUFFER array:'
5932 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5934 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5936 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5937 C Clear the contacts of the atom passed to the neighboring processor
5938 nn=num_cont_hb(iatel_s+1)
5940 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5942 num_cont_hb(iatel_s)=0
5944 cd write (iout,*) 'Processor ',MyID,MyRank,
5945 cd & ' is sending correlation contribution to processor',MyID-1,
5946 cd & ' msglen=',msglen
5947 cd write (*,*) 'Processor ',MyID,MyRank,
5948 cd & ' is sending correlation contribution to processor',MyID-1,
5949 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5950 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5951 cd write (iout,*) 'Processor ',MyID,
5952 cd & ' has sent correlation contribution to processor',MyID-1,
5953 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5954 cd write (*,*) 'Processor ',MyID,
5955 cd & ' has sent correlation contribution to processor',MyID-1,
5956 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5958 endif ! (MyRank.gt.0)
5962 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5963 if (MyRank.lt.fgProcs-1) then
5964 C Receive correlation contributions from the next processor
5966 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5967 cd write (iout,*) 'Processor',MyID,
5968 cd & ' is receiving correlation contribution from processor',MyID+1,
5969 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5970 cd write (*,*) 'Processor',MyID,
5971 cd & ' is receiving correlation contribution from processor',MyID+1,
5972 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5974 do while (nbytes.le.0)
5975 call mp_probe(MyID+1,CorrelType,nbytes)
5977 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5978 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5979 cd write (iout,*) 'Processor',MyID,
5980 cd & ' has received correlation contribution from processor',MyID+1,
5981 cd & ' msglen=',msglen,' nbytes=',nbytes
5982 cd write (iout,*) 'The received BUFFER array:'
5984 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5986 if (msglen.eq.msglen1) then
5987 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5988 else if (msglen.eq.msglen2) then
5989 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5990 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5993 & 'ERROR!!!! message length changed while processing correlations.'
5995 & 'ERROR!!!! message length changed while processing correlations.'
5996 call mp_stopall(Error)
5997 endif ! msglen.eq.msglen1
5998 endif ! MyRank.lt.fgProcs-1
6005 write (iout,'(a)') 'Contact function values:'
6007 write (iout,'(2i3,50(1x,i2,f5.2))')
6008 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6009 & j=1,num_cont_hb(i))
6013 C Remove the loop below after debugging !!!
6020 C Calculate the local-electrostatic correlation terms
6021 do i=iatel_s,iatel_e+1
6023 num_conti=num_cont_hb(i)
6024 num_conti1=num_cont_hb(i+1)
6029 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6030 c & ' jj=',jj,' kk=',kk
6031 if (j1.eq.j+1 .or. j1.eq.j-1) then
6032 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6033 C The system gains extra energy.
6034 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6036 else if (j1.eq.j) then
6037 C Contacts I-J and I-(J+1) occur simultaneously.
6038 C The system loses extra energy.
6039 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6044 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6045 c & ' jj=',jj,' kk=',kk
6047 C Contacts I-J and (I+1)-J occur simultaneously.
6048 C The system loses extra energy.
6049 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6056 c------------------------------------------------------------------------------
6057 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6059 C This subroutine calculates multi-body contributions to hydrogen-bonding
6060 implicit real*8 (a-h,o-z)
6061 include 'DIMENSIONS'
6062 include 'DIMENSIONS.ZSCOPT'
6063 include 'COMMON.IOUNITS'
6065 include 'COMMON.INFO'
6067 include 'COMMON.FFIELD'
6068 include 'COMMON.DERIV'
6069 include 'COMMON.INTERACT'
6070 include 'COMMON.CONTACTS'
6072 parameter (max_cont=maxconts)
6073 parameter (max_dim=2*(8*3+2))
6074 parameter (msglen1=max_cont*max_dim*4)
6075 parameter (msglen2=2*msglen1)
6076 integer source,CorrelType,CorrelID,Error
6077 double precision buffer(max_cont,max_dim)
6079 double precision gx(3),gx1(3)
6082 C Set lprn=.true. for debugging
6089 if (fgProcs.le.1) goto 30
6091 write (iout,'(a)') 'Contact function values:'
6093 write (iout,'(2i3,50(1x,i2,f5.2))')
6094 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6095 & j=1,num_cont_hb(i))
6098 C Caution! Following code assumes that electrostatic interactions concerning
6099 C a given atom are split among at most two processors!
6109 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6112 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6113 if (MyRank.gt.0) then
6114 C Send correlation contributions to the preceding processor
6116 nn=num_cont_hb(iatel_s)
6117 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6118 cd write (iout,*) 'The BUFFER array:'
6120 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6122 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6124 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6125 C Clear the contacts of the atom passed to the neighboring processor
6126 nn=num_cont_hb(iatel_s+1)
6128 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6130 num_cont_hb(iatel_s)=0
6132 cd write (iout,*) 'Processor ',MyID,MyRank,
6133 cd & ' is sending correlation contribution to processor',MyID-1,
6134 cd & ' msglen=',msglen
6135 cd write (*,*) 'Processor ',MyID,MyRank,
6136 cd & ' is sending correlation contribution to processor',MyID-1,
6137 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6138 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6139 cd write (iout,*) 'Processor ',MyID,
6140 cd & ' has sent correlation contribution to processor',MyID-1,
6141 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6142 cd write (*,*) 'Processor ',MyID,
6143 cd & ' has sent correlation contribution to processor',MyID-1,
6144 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6146 endif ! (MyRank.gt.0)
6150 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6151 if (MyRank.lt.fgProcs-1) then
6152 C Receive correlation contributions from the next processor
6154 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6155 cd write (iout,*) 'Processor',MyID,
6156 cd & ' is receiving correlation contribution from processor',MyID+1,
6157 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6158 cd write (*,*) 'Processor',MyID,
6159 cd & ' is receiving correlation contribution from processor',MyID+1,
6160 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6162 do while (nbytes.le.0)
6163 call mp_probe(MyID+1,CorrelType,nbytes)
6165 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6166 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6167 cd write (iout,*) 'Processor',MyID,
6168 cd & ' has received correlation contribution from processor',MyID+1,
6169 cd & ' msglen=',msglen,' nbytes=',nbytes
6170 cd write (iout,*) 'The received BUFFER array:'
6172 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6174 if (msglen.eq.msglen1) then
6175 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6176 else if (msglen.eq.msglen2) then
6177 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6178 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6181 & 'ERROR!!!! message length changed while processing correlations.'
6183 & 'ERROR!!!! message length changed while processing correlations.'
6184 call mp_stopall(Error)
6185 endif ! msglen.eq.msglen1
6186 endif ! MyRank.lt.fgProcs-1
6193 write (iout,'(a)') 'Contact function values:'
6195 write (iout,'(2i3,50(1x,i2,f5.2))')
6196 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6197 & j=1,num_cont_hb(i))
6203 C Remove the loop below after debugging !!!
6210 C Calculate the dipole-dipole interaction energies
6211 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6212 do i=iatel_s,iatel_e+1
6213 num_conti=num_cont_hb(i)
6220 C Calculate the local-electrostatic correlation terms
6221 do i=iatel_s,iatel_e+1
6223 num_conti=num_cont_hb(i)
6224 num_conti1=num_cont_hb(i+1)
6229 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6230 c & ' jj=',jj,' kk=',kk
6231 if (j1.eq.j+1 .or. j1.eq.j-1) then
6232 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6233 C The system gains extra energy.
6235 sqd1=dsqrt(d_cont(jj,i))
6236 sqd2=dsqrt(d_cont(kk,i1))
6237 sred_geom = sqd1*sqd2
6238 IF (sred_geom.lt.cutoff_corr) THEN
6239 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6241 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6242 c & ' jj=',jj,' kk=',kk
6243 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6244 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6246 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6247 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6250 cd write (iout,*) 'sred_geom=',sred_geom,
6251 cd & ' ekont=',ekont,' fprim=',fprimcont
6252 call calc_eello(i,j,i+1,j1,jj,kk)
6253 if (wcorr4.gt.0.0d0)
6254 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6255 if (wcorr5.gt.0.0d0)
6256 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6257 c print *,"wcorr5",ecorr5
6258 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6259 cd write(2,*)'ijkl',i,j,i+1,j1
6260 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6261 & .or. wturn6.eq.0.0d0))then
6262 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6263 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6264 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6265 cd & 'ecorr6=',ecorr6
6266 cd write (iout,'(4e15.5)') sred_geom,
6267 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6268 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6269 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6270 else if (wturn6.gt.0.0d0
6271 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6272 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6273 eturn6=eturn6+eello_turn6(i,jj,kk)
6274 cd write (2,*) 'multibody_eello:eturn6',eturn6
6275 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6282 else if (j1.eq.j) then
6283 C Contacts I-J and I-(J+1) occur simultaneously.
6284 C The system loses extra energy.
6285 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6290 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6291 c & ' jj=',jj,' kk=',kk
6293 C Contacts I-J and (I+1)-J occur simultaneously.
6294 C The system loses extra energy.
6295 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6300 write (iout,*) "eturn6",eturn6,ecorr6
6303 c------------------------------------------------------------------------------
6304 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6305 implicit real*8 (a-h,o-z)
6306 include 'DIMENSIONS'
6307 include 'COMMON.IOUNITS'
6308 include 'COMMON.DERIV'
6309 include 'COMMON.INTERACT'
6310 include 'COMMON.CONTACTS'
6311 double precision gx(3),gx1(3)
6321 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6322 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6323 C Following 4 lines for diagnostics.
6328 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6330 c write (iout,*)'Contacts have occurred for peptide groups',
6331 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6332 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6333 C Calculate the multi-body contribution to energy.
6334 ecorr=ecorr+ekont*ees
6336 C Calculate multi-body contributions to the gradient.
6338 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6339 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6340 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6341 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6342 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6343 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6344 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6345 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6346 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6347 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6348 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6349 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6350 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6351 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6355 gradcorr(ll,m)=gradcorr(ll,m)+
6356 & ees*ekl*gacont_hbr(ll,jj,i)-
6357 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6358 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6363 gradcorr(ll,m)=gradcorr(ll,m)+
6364 & ees*eij*gacont_hbr(ll,kk,k)-
6365 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6366 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6373 C---------------------------------------------------------------------------
6374 subroutine dipole(i,j,jj)
6375 implicit real*8 (a-h,o-z)
6376 include 'DIMENSIONS'
6377 include 'DIMENSIONS.ZSCOPT'
6378 include 'COMMON.IOUNITS'
6379 include 'COMMON.CHAIN'
6380 include 'COMMON.FFIELD'
6381 include 'COMMON.DERIV'
6382 include 'COMMON.INTERACT'
6383 include 'COMMON.CONTACTS'
6384 include 'COMMON.TORSION'
6385 include 'COMMON.VAR'
6386 include 'COMMON.GEO'
6387 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6389 iti1 = itortyp(itype(i+1))
6390 if (j.lt.nres-1) then
6391 if (itype(j).le.ntyp) then
6392 itj1 = itortyp(itype(j+1))
6400 dipi(iii,1)=Ub2(iii,i)
6401 dipderi(iii)=Ub2der(iii,i)
6402 dipi(iii,2)=b1(iii,iti1)
6403 dipj(iii,1)=Ub2(iii,j)
6404 dipderj(iii)=Ub2der(iii,j)
6405 dipj(iii,2)=b1(iii,itj1)
6409 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6412 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6415 if (.not.calc_grad) return
6420 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6424 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6429 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6430 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6432 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6434 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6436 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6440 C---------------------------------------------------------------------------
6441 subroutine calc_eello(i,j,k,l,jj,kk)
6443 C This subroutine computes matrices and vectors needed to calculate
6444 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6446 implicit real*8 (a-h,o-z)
6447 include 'DIMENSIONS'
6448 include 'DIMENSIONS.ZSCOPT'
6449 include 'COMMON.IOUNITS'
6450 include 'COMMON.CHAIN'
6451 include 'COMMON.DERIV'
6452 include 'COMMON.INTERACT'
6453 include 'COMMON.CONTACTS'
6454 include 'COMMON.TORSION'
6455 include 'COMMON.VAR'
6456 include 'COMMON.GEO'
6457 include 'COMMON.FFIELD'
6458 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6459 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6462 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6463 cd & ' jj=',jj,' kk=',kk
6464 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6467 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6468 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6471 call transpose2(aa1(1,1),aa1t(1,1))
6472 call transpose2(aa2(1,1),aa2t(1,1))
6475 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6476 & aa1tder(1,1,lll,kkk))
6477 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6478 & aa2tder(1,1,lll,kkk))
6482 C parallel orientation of the two CA-CA-CA frames.
6483 if (i.gt.1 .and. itype(i).le.ntyp) then
6484 iti=itortyp(itype(i))
6488 itk1=itortyp(itype(k+1))
6489 itj=itortyp(itype(j))
6490 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6491 itl1=itortyp(itype(l+1))
6495 C A1 kernel(j+1) A2T
6497 cd write (iout,'(3f10.5,5x,3f10.5)')
6498 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6500 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6501 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6502 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6503 C Following matrices are needed only for 6-th order cumulants
6504 IF (wcorr6.gt.0.0d0) THEN
6505 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6506 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6507 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6508 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6509 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6510 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6511 & ADtEAderx(1,1,1,1,1,1))
6513 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6514 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6515 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6516 & ADtEA1derx(1,1,1,1,1,1))
6518 C End 6-th order cumulants
6521 cd write (2,*) 'In calc_eello6'
6523 cd write (2,*) 'iii=',iii
6525 cd write (2,*) 'kkk=',kkk
6527 cd write (2,'(3(2f10.5),5x)')
6528 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6533 call transpose2(EUgder(1,1,k),auxmat(1,1))
6534 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6535 call transpose2(EUg(1,1,k),auxmat(1,1))
6536 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6537 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6541 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6542 & EAEAderx(1,1,lll,kkk,iii,1))
6546 C A1T kernel(i+1) A2
6547 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6548 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6549 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6550 C Following matrices are needed only for 6-th order cumulants
6551 IF (wcorr6.gt.0.0d0) THEN
6552 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6553 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6554 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6555 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6556 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6557 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6558 & ADtEAderx(1,1,1,1,1,2))
6559 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6560 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6561 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6562 & ADtEA1derx(1,1,1,1,1,2))
6564 C End 6-th order cumulants
6565 call transpose2(EUgder(1,1,l),auxmat(1,1))
6566 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6567 call transpose2(EUg(1,1,l),auxmat(1,1))
6568 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6569 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6573 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6574 & EAEAderx(1,1,lll,kkk,iii,2))
6579 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6580 C They are needed only when the fifth- or the sixth-order cumulants are
6582 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6583 call transpose2(AEA(1,1,1),auxmat(1,1))
6584 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6585 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6586 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6587 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6588 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6589 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6590 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6591 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6592 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6593 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6594 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6595 call transpose2(AEA(1,1,2),auxmat(1,1))
6596 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6597 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6598 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6599 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6600 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6601 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6602 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6603 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6604 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6605 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6606 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6607 C Calculate the Cartesian derivatives of the vectors.
6611 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6612 call matvec2(auxmat(1,1),b1(1,iti),
6613 & AEAb1derx(1,lll,kkk,iii,1,1))
6614 call matvec2(auxmat(1,1),Ub2(1,i),
6615 & AEAb2derx(1,lll,kkk,iii,1,1))
6616 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6617 & AEAb1derx(1,lll,kkk,iii,2,1))
6618 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6619 & AEAb2derx(1,lll,kkk,iii,2,1))
6620 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6621 call matvec2(auxmat(1,1),b1(1,itj),
6622 & AEAb1derx(1,lll,kkk,iii,1,2))
6623 call matvec2(auxmat(1,1),Ub2(1,j),
6624 & AEAb2derx(1,lll,kkk,iii,1,2))
6625 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6626 & AEAb1derx(1,lll,kkk,iii,2,2))
6627 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6628 & AEAb2derx(1,lll,kkk,iii,2,2))
6635 C Antiparallel orientation of the two CA-CA-CA frames.
6636 if (i.gt.1 .and. itype(i).le.ntyp) then
6637 iti=itortyp(itype(i))
6641 itk1=itortyp(itype(k+1))
6642 itl=itortyp(itype(l))
6643 itj=itortyp(itype(j))
6644 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6645 itj1=itortyp(itype(j+1))
6649 C A2 kernel(j-1)T A1T
6650 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6651 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6652 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6653 C Following matrices are needed only for 6-th order cumulants
6654 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6655 & j.eq.i+4 .and. l.eq.i+3)) THEN
6656 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6657 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6658 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6659 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6660 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6661 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6662 & ADtEAderx(1,1,1,1,1,1))
6663 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6664 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6665 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6666 & ADtEA1derx(1,1,1,1,1,1))
6668 C End 6-th order cumulants
6669 call transpose2(EUgder(1,1,k),auxmat(1,1))
6670 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6671 call transpose2(EUg(1,1,k),auxmat(1,1))
6672 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6673 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6677 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6678 & EAEAderx(1,1,lll,kkk,iii,1))
6682 C A2T kernel(i+1)T A1
6683 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6684 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6685 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6686 C Following matrices are needed only for 6-th order cumulants
6687 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6688 & j.eq.i+4 .and. l.eq.i+3)) THEN
6689 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6690 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6691 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6692 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6693 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6694 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6695 & ADtEAderx(1,1,1,1,1,2))
6696 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6697 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6698 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6699 & ADtEA1derx(1,1,1,1,1,2))
6701 C End 6-th order cumulants
6702 call transpose2(EUgder(1,1,j),auxmat(1,1))
6703 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6704 call transpose2(EUg(1,1,j),auxmat(1,1))
6705 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6706 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6710 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6711 & EAEAderx(1,1,lll,kkk,iii,2))
6716 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6717 C They are needed only when the fifth- or the sixth-order cumulants are
6719 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6720 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6721 call transpose2(AEA(1,1,1),auxmat(1,1))
6722 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6723 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6724 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6725 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6726 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6727 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6728 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6729 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6730 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6731 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6732 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6733 call transpose2(AEA(1,1,2),auxmat(1,1))
6734 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6735 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6736 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6737 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6738 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6739 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6740 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6741 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6742 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6743 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6744 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6745 C Calculate the Cartesian derivatives of the vectors.
6749 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6750 call matvec2(auxmat(1,1),b1(1,iti),
6751 & AEAb1derx(1,lll,kkk,iii,1,1))
6752 call matvec2(auxmat(1,1),Ub2(1,i),
6753 & AEAb2derx(1,lll,kkk,iii,1,1))
6754 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6755 & AEAb1derx(1,lll,kkk,iii,2,1))
6756 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6757 & AEAb2derx(1,lll,kkk,iii,2,1))
6758 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6759 call matvec2(auxmat(1,1),b1(1,itl),
6760 & AEAb1derx(1,lll,kkk,iii,1,2))
6761 call matvec2(auxmat(1,1),Ub2(1,l),
6762 & AEAb2derx(1,lll,kkk,iii,1,2))
6763 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6764 & AEAb1derx(1,lll,kkk,iii,2,2))
6765 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6766 & AEAb2derx(1,lll,kkk,iii,2,2))
6775 C---------------------------------------------------------------------------
6776 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6777 & KK,KKderg,AKA,AKAderg,AKAderx)
6781 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6782 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6783 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6788 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6790 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6793 cd if (lprn) write (2,*) 'In kernel'
6795 cd if (lprn) write (2,*) 'kkk=',kkk
6797 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6798 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6800 cd write (2,*) 'lll=',lll
6801 cd write (2,*) 'iii=1'
6803 cd write (2,'(3(2f10.5),5x)')
6804 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6807 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6808 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6810 cd write (2,*) 'lll=',lll
6811 cd write (2,*) 'iii=2'
6813 cd write (2,'(3(2f10.5),5x)')
6814 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6821 C---------------------------------------------------------------------------
6822 double precision function eello4(i,j,k,l,jj,kk)
6823 implicit real*8 (a-h,o-z)
6824 include 'DIMENSIONS'
6825 include 'DIMENSIONS.ZSCOPT'
6826 include 'COMMON.IOUNITS'
6827 include 'COMMON.CHAIN'
6828 include 'COMMON.DERIV'
6829 include 'COMMON.INTERACT'
6830 include 'COMMON.CONTACTS'
6831 include 'COMMON.TORSION'
6832 include 'COMMON.VAR'
6833 include 'COMMON.GEO'
6834 double precision pizda(2,2),ggg1(3),ggg2(3)
6835 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6839 cd print *,'eello4:',i,j,k,l,jj,kk
6840 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6841 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6842 cold eij=facont_hb(jj,i)
6843 cold ekl=facont_hb(kk,k)
6845 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6847 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6848 gcorr_loc(k-1)=gcorr_loc(k-1)
6849 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6851 gcorr_loc(l-1)=gcorr_loc(l-1)
6852 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6854 gcorr_loc(j-1)=gcorr_loc(j-1)
6855 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6860 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6861 & -EAEAderx(2,2,lll,kkk,iii,1)
6862 cd derx(lll,kkk,iii)=0.0d0
6866 cd gcorr_loc(l-1)=0.0d0
6867 cd gcorr_loc(j-1)=0.0d0
6868 cd gcorr_loc(k-1)=0.0d0
6870 cd write (iout,*)'Contacts have occurred for peptide groups',
6871 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6872 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6873 if (j.lt.nres-1) then
6880 if (l.lt.nres-1) then
6888 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6889 ggg1(ll)=eel4*g_contij(ll,1)
6890 ggg2(ll)=eel4*g_contij(ll,2)
6891 ghalf=0.5d0*ggg1(ll)
6893 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6894 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6895 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6896 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6897 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6898 ghalf=0.5d0*ggg2(ll)
6900 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6901 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6902 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6903 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6908 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6909 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6914 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6915 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6921 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6926 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6930 cd write (2,*) iii,gcorr_loc(iii)
6934 cd write (2,*) 'ekont',ekont
6935 cd write (iout,*) 'eello4',ekont*eel4
6938 C---------------------------------------------------------------------------
6939 double precision function eello5(i,j,k,l,jj,kk)
6940 implicit real*8 (a-h,o-z)
6941 include 'DIMENSIONS'
6942 include 'DIMENSIONS.ZSCOPT'
6943 include 'COMMON.IOUNITS'
6944 include 'COMMON.CHAIN'
6945 include 'COMMON.DERIV'
6946 include 'COMMON.INTERACT'
6947 include 'COMMON.CONTACTS'
6948 include 'COMMON.TORSION'
6949 include 'COMMON.VAR'
6950 include 'COMMON.GEO'
6951 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6952 double precision ggg1(3),ggg2(3)
6953 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6958 C /l\ / \ \ / \ / \ / C
6959 C / \ / \ \ / \ / \ / C
6960 C j| o |l1 | o | o| o | | o |o C
6961 C \ |/k\| |/ \| / |/ \| |/ \| C
6962 C \i/ \ / \ / / \ / \ C
6964 C (I) (II) (III) (IV) C
6966 C eello5_1 eello5_2 eello5_3 eello5_4 C
6968 C Antiparallel chains C
6971 C /j\ / \ \ / \ / \ / C
6972 C / \ / \ \ / \ / \ / C
6973 C j1| o |l | o | o| o | | o |o C
6974 C \ |/k\| |/ \| / |/ \| |/ \| C
6975 C \i/ \ / \ / / \ / \ C
6977 C (I) (II) (III) (IV) C
6979 C eello5_1 eello5_2 eello5_3 eello5_4 C
6981 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6983 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6984 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6989 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6991 itk=itortyp(itype(k))
6992 itl=itortyp(itype(l))
6993 itj=itortyp(itype(j))
6998 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6999 cd & eel5_3_num,eel5_4_num)
7003 derx(lll,kkk,iii)=0.0d0
7007 cd eij=facont_hb(jj,i)
7008 cd ekl=facont_hb(kk,k)
7010 cd write (iout,*)'Contacts have occurred for peptide groups',
7011 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7013 C Contribution from the graph I.
7014 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7015 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7016 call transpose2(EUg(1,1,k),auxmat(1,1))
7017 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7018 vv(1)=pizda(1,1)-pizda(2,2)
7019 vv(2)=pizda(1,2)+pizda(2,1)
7020 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7021 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7023 C Explicit gradient in virtual-dihedral angles.
7024 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7025 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7026 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7027 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7028 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7029 vv(1)=pizda(1,1)-pizda(2,2)
7030 vv(2)=pizda(1,2)+pizda(2,1)
7031 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7032 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7033 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7034 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7035 vv(1)=pizda(1,1)-pizda(2,2)
7036 vv(2)=pizda(1,2)+pizda(2,1)
7038 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7039 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7040 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7042 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7043 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7044 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7046 C Cartesian gradient
7050 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7052 vv(1)=pizda(1,1)-pizda(2,2)
7053 vv(2)=pizda(1,2)+pizda(2,1)
7054 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7055 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7056 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7063 C Contribution from graph II
7064 call transpose2(EE(1,1,itk),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7066 vv(1)=pizda(1,1)+pizda(2,2)
7067 vv(2)=pizda(2,1)-pizda(1,2)
7068 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7069 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7071 C Explicit gradient in virtual-dihedral angles.
7072 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7073 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7074 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7075 vv(1)=pizda(1,1)+pizda(2,2)
7076 vv(2)=pizda(2,1)-pizda(1,2)
7078 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7079 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7080 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7082 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7083 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7084 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7086 C Cartesian gradient
7090 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7092 vv(1)=pizda(1,1)+pizda(2,2)
7093 vv(2)=pizda(2,1)-pizda(1,2)
7094 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7095 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7096 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7105 C Parallel orientation
7106 C Contribution from graph III
7107 call transpose2(EUg(1,1,l),auxmat(1,1))
7108 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7109 vv(1)=pizda(1,1)-pizda(2,2)
7110 vv(2)=pizda(1,2)+pizda(2,1)
7111 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7112 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7114 C Explicit gradient in virtual-dihedral angles.
7115 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7116 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7117 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7118 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7119 vv(1)=pizda(1,1)-pizda(2,2)
7120 vv(2)=pizda(1,2)+pizda(2,1)
7121 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7122 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7123 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7124 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7125 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7126 vv(1)=pizda(1,1)-pizda(2,2)
7127 vv(2)=pizda(1,2)+pizda(2,1)
7128 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7129 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7130 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7131 C Cartesian gradient
7135 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7137 vv(1)=pizda(1,1)-pizda(2,2)
7138 vv(2)=pizda(1,2)+pizda(2,1)
7139 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7140 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7141 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7147 C Contribution from graph IV
7149 call transpose2(EE(1,1,itl),auxmat(1,1))
7150 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7151 vv(1)=pizda(1,1)+pizda(2,2)
7152 vv(2)=pizda(2,1)-pizda(1,2)
7153 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7154 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7156 C Explicit gradient in virtual-dihedral angles.
7157 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7158 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7159 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7160 vv(1)=pizda(1,1)+pizda(2,2)
7161 vv(2)=pizda(2,1)-pizda(1,2)
7162 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7163 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7164 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7165 C Cartesian gradient
7169 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7171 vv(1)=pizda(1,1)+pizda(2,2)
7172 vv(2)=pizda(2,1)-pizda(1,2)
7173 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7174 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7175 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7181 C Antiparallel orientation
7182 C Contribution from graph III
7184 call transpose2(EUg(1,1,j),auxmat(1,1))
7185 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7186 vv(1)=pizda(1,1)-pizda(2,2)
7187 vv(2)=pizda(1,2)+pizda(2,1)
7188 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7189 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7191 C Explicit gradient in virtual-dihedral angles.
7192 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7193 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7194 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7195 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7196 vv(1)=pizda(1,1)-pizda(2,2)
7197 vv(2)=pizda(1,2)+pizda(2,1)
7198 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7199 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7200 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7201 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7202 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7203 vv(1)=pizda(1,1)-pizda(2,2)
7204 vv(2)=pizda(1,2)+pizda(2,1)
7205 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7206 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7207 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7208 C Cartesian gradient
7212 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7214 vv(1)=pizda(1,1)-pizda(2,2)
7215 vv(2)=pizda(1,2)+pizda(2,1)
7216 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7217 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7218 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7224 C Contribution from graph IV
7226 call transpose2(EE(1,1,itj),auxmat(1,1))
7227 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7228 vv(1)=pizda(1,1)+pizda(2,2)
7229 vv(2)=pizda(2,1)-pizda(1,2)
7230 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7231 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7233 C Explicit gradient in virtual-dihedral angles.
7234 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7235 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7236 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7237 vv(1)=pizda(1,1)+pizda(2,2)
7238 vv(2)=pizda(2,1)-pizda(1,2)
7239 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7240 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7241 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7242 C Cartesian gradient
7246 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7248 vv(1)=pizda(1,1)+pizda(2,2)
7249 vv(2)=pizda(2,1)-pizda(1,2)
7250 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7251 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7252 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7259 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7260 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7261 cd write (2,*) 'ijkl',i,j,k,l
7262 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7263 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7265 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7266 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7267 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7268 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7270 if (j.lt.nres-1) then
7277 if (l.lt.nres-1) then
7287 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7289 ggg1(ll)=eel5*g_contij(ll,1)
7290 ggg2(ll)=eel5*g_contij(ll,2)
7291 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7292 ghalf=0.5d0*ggg1(ll)
7294 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7295 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7296 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7297 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7298 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7299 ghalf=0.5d0*ggg2(ll)
7301 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7302 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7303 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7304 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7309 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7310 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7315 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7316 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7322 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7327 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7331 cd write (2,*) iii,g_corr5_loc(iii)
7335 cd write (2,*) 'ekont',ekont
7336 cd write (iout,*) 'eello5',ekont*eel5
7339 c--------------------------------------------------------------------------
7340 double precision function eello6(i,j,k,l,jj,kk)
7341 implicit real*8 (a-h,o-z)
7342 include 'DIMENSIONS'
7343 include 'DIMENSIONS.ZSCOPT'
7344 include 'COMMON.IOUNITS'
7345 include 'COMMON.CHAIN'
7346 include 'COMMON.DERIV'
7347 include 'COMMON.INTERACT'
7348 include 'COMMON.CONTACTS'
7349 include 'COMMON.TORSION'
7350 include 'COMMON.VAR'
7351 include 'COMMON.GEO'
7352 include 'COMMON.FFIELD'
7353 double precision ggg1(3),ggg2(3)
7354 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7359 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7367 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7368 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7372 derx(lll,kkk,iii)=0.0d0
7376 cd eij=facont_hb(jj,i)
7377 cd ekl=facont_hb(kk,k)
7383 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7384 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7385 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7386 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7387 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7388 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7390 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7391 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7392 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7393 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7394 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7395 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7399 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7401 C If turn contributions are considered, they will be handled separately.
7402 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7403 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7404 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7405 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7406 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7407 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7408 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7411 if (j.lt.nres-1) then
7418 if (l.lt.nres-1) then
7426 ggg1(ll)=eel6*g_contij(ll,1)
7427 ggg2(ll)=eel6*g_contij(ll,2)
7428 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7429 ghalf=0.5d0*ggg1(ll)
7431 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7432 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7433 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7434 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7435 ghalf=0.5d0*ggg2(ll)
7436 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7438 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7439 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7440 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7441 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7446 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7447 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7452 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7453 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7459 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7464 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7468 cd write (2,*) iii,g_corr6_loc(iii)
7472 cd write (2,*) 'ekont',ekont
7473 cd write (iout,*) 'eello6',ekont*eel6
7476 c--------------------------------------------------------------------------
7477 double precision function eello6_graph1(i,j,k,l,imat,swap)
7478 implicit real*8 (a-h,o-z)
7479 include 'DIMENSIONS'
7480 include 'DIMENSIONS.ZSCOPT'
7481 include 'COMMON.IOUNITS'
7482 include 'COMMON.CHAIN'
7483 include 'COMMON.DERIV'
7484 include 'COMMON.INTERACT'
7485 include 'COMMON.CONTACTS'
7486 include 'COMMON.TORSION'
7487 include 'COMMON.VAR'
7488 include 'COMMON.GEO'
7489 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7493 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7495 C Parallel Antiparallel C
7501 C \ j|/k\| / \ |/k\|l / C
7506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7507 itk=itortyp(itype(k))
7508 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7509 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7510 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7511 call transpose2(EUgC(1,1,k),auxmat(1,1))
7512 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7513 vv1(1)=pizda1(1,1)-pizda1(2,2)
7514 vv1(2)=pizda1(1,2)+pizda1(2,1)
7515 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7516 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7517 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7518 s5=scalar2(vv(1),Dtobr2(1,i))
7519 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7520 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7521 if (.not. calc_grad) return
7522 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7523 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7524 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7525 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7526 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7527 & +scalar2(vv(1),Dtobr2der(1,i)))
7528 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7529 vv1(1)=pizda1(1,1)-pizda1(2,2)
7530 vv1(2)=pizda1(1,2)+pizda1(2,1)
7531 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7532 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7534 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7535 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7536 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7537 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7538 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7540 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7541 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7542 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7543 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7544 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7546 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7547 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7548 vv1(1)=pizda1(1,1)-pizda1(2,2)
7549 vv1(2)=pizda1(1,2)+pizda1(2,1)
7550 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7551 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7552 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7553 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7562 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7563 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7564 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7565 call transpose2(EUgC(1,1,k),auxmat(1,1))
7566 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7568 vv1(1)=pizda1(1,1)-pizda1(2,2)
7569 vv1(2)=pizda1(1,2)+pizda1(2,1)
7570 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7571 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7572 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7573 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7574 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7575 s5=scalar2(vv(1),Dtobr2(1,i))
7576 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7582 c----------------------------------------------------------------------------
7583 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7584 implicit real*8 (a-h,o-z)
7585 include 'DIMENSIONS'
7586 include 'DIMENSIONS.ZSCOPT'
7587 include 'COMMON.IOUNITS'
7588 include 'COMMON.CHAIN'
7589 include 'COMMON.DERIV'
7590 include 'COMMON.INTERACT'
7591 include 'COMMON.CONTACTS'
7592 include 'COMMON.TORSION'
7593 include 'COMMON.VAR'
7594 include 'COMMON.GEO'
7596 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7597 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7602 C Parallel Antiparallel C
7608 C \ j|/k\| \ |/k\|l C
7613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7614 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7615 C AL 7/4/01 s1 would occur in the sixth-order moment,
7616 C but not in a cluster cumulant
7618 s1=dip(1,jj,i)*dip(1,kk,k)
7620 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7621 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7622 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7623 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7624 call transpose2(EUg(1,1,k),auxmat(1,1))
7625 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7626 vv(1)=pizda(1,1)-pizda(2,2)
7627 vv(2)=pizda(1,2)+pizda(2,1)
7628 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7629 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7631 eello6_graph2=-(s1+s2+s3+s4)
7633 eello6_graph2=-(s2+s3+s4)
7636 if (.not. calc_grad) return
7637 C Derivatives in gamma(i-1)
7640 s1=dipderg(1,jj,i)*dip(1,kk,k)
7642 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7643 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7644 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7645 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7647 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7649 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7651 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7653 C Derivatives in gamma(k-1)
7655 s1=dip(1,jj,i)*dipderg(1,kk,k)
7657 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7658 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7659 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7660 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7661 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7662 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7663 vv(1)=pizda(1,1)-pizda(2,2)
7664 vv(2)=pizda(1,2)+pizda(2,1)
7665 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7667 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7669 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7671 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7672 C Derivatives in gamma(j-1) or gamma(l-1)
7675 s1=dipderg(3,jj,i)*dip(1,kk,k)
7677 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7678 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7679 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7680 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7681 vv(1)=pizda(1,1)-pizda(2,2)
7682 vv(2)=pizda(1,2)+pizda(2,1)
7683 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7686 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7688 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7691 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7692 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7694 C Derivatives in gamma(l-1) or gamma(j-1)
7697 s1=dip(1,jj,i)*dipderg(3,kk,k)
7699 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7700 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7701 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7702 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7703 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7704 vv(1)=pizda(1,1)-pizda(2,2)
7705 vv(2)=pizda(1,2)+pizda(2,1)
7706 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7709 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7711 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7714 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7715 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7717 C Cartesian derivatives.
7719 write (2,*) 'In eello6_graph2'
7721 write (2,*) 'iii=',iii
7723 write (2,*) 'kkk=',kkk
7725 write (2,'(3(2f10.5),5x)')
7726 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7736 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7738 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7741 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7743 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7744 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7746 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7747 call transpose2(EUg(1,1,k),auxmat(1,1))
7748 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7750 vv(1)=pizda(1,1)-pizda(2,2)
7751 vv(2)=pizda(1,2)+pizda(2,1)
7752 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7753 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7755 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7757 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7760 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7762 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7769 c----------------------------------------------------------------------------
7770 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7771 implicit real*8 (a-h,o-z)
7772 include 'DIMENSIONS'
7773 include 'DIMENSIONS.ZSCOPT'
7774 include 'COMMON.IOUNITS'
7775 include 'COMMON.CHAIN'
7776 include 'COMMON.DERIV'
7777 include 'COMMON.INTERACT'
7778 include 'COMMON.CONTACTS'
7779 include 'COMMON.TORSION'
7780 include 'COMMON.VAR'
7781 include 'COMMON.GEO'
7782 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7786 C Parallel Antiparallel C
7792 C j|/k\| / |/k\|l / C
7797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7799 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7800 C energy moment and not to the cluster cumulant.
7801 iti=itortyp(itype(i))
7802 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7803 itj1=itortyp(itype(j+1))
7807 itk=itortyp(itype(k))
7808 itk1=itortyp(itype(k+1))
7809 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7810 itl1=itortyp(itype(l+1))
7815 s1=dip(4,jj,i)*dip(4,kk,k)
7817 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7818 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7819 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7820 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7821 call transpose2(EE(1,1,itk),auxmat(1,1))
7822 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7823 vv(1)=pizda(1,1)+pizda(2,2)
7824 vv(2)=pizda(2,1)-pizda(1,2)
7825 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7826 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7828 eello6_graph3=-(s1+s2+s3+s4)
7830 eello6_graph3=-(s2+s3+s4)
7833 if (.not. calc_grad) return
7834 C Derivatives in gamma(k-1)
7835 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7836 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7837 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7838 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7839 C Derivatives in gamma(l-1)
7840 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7841 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7842 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7843 vv(1)=pizda(1,1)+pizda(2,2)
7844 vv(2)=pizda(2,1)-pizda(1,2)
7845 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7846 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7847 C Cartesian derivatives.
7853 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7855 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7858 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7860 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7861 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7863 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7864 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7866 vv(1)=pizda(1,1)+pizda(2,2)
7867 vv(2)=pizda(2,1)-pizda(1,2)
7868 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7870 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7872 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7875 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7877 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7879 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7885 c----------------------------------------------------------------------------
7886 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7887 implicit real*8 (a-h,o-z)
7888 include 'DIMENSIONS'
7889 include 'DIMENSIONS.ZSCOPT'
7890 include 'COMMON.IOUNITS'
7891 include 'COMMON.CHAIN'
7892 include 'COMMON.DERIV'
7893 include 'COMMON.INTERACT'
7894 include 'COMMON.CONTACTS'
7895 include 'COMMON.TORSION'
7896 include 'COMMON.VAR'
7897 include 'COMMON.GEO'
7898 include 'COMMON.FFIELD'
7899 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7900 & auxvec1(2),auxmat1(2,2)
7902 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7904 C Parallel Antiparallel C
7910 C \ j|/k\| \ |/k\|l C
7915 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7917 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7918 C energy moment and not to the cluster cumulant.
7919 cd write (2,*) 'eello_graph4: wturn6',wturn6
7920 iti=itortyp(itype(i))
7921 itj=itortyp(itype(j))
7922 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7923 itj1=itortyp(itype(j+1))
7927 itk=itortyp(itype(k))
7928 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7929 itk1=itortyp(itype(k+1))
7933 itl=itortyp(itype(l))
7934 if (l.lt.nres-1) then
7935 itl1=itortyp(itype(l+1))
7939 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7940 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7941 cd & ' itl',itl,' itl1',itl1
7944 s1=dip(3,jj,i)*dip(3,kk,k)
7946 s1=dip(2,jj,j)*dip(2,kk,l)
7949 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7950 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7952 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7953 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7955 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7956 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7958 call transpose2(EUg(1,1,k),auxmat(1,1))
7959 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7960 vv(1)=pizda(1,1)-pizda(2,2)
7961 vv(2)=pizda(2,1)+pizda(1,2)
7962 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7963 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7965 eello6_graph4=-(s1+s2+s3+s4)
7967 eello6_graph4=-(s2+s3+s4)
7969 if (.not. calc_grad) return
7970 C Derivatives in gamma(i-1)
7974 s1=dipderg(2,jj,i)*dip(3,kk,k)
7976 s1=dipderg(4,jj,j)*dip(2,kk,l)
7979 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7981 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7982 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7984 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7985 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7987 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7988 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7989 cd write (2,*) 'turn6 derivatives'
7991 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7993 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7997 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7999 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8003 C Derivatives in gamma(k-1)
8006 s1=dip(3,jj,i)*dipderg(2,kk,k)
8008 s1=dip(2,jj,j)*dipderg(4,kk,l)
8011 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8012 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8014 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8015 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8017 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8018 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8020 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8021 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8022 vv(1)=pizda(1,1)-pizda(2,2)
8023 vv(2)=pizda(2,1)+pizda(1,2)
8024 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8025 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8027 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8029 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8033 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8035 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8038 C Derivatives in gamma(j-1) or gamma(l-1)
8039 if (l.eq.j+1 .and. l.gt.1) then
8040 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8041 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8042 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8043 vv(1)=pizda(1,1)-pizda(2,2)
8044 vv(2)=pizda(2,1)+pizda(1,2)
8045 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8046 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8047 else if (j.gt.1) then
8048 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8049 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8050 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8051 vv(1)=pizda(1,1)-pizda(2,2)
8052 vv(2)=pizda(2,1)+pizda(1,2)
8053 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8054 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8055 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8057 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8060 C Cartesian derivatives.
8067 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8069 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8073 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8075 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8079 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8081 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8083 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8084 & b1(1,itj1),auxvec(1))
8085 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8087 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8088 & b1(1,itl1),auxvec(1))
8089 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8091 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8093 vv(1)=pizda(1,1)-pizda(2,2)
8094 vv(2)=pizda(2,1)+pizda(1,2)
8095 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8097 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8099 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8102 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8105 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8108 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8110 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8112 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8116 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8118 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8121 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8123 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8131 c----------------------------------------------------------------------------
8132 double precision function eello_turn6(i,jj,kk)
8133 implicit real*8 (a-h,o-z)
8134 include 'DIMENSIONS'
8135 include 'DIMENSIONS.ZSCOPT'
8136 include 'COMMON.IOUNITS'
8137 include 'COMMON.CHAIN'
8138 include 'COMMON.DERIV'
8139 include 'COMMON.INTERACT'
8140 include 'COMMON.CONTACTS'
8141 include 'COMMON.TORSION'
8142 include 'COMMON.VAR'
8143 include 'COMMON.GEO'
8144 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8145 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8147 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8148 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8149 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8150 C the respective energy moment and not to the cluster cumulant.
8155 iti=itortyp(itype(i))
8156 itk=itortyp(itype(k))
8157 itk1=itortyp(itype(k+1))
8158 itl=itortyp(itype(l))
8159 itj=itortyp(itype(j))
8160 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8161 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8162 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8167 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8169 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8173 derx_turn(lll,kkk,iii)=0.0d0
8180 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8182 cd write (2,*) 'eello6_5',eello6_5
8184 call transpose2(AEA(1,1,1),auxmat(1,1))
8185 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8186 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8187 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8191 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8192 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8193 s2 = scalar2(b1(1,itk),vtemp1(1))
8195 call transpose2(AEA(1,1,2),atemp(1,1))
8196 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8197 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8198 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8202 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8203 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8204 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8206 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8207 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8208 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8209 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8210 ss13 = scalar2(b1(1,itk),vtemp4(1))
8211 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8215 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8221 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8223 C Derivatives in gamma(i+2)
8225 call transpose2(AEA(1,1,1),auxmatd(1,1))
8226 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8227 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8228 call transpose2(AEAderg(1,1,2),atempd(1,1))
8229 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8230 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8234 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8235 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8236 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8242 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8243 C Derivatives in gamma(i+3)
8245 call transpose2(AEA(1,1,1),auxmatd(1,1))
8246 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8247 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8248 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8252 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8253 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8254 s2d = scalar2(b1(1,itk),vtemp1d(1))
8256 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8257 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8259 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8261 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8262 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8263 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8273 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8274 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8276 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8277 & -0.5d0*ekont*(s2d+s12d)
8279 C Derivatives in gamma(i+4)
8280 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8281 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8282 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8284 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8285 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8286 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8296 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8298 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8300 C Derivatives in gamma(i+5)
8302 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8303 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8304 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8308 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8309 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8310 s2d = scalar2(b1(1,itk),vtemp1d(1))
8312 call transpose2(AEA(1,1,2),atempd(1,1))
8313 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8314 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8318 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8319 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8321 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8322 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8323 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8333 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8334 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8336 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8337 & -0.5d0*ekont*(s2d+s12d)
8339 C Cartesian derivatives
8344 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8345 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8346 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8350 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8351 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8353 s2d = scalar2(b1(1,itk),vtemp1d(1))
8355 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8356 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8357 s8d = -(atempd(1,1)+atempd(2,2))*
8358 & scalar2(cc(1,1,itl),vtemp2(1))
8362 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8364 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8365 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8372 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8375 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8379 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8380 & - 0.5d0*(s8d+s12d)
8382 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8391 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8393 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8394 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8395 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8396 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8397 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8399 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8400 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8401 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8405 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8406 cd & 16*eel_turn6_num
8408 if (j.lt.nres-1) then
8415 if (l.lt.nres-1) then
8423 ggg1(ll)=eel_turn6*g_contij(ll,1)
8424 ggg2(ll)=eel_turn6*g_contij(ll,2)
8425 ghalf=0.5d0*ggg1(ll)
8427 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8428 & +ekont*derx_turn(ll,2,1)
8429 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8430 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8431 & +ekont*derx_turn(ll,4,1)
8432 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8433 ghalf=0.5d0*ggg2(ll)
8435 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8436 & +ekont*derx_turn(ll,2,2)
8437 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8438 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8439 & +ekont*derx_turn(ll,4,2)
8440 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8445 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8450 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8456 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8461 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8465 cd write (2,*) iii,g_corr6_loc(iii)
8468 eello_turn6=ekont*eel_turn6
8469 cd write (2,*) 'ekont',ekont
8470 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8473 crc-------------------------------------------------
8474 SUBROUTINE MATVEC2(A1,V1,V2)
8475 implicit real*8 (a-h,o-z)
8476 include 'DIMENSIONS'
8477 DIMENSION A1(2,2),V1(2),V2(2)
8481 c 3 VI=VI+A1(I,K)*V1(K)
8485 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8486 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8491 C---------------------------------------
8492 SUBROUTINE MATMAT2(A1,A2,A3)
8493 implicit real*8 (a-h,o-z)
8494 include 'DIMENSIONS'
8495 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8496 c DIMENSION AI3(2,2)
8500 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8506 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8507 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8508 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8509 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8517 c-------------------------------------------------------------------------
8518 double precision function scalar2(u,v)
8520 double precision u(2),v(2)
8523 scalar2=u(1)*v(1)+u(2)*v(2)
8527 C-----------------------------------------------------------------------------
8529 subroutine transpose2(a,at)
8531 double precision a(2,2),at(2,2)
8538 c--------------------------------------------------------------------------
8539 subroutine transpose(n,a,at)
8542 double precision a(n,n),at(n,n)
8550 C---------------------------------------------------------------------------
8551 subroutine prodmat3(a1,a2,kk,transp,prod)
8554 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8556 crc double precision auxmat(2,2),prod_(2,2)
8559 crc call transpose2(kk(1,1),auxmat(1,1))
8560 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8561 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8563 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8564 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8565 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8566 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8567 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8568 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8569 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8570 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8573 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8574 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8576 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8577 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8578 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8579 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8580 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8581 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8582 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8583 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8586 c call transpose2(a2(1,1),a2t(1,1))
8589 crc print *,((prod_(i,j),i=1,2),j=1,2)
8590 crc print *,((prod(i,j),i=1,2),j=1,2)
8594 C-----------------------------------------------------------------------------
8595 double precision function scalar(u,v)
8597 double precision u(3),v(3)
8607 C-----------------------------------------------------------------------
8608 double precision function sscale(r)
8609 double precision r,gamm
8610 include "COMMON.SPLITELE"
8611 if(r.lt.r_cut-rlamb) then
8613 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8614 gamm=(r-(r_cut-rlamb))/rlamb
8615 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8621 C-----------------------------------------------------------------------
8622 C-----------------------------------------------------------------------
8623 double precision function sscagrad(r)
8624 double precision r,gamm
8625 include "COMMON.SPLITELE"
8626 if(r.lt.r_cut-rlamb) then
8628 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8629 gamm=(r-(r_cut-rlamb))/rlamb
8630 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8636 C-----------------------------------------------------------------------
8637 C-----------------------------------------------------------------------
8638 double precision function sscalelip(r)
8639 double precision r,gamm
8640 include "COMMON.SPLITELE"
8641 C if(r.lt.r_cut-rlamb) then
8643 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8644 C gamm=(r-(r_cut-rlamb))/rlamb
8645 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8651 C-----------------------------------------------------------------------
8652 double precision function sscagradlip(r)
8653 double precision r,gamm
8654 include "COMMON.SPLITELE"
8655 C if(r.lt.r_cut-rlamb) then
8657 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8658 C gamm=(r-(r_cut-rlamb))/rlamb
8659 sscagradlip=r*(6*r-6.0d0)
8665 c----------------------------------------------------------------------------
8666 double precision function sscale2(r,r_cut,r0,rlamb)
8668 double precision r,gamm,r_cut,r0,rlamb,rr
8670 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
8671 c write (2,*) "rr",rr
8672 if(rr.lt.r_cut-rlamb) then
8674 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8675 gamm=(rr-(r_cut-rlamb))/rlamb
8676 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8682 C-----------------------------------------------------------------------
8683 double precision function sscalgrad2(r,r_cut,r0,rlamb)
8685 double precision r,gamm,r_cut,r0,rlamb,rr
8687 if(rr.lt.r_cut-rlamb) then
8689 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8690 gamm=(rr-(r_cut-rlamb))/rlamb
8692 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
8694 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
8701 c----------------------------------------------------------------------------
8702 subroutine e_saxs(Esaxs_constr)
8704 include 'DIMENSIONS'
8705 include 'DIMENSIONS.ZSCOPT'
8706 include 'DIMENSIONS.FREE'
8709 include "COMMON.SETUP"
8712 include 'COMMON.SBRIDGE'
8713 include 'COMMON.CHAIN'
8714 include 'COMMON.GEO'
8715 include 'COMMON.LOCAL'
8716 include 'COMMON.INTERACT'
8717 include 'COMMON.VAR'
8718 include 'COMMON.IOUNITS'
8719 include 'COMMON.DERIV'
8720 include 'COMMON.CONTROL'
8721 include 'COMMON.NAMES'
8722 include 'COMMON.FFIELD'
8723 include 'COMMON.LANGEVIN'
8725 double precision Esaxs_constr
8726 integer i,iint,j,k,l
8727 double precision PgradC(maxSAXS,3,maxres),
8728 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
8730 double precision PgradC_(maxSAXS,3,maxres),
8731 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
8733 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
8734 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
8735 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
8736 & auxX,auxX1,CACAgrad,Cnorm
8737 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
8738 double precision dist
8740 c SAXS restraint penalty function
8742 write(iout,*) "------- SAXS penalty function start -------"
8743 write (iout,*) "nsaxs",nsaxs
8744 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
8745 write (iout,*) "Psaxs"
8747 write (iout,'(i5,e15.5)') i, Psaxs(i)
8750 Esaxs_constr = 0.0d0
8760 do i=iatsc_s,iatsc_e
8761 if (itype(i).eq.ntyp1) cycle
8762 do iint=1,nint_gr(i)
8763 do j=istart(i,iint),iend(i,iint)
8764 if (itype(j).eq.ntyp1) cycle
8767 dijCASC=dist(i,j+nres)
8768 dijSCCA=dist(i+nres,j)
8769 dijSCSC=dist(i+nres,j+nres)
8770 sigma2CACA=2.0d0/(pstok**2)
8771 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
8772 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
8773 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
8776 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8777 if (itype(j).ne.10) then
8778 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
8782 if (itype(i).ne.10) then
8783 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
8787 if (itype(i).ne.10 .and. itype(j).ne.10) then
8788 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
8792 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
8794 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8796 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8797 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
8798 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
8799 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
8802 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8803 PgradC(k,l,i) = PgradC(k,l,i)-aux
8804 PgradC(k,l,j) = PgradC(k,l,j)+aux
8806 if (itype(j).ne.10) then
8807 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
8808 PgradC(k,l,i) = PgradC(k,l,i)-aux
8809 PgradC(k,l,j) = PgradC(k,l,j)+aux
8810 PgradX(k,l,j) = PgradX(k,l,j)+aux
8813 if (itype(i).ne.10) then
8814 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
8815 PgradX(k,l,i) = PgradX(k,l,i)-aux
8816 PgradC(k,l,i) = PgradC(k,l,i)-aux
8817 PgradC(k,l,j) = PgradC(k,l,j)+aux
8820 if (itype(i).ne.10 .and. itype(j).ne.10) then
8821 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
8822 PgradC(k,l,i) = PgradC(k,l,i)-aux
8823 PgradC(k,l,j) = PgradC(k,l,j)+aux
8824 PgradX(k,l,i) = PgradX(k,l,i)-aux
8825 PgradX(k,l,j) = PgradX(k,l,j)+aux
8831 sigma2CACA=scal_rad**2*0.25d0/
8832 & (restok(itype(j))**2+restok(itype(i))**2)
8834 IF (saxs_cutoff.eq.0) THEN
8837 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8838 Pcalc(k) = Pcalc(k)+expCACA
8839 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8841 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8842 PgradC(k,l,i) = PgradC(k,l,i)-aux
8843 PgradC(k,l,j) = PgradC(k,l,j)+aux
8847 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
8850 c write (2,*) "ijk",i,j,k
8851 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
8852 if (sss2.eq.0.0d0) cycle
8853 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
8854 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
8855 Pcalc(k) = Pcalc(k)+expCACA
8857 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8859 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
8860 & ssgrad2*expCACA/sss2
8863 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8864 PgradC(k,l,i) = PgradC(k,l,i)+aux
8865 PgradC(k,l,j) = PgradC(k,l,j)-aux
8874 if (nfgtasks.gt.1) then
8875 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
8876 & MPI_SUM,king,FG_COMM,IERR)
8877 if (fg_rank.eq.king) then
8879 Pcalc(k) = Pcalc_(k)
8882 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
8883 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8884 if (fg_rank.eq.king) then
8888 PgradC(k,l,i) = PgradC_(k,l,i)
8894 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
8895 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8896 if (fg_rank.eq.king) then
8900 PgradX(k,l,i) = PgradX_(k,l,i)
8909 if (fg_rank.eq.king) then
8913 Cnorm = Cnorm + Pcalc(k)
8915 Esaxs_constr = dlog(Cnorm)-wsaxs0
8917 if (Pcalc(k).gt.0.0d0)
8918 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
8920 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
8924 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
8934 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
8935 auxC1 = auxC1+PgradC(k,l,i)
8937 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
8938 auxX1 = auxX1+PgradX(k,l,i)
8941 gsaxsC(l,i) = auxC - auxC1/Cnorm
8943 gsaxsX(l,i) = auxX - auxX1/Cnorm
8945 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
8946 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
8954 c----------------------------------------------------------------------------
8955 subroutine e_saxsC(Esaxs_constr)
8957 include 'DIMENSIONS'
8958 include 'DIMENSIONS.ZSCOPT'
8959 include 'DIMENSIONS.FREE'
8962 include "COMMON.SETUP"
8965 include 'COMMON.SBRIDGE'
8966 include 'COMMON.CHAIN'
8967 include 'COMMON.GEO'
8968 include 'COMMON.LOCAL'
8969 include 'COMMON.INTERACT'
8970 include 'COMMON.VAR'
8971 include 'COMMON.IOUNITS'
8972 include 'COMMON.DERIV'
8973 include 'COMMON.CONTROL'
8974 include 'COMMON.NAMES'
8975 include 'COMMON.FFIELD'
8976 include 'COMMON.LANGEVIN'
8978 double precision Esaxs_constr
8979 integer i,iint,j,k,l
8980 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
8982 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
8984 double precision dk,dijCASPH,dijSCSPH,
8985 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
8986 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
8988 c SAXS restraint penalty function
8990 write(iout,*) "------- SAXS penalty function start -------"
8991 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
8992 & " isaxs_end",isaxs_end
8993 write (iout,*) "nnt",nnt," ntc",nct
8995 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
8996 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
8999 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9002 Esaxs_constr = 0.0d0
9004 do j=isaxs_start,isaxs_end
9016 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9018 if (itype(i).ne.10) then
9020 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9023 sigma2CA=2.0d0/pstok**2
9024 sigma2SC=4.0d0/restok(itype(i))**2
9025 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9026 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9027 Pcalc = Pcalc+expCASPH+expSCSPH
9029 write(*,*) "processor i j Pcalc",
9030 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
9032 CASPHgrad = sigma2CA*expCASPH
9033 SCSPHgrad = sigma2SC*expSCSPH
9035 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9036 PgradX(l,i) = PgradX(l,i) + aux
9037 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9042 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
9043 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
9046 logPtot = logPtot - dlog(Pcalc)
9047 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
9048 c & " logPtot",logPtot
9051 if (nfgtasks.gt.1) then
9052 c write (iout,*) "logPtot before reduction",logPtot
9053 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9054 & MPI_SUM,king,FG_COMM,IERR)
9056 c write (iout,*) "logPtot after reduction",logPtot
9057 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9058 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9059 if (fg_rank.eq.king) then
9062 gsaxsC(l,i) = gsaxsC_(l,i)
9066 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9067 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9068 if (fg_rank.eq.king) then
9071 gsaxsX(l,i) = gsaxsX_(l,i)
9077 Esaxs_constr = logPtot