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.ZSCOPT'
3225 include 'DIMENSIONS.FREE'
3226 include 'COMMON.SBRIDGE'
3227 include 'COMMON.CHAIN'
3228 include 'COMMON.DERIV'
3229 include 'COMMON.VAR'
3230 include 'COMMON.INTERACT'
3231 include 'COMMON.CONTROL'
3232 include 'COMMON.IOUNITS'
3235 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3236 cd print *,'link_start=',link_start,' link_end=',link_end
3237 C write(iout,*) link_end, "link_end"
3238 if (link_end.eq.0) return
3239 do i=link_start,link_end
3240 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3241 C CA-CA distance used in regularization of structure.
3244 C iii and jjj point to the residues for which the distance is assigned.
3245 if (ii.gt.nres) then
3252 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3253 C distance and angle dependent SS bond potential.
3254 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3255 C & iabs(itype(jjj)).eq.1) then
3256 C write(iout,*) constr_dist,"const"
3257 if (.not.dyn_ss .and. i.le.nss) then
3258 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3259 & iabs(itype(jjj)).eq.1) then
3260 call ssbond_ene(iii,jjj,eij)
3263 else if (ii.gt.nres .and. jj.gt.nres) then
3264 c Restraints from contact prediction
3266 if (constr_dist.eq.11) then
3267 C ehpb=ehpb+fordepth(i)**4.0d0
3268 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3269 ehpb=ehpb+fordepth(i)**4.0d0
3270 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3271 fac=fordepth(i)**4.0d0
3272 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3273 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3274 C & ehpb,fordepth(i),dd
3275 C write(iout,*) ehpb,"atu?"
3277 C fac=fordepth(i)**4.0d0
3278 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3280 if (dhpb1(i).gt.0.0d0) then
3281 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3282 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3283 c write (iout,*) "beta nmr",
3284 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3288 C Get the force constant corresponding to this distance.
3290 C Calculate the contribution to energy.
3291 ehpb=ehpb+waga*rdis*rdis
3292 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3294 C Evaluate gradient.
3297 endif !end dhpb1(i).gt.0
3298 endif !end const_dist=11
3300 ggg(j)=fac*(c(j,jj)-c(j,ii))
3303 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3304 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3307 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3308 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3311 C write(iout,*) "before"
3313 C write(iout,*) "after",dd
3314 if (constr_dist.eq.11) then
3315 ehpb=ehpb+fordepth(i)**4.0d0
3316 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3317 fac=fordepth(i)**4.0d0
3318 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3319 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3320 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3321 C print *,ehpb,"tu?"
3322 C write(iout,*) ehpb,"btu?",
3323 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3324 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3325 C & ehpb,fordepth(i),dd
3327 if (dhpb1(i).gt.0.0d0) then
3328 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3329 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3330 c write (iout,*) "alph nmr",
3331 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3334 C Get the force constant corresponding to this distance.
3336 C Calculate the contribution to energy.
3337 ehpb=ehpb+waga*rdis*rdis
3338 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3340 C Evaluate gradient.
3347 ggg(j)=fac*(c(j,jj)-c(j,ii))
3349 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3350 C If this is a SC-SC distance, we need to calculate the contributions to the
3351 C Cartesian gradient in the SC vectors (ghpbx).
3354 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3355 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3360 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3365 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3368 C--------------------------------------------------------------------------
3369 subroutine ssbond_ene(i,j,eij)
3371 C Calculate the distance and angle dependent SS-bond potential energy
3372 C using a free-energy function derived based on RHF/6-31G** ab initio
3373 C calculations of diethyl disulfide.
3375 C A. Liwo and U. Kozlowska, 11/24/03
3377 implicit real*8 (a-h,o-z)
3378 include 'DIMENSIONS'
3379 include 'DIMENSIONS.ZSCOPT'
3380 include 'COMMON.SBRIDGE'
3381 include 'COMMON.CHAIN'
3382 include 'COMMON.DERIV'
3383 include 'COMMON.LOCAL'
3384 include 'COMMON.INTERACT'
3385 include 'COMMON.VAR'
3386 include 'COMMON.IOUNITS'
3387 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3388 itypi=iabs(itype(i))
3392 dxi=dc_norm(1,nres+i)
3393 dyi=dc_norm(2,nres+i)
3394 dzi=dc_norm(3,nres+i)
3395 dsci_inv=dsc_inv(itypi)
3396 itypj=iabs(itype(j))
3397 dscj_inv=dsc_inv(itypj)
3401 dxj=dc_norm(1,nres+j)
3402 dyj=dc_norm(2,nres+j)
3403 dzj=dc_norm(3,nres+j)
3404 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3409 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3410 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3411 om12=dxi*dxj+dyi*dyj+dzi*dzj
3413 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3414 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3420 deltat12=om2-om1+2.0d0
3422 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3423 & +akct*deltad*deltat12
3424 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3425 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3426 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3427 c & " deltat12",deltat12," eij",eij
3428 ed=2*akcm*deltad+akct*deltat12
3430 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3431 eom1=-2*akth*deltat1-pom1-om2*pom2
3432 eom2= 2*akth*deltat2+pom1-om1*pom2
3435 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3438 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3439 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3440 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3441 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3444 C Calculate the components of the gradient in DC and X
3448 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3453 C--------------------------------------------------------------------------
3454 c MODELLER restraint function
3455 subroutine e_modeller(ehomology_constr)
3456 implicit real*8 (a-h,o-z)
3457 include 'DIMENSIONS'
3458 include 'DIMENSIONS.ZSCOPT'
3459 include 'DIMENSIONS.FREE'
3460 integer nnn, i, j, k, ki, irec, l
3461 integer katy, odleglosci, test7
3462 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3463 real*8 distance(max_template),distancek(max_template),
3464 & min_odl,godl(max_template),dih_diff(max_template)
3467 c FP - 30/10/2014 Temporary specifications for homology restraints
3469 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3471 double precision, dimension (maxres) :: guscdiff,usc_diff
3472 double precision, dimension (max_template) ::
3473 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3476 include 'COMMON.SBRIDGE'
3477 include 'COMMON.CHAIN'
3478 include 'COMMON.GEO'
3479 include 'COMMON.DERIV'
3480 include 'COMMON.LOCAL'
3481 include 'COMMON.INTERACT'
3482 include 'COMMON.VAR'
3483 include 'COMMON.IOUNITS'
3484 include 'COMMON.CONTROL'
3485 include 'COMMON.HOMRESTR'
3487 include 'COMMON.SETUP'
3488 include 'COMMON.NAMES'
3491 distancek(i)=9999999.9
3496 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3498 C AL 5/2/14 - Introduce list of restraints
3499 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3501 write(iout,*) "------- dist restrs start -------"
3503 do ii = link_start_homo,link_end_homo
3507 c write (iout,*) "dij(",i,j,") =",dij
3509 do k=1,constr_homology
3510 if(.not.l_homo(k,ii)) then
3514 distance(k)=odl(k,ii)-dij
3515 c write (iout,*) "distance(",k,") =",distance(k)
3517 c For Gaussian-type Urestr
3519 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3520 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3521 c write (iout,*) "distancek(",k,") =",distancek(k)
3522 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3524 c For Lorentzian-type Urestr
3526 if (waga_dist.lt.0.0d0) then
3527 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3528 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3529 & (distance(k)**2+sigma_odlir(k,ii)**2))
3533 c min_odl=minval(distancek)
3534 do kk=1,constr_homology
3535 if(l_homo(kk,ii)) then
3536 min_odl=distancek(kk)
3540 do kk=1,constr_homology
3541 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3542 & min_odl=distancek(kk)
3544 c write (iout,* )"min_odl",min_odl
3546 write (iout,*) "ij dij",i,j,dij
3547 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3548 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3549 write (iout,* )"min_odl",min_odl
3554 if (waga_dist.ge.0.0d0) then
3560 do k=1,constr_homology
3561 c Nie wiem po co to liczycie jeszcze raz!
3562 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3563 c & (2*(sigma_odl(i,j,k))**2))
3564 if(.not.l_homo(k,ii)) cycle
3565 if (waga_dist.ge.0.0d0) then
3567 c For Gaussian-type Urestr
3569 godl(k)=dexp(-distancek(k)+min_odl)
3570 odleg2=odleg2+godl(k)
3572 c For Lorentzian-type Urestr
3575 odleg2=odleg2+distancek(k)
3578 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3579 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3580 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3581 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3584 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3585 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3587 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3588 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3590 if (waga_dist.ge.0.0d0) then
3592 c For Gaussian-type Urestr
3594 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3596 c For Lorentzian-type Urestr
3599 odleg=odleg+odleg2/constr_homology
3603 c write (iout,*) "odleg",odleg ! sum of -ln-s
3606 c For Gaussian-type Urestr
3608 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3610 do k=1,constr_homology
3611 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3612 c & *waga_dist)+min_odl
3613 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3615 if(.not.l_homo(k,ii)) cycle
3616 if (waga_dist.ge.0.0d0) then
3617 c For Gaussian-type Urestr
3619 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3621 c For Lorentzian-type Urestr
3624 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3625 & sigma_odlir(k,ii)**2)**2)
3627 sum_sgodl=sum_sgodl+sgodl
3629 c sgodl2=sgodl2+sgodl
3630 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3631 c write(iout,*) "constr_homology=",constr_homology
3632 c write(iout,*) i, j, k, "TEST K"
3634 if (waga_dist.ge.0.0d0) then
3636 c For Gaussian-type Urestr
3638 grad_odl3=waga_homology(iset)*waga_dist
3639 & *sum_sgodl/(sum_godl*dij)
3641 c For Lorentzian-type Urestr
3644 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3645 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3646 grad_odl3=-waga_homology(iset)*waga_dist*
3647 & sum_sgodl/(constr_homology*dij)
3650 c grad_odl3=sum_sgodl/(sum_godl*dij)
3653 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3654 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3655 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3657 ccc write(iout,*) godl, sgodl, grad_odl3
3659 c grad_odl=grad_odl+grad_odl3
3662 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3663 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3664 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3665 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3666 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3667 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3668 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3669 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3670 c if (i.eq.25.and.j.eq.27) then
3671 c write(iout,*) "jik",jik,"i",i,"j",j
3672 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3673 c write(iout,*) "grad_odl3",grad_odl3
3674 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3675 c write(iout,*) "ggodl",ggodl
3676 c write(iout,*) "ghpbc(",jik,i,")",
3677 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3682 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3683 ccc & dLOG(odleg2),"-odleg=", -odleg
3685 enddo ! ii-loop for dist
3687 write(iout,*) "------- dist restrs end -------"
3688 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3689 c & waga_d.eq.1.0d0) call sum_gradient
3691 c Pseudo-energy and gradient from dihedral-angle restraints from
3692 c homology templates
3693 c write (iout,*) "End of distance loop"
3696 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3698 write(iout,*) "------- dih restrs start -------"
3699 do i=idihconstr_start_homo,idihconstr_end_homo
3700 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3703 do i=idihconstr_start_homo,idihconstr_end_homo
3705 c betai=beta(i,i+1,i+2,i+3)
3707 c write (iout,*) "betai =",betai
3708 do k=1,constr_homology
3709 dih_diff(k)=pinorm(dih(k,i)-betai)
3710 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3711 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3712 c & -(6.28318-dih_diff(i,k))
3713 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3714 c & 6.28318+dih_diff(i,k)
3716 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3718 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3720 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3723 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3726 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3727 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3729 write (iout,*) "i",i," betai",betai," kat2",kat2
3730 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3732 if (kat2.le.1.0d-14) cycle
3733 kat=kat-dLOG(kat2/constr_homology)
3734 c write (iout,*) "kat",kat ! sum of -ln-s
3736 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3737 ccc & dLOG(kat2), "-kat=", -kat
3740 c ----------------------------------------------------------------------
3742 c ----------------------------------------------------------------------
3746 do k=1,constr_homology
3748 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3750 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3752 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3753 sum_sgdih=sum_sgdih+sgdih
3755 c grad_dih3=sum_sgdih/sum_gdih
3756 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3758 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3759 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3760 ccc & gloc(nphi+i-3,icg)
3761 gloc(i,icg)=gloc(i,icg)+grad_dih3
3763 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3765 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3766 ccc & gloc(nphi+i-3,icg)
3768 enddo ! i-loop for dih
3770 write(iout,*) "------- dih restrs end -------"
3773 c Pseudo-energy and gradient for theta angle restraints from
3774 c homology templates
3775 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3779 c For constr_homology reference structures (FP)
3781 c Uconst_back_tot=0.0d0
3784 c Econstr_back legacy
3787 c do i=ithet_start,ithet_end
3790 c do i=loc_start,loc_end
3793 duscdiffx(j,i)=0.0d0
3799 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3800 c write (iout,*) "waga_theta",waga_theta
3801 if (waga_theta.gt.0.0d0) then
3803 write (iout,*) "usampl",usampl
3804 write(iout,*) "------- theta restrs start -------"
3805 c do i=ithet_start,ithet_end
3806 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3809 c write (iout,*) "maxres",maxres,"nres",nres
3811 do i=ithet_start,ithet_end
3814 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3816 c Deviation of theta angles wrt constr_homology ref structures
3818 utheta_i=0.0d0 ! argument of Gaussian for single k
3819 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3820 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3821 c over residues in a fragment
3822 c write (iout,*) "theta(",i,")=",theta(i)
3823 do k=1,constr_homology
3825 c dtheta_i=theta(j)-thetaref(j,iref)
3826 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3827 theta_diff(k)=thetatpl(k,i)-theta(i)
3829 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3830 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3831 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3832 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3833 c Gradient for single Gaussian restraint in subr Econstr_back
3834 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3837 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3838 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3842 c Gradient for multiple Gaussian restraint
3843 sum_gtheta=gutheta_i
3845 do k=1,constr_homology
3846 c New generalized expr for multiple Gaussian from Econstr_back
3847 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3849 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3850 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3853 c Final value of gradient using same var as in Econstr_back
3854 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3855 & *waga_homology(iset)
3856 c dutheta(i)=sum_sgtheta/sum_gtheta
3858 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3860 Eval=Eval-dLOG(gutheta_i/constr_homology)
3861 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3862 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3863 c Uconst_back=Uconst_back+utheta(i)
3864 enddo ! (i-loop for theta)
3866 write(iout,*) "------- theta restrs end -------"
3870 c Deviation of local SC geometry
3872 c Separation of two i-loops (instructed by AL - 11/3/2014)
3874 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3875 c write (iout,*) "waga_d",waga_d
3878 write(iout,*) "------- SC restrs start -------"
3879 write (iout,*) "Initial duscdiff,duscdiffx"
3880 do i=loc_start,loc_end
3881 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3882 & (duscdiffx(jik,i),jik=1,3)
3885 do i=loc_start,loc_end
3886 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3887 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3888 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3889 c write(iout,*) "xxtab, yytab, zztab"
3890 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3891 do k=1,constr_homology
3893 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3894 c Original sign inverted for calc of gradients (s. Econstr_back)
3895 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3896 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3897 c write(iout,*) "dxx, dyy, dzz"
3898 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3900 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3901 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3902 c uscdiffk(k)=usc_diff(i)
3903 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3904 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3905 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3906 c & xxref(j),yyref(j),zzref(j)
3911 c Generalized expression for multiple Gaussian acc to that for a single
3912 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3914 c Original implementation
3915 c sum_guscdiff=guscdiff(i)
3917 c sum_sguscdiff=0.0d0
3918 c do k=1,constr_homology
3919 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3920 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3921 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3924 c Implementation of new expressions for gradient (Jan. 2015)
3926 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3928 do k=1,constr_homology
3930 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3931 c before. Now the drivatives should be correct
3933 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3934 c Original sign inverted for calc of gradients (s. Econstr_back)
3935 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3936 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3938 c New implementation
3940 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3941 & sigma_d(k,i) ! for the grad wrt r'
3942 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3945 c New implementation
3946 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3948 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3949 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3950 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3951 duscdiff(jik,i)=duscdiff(jik,i)+
3952 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3953 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3954 duscdiffx(jik,i)=duscdiffx(jik,i)+
3955 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3956 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3959 write(iout,*) "jik",jik,"i",i
3960 write(iout,*) "dxx, dyy, dzz"
3961 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3962 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3963 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3964 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3965 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3966 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3967 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3968 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3969 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3970 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3971 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3972 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3973 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3974 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3975 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3982 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3983 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3985 c write (iout,*) i," uscdiff",uscdiff(i)
3987 c Put together deviations from local geometry
3989 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3990 c & wfrag_back(3,i,iset)*uscdiff(i)
3991 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3992 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3993 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3994 c Uconst_back=Uconst_back+usc_diff(i)
3996 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3998 c New implment: multiplied by sum_sguscdiff
4001 enddo ! (i-loop for dscdiff)
4006 write(iout,*) "------- SC restrs end -------"
4007 write (iout,*) "------ After SC loop in e_modeller ------"
4008 do i=loc_start,loc_end
4009 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4010 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4012 if (waga_theta.eq.1.0d0) then
4013 write (iout,*) "in e_modeller after SC restr end: dutheta"
4014 do i=ithet_start,ithet_end
4015 write (iout,*) i,dutheta(i)
4018 if (waga_d.eq.1.0d0) then
4019 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4021 write (iout,*) i,(duscdiff(j,i),j=1,3)
4022 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4027 c Total energy from homology restraints
4029 write (iout,*) "odleg",odleg," kat",kat
4030 write (iout,*) "odleg",odleg," kat",kat
4031 write (iout,*) "Eval",Eval," Erot",Erot
4032 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4033 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4034 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4037 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4039 c ehomology_constr=odleg+kat
4041 c For Lorentzian-type Urestr
4044 if (waga_dist.ge.0.0d0) then
4046 c For Gaussian-type Urestr
4048 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4049 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4050 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4051 & waga_theta*Eval+waga_d*Erot
4052 c write (iout,*) "ehomology_constr=",ehomology_constr
4055 c For Lorentzian-type Urestr
4057 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4058 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4059 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4060 & waga_theta*Eval+waga_d*Erot
4061 c write (iout,*) "ehomology_constr=",ehomology_constr
4064 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4065 & "Eval",waga_theta,eval,
4066 & "Erot",waga_d,Erot
4067 write (iout,*) "ehomology_constr",ehomology_constr
4071 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4072 747 format(a12,i4,i4,i4,f8.3,f8.3)
4073 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4074 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4075 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4076 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4078 c-----------------------------------------------------------------------
4079 subroutine ebond(estr)
4081 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4083 implicit real*8 (a-h,o-z)
4084 include 'DIMENSIONS'
4085 include 'DIMENSIONS.ZSCOPT'
4086 include 'DIMENSIONS.FREE'
4087 include 'COMMON.LOCAL'
4088 include 'COMMON.GEO'
4089 include 'COMMON.INTERACT'
4090 include 'COMMON.DERIV'
4091 include 'COMMON.VAR'
4092 include 'COMMON.CHAIN'
4093 include 'COMMON.IOUNITS'
4094 include 'COMMON.NAMES'
4095 include 'COMMON.FFIELD'
4096 include 'COMMON.CONTROL'
4097 logical energy_dec /.false./
4098 double precision u(3),ud(3)
4100 C write (iout,*) "distchainmax",distchainmax
4102 c write (iout,*) "distchainmax",distchainmax
4104 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4105 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4107 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4108 C & *dc(j,i-1)/vbld(i)
4110 C if (energy_dec) write(iout,*)
4111 C & "estr1",i,vbld(i),distchainmax,
4112 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4114 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4115 diff = vbld(i)-vbldpDUM
4116 C write(iout,*) i,diff
4118 diff = vbld(i)-vbldp0
4119 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4123 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4126 C write (iout,'(a7,i5,4f7.3)')
4127 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4129 estr=0.5d0*AKP*estr+estr1
4131 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4135 if (iti.ne.10 .and. iti.ne.ntyp1) then
4138 diff=vbld(i+nres)-vbldsc0(1,iti)
4139 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4140 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4141 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4143 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4147 diff=vbld(i+nres)-vbldsc0(j,iti)
4148 ud(j)=aksc(j,iti)*diff
4149 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4163 uprod2=uprod2*u(k)*u(k)
4167 usumsqder=usumsqder+ud(j)*uprod2
4169 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4170 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4171 estr=estr+uprod/usum
4173 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4181 C--------------------------------------------------------------------------
4182 subroutine ebend(etheta)
4184 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4185 C angles gamma and its derivatives in consecutive thetas and gammas.
4187 implicit real*8 (a-h,o-z)
4188 include 'DIMENSIONS'
4189 include 'DIMENSIONS.ZSCOPT'
4190 include 'COMMON.LOCAL'
4191 include 'COMMON.GEO'
4192 include 'COMMON.INTERACT'
4193 include 'COMMON.DERIV'
4194 include 'COMMON.VAR'
4195 include 'COMMON.CHAIN'
4196 include 'COMMON.IOUNITS'
4197 include 'COMMON.NAMES'
4198 include 'COMMON.FFIELD'
4199 common /calcthet/ term1,term2,termm,diffak,ratak,
4200 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4201 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4202 double precision y(2),z(2)
4204 time11=dexp(-2*time)
4207 c write (iout,*) "nres",nres
4208 c write (*,'(a,i2)') 'EBEND ICG=',icg
4209 c write (iout,*) ithet_start,ithet_end
4210 do i=ithet_start,ithet_end
4211 C if (itype(i-1).eq.ntyp1) cycle
4213 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4214 & .or.itype(i).eq.ntyp1) cycle
4215 C Zero the energy function and its derivative at 0 or pi.
4216 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4218 ichir1=isign(1,itype(i-2))
4219 ichir2=isign(1,itype(i))
4220 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4221 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4222 if (itype(i-1).eq.10) then
4223 itype1=isign(10,itype(i-2))
4224 ichir11=isign(1,itype(i-2))
4225 ichir12=isign(1,itype(i-2))
4226 itype2=isign(10,itype(i))
4227 ichir21=isign(1,itype(i))
4228 ichir22=isign(1,itype(i))
4235 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4239 c call proc_proc(phii,icrc)
4240 if (icrc.eq.1) phii=150.0
4251 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4255 c call proc_proc(phii1,icrc)
4256 if (icrc.eq.1) phii1=150.0
4268 C Calculate the "mean" value of theta from the part of the distribution
4269 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4270 C In following comments this theta will be referred to as t_c.
4271 thet_pred_mean=0.0d0
4273 athetk=athet(k,it,ichir1,ichir2)
4274 bthetk=bthet(k,it,ichir1,ichir2)
4276 athetk=athet(k,itype1,ichir11,ichir12)
4277 bthetk=bthet(k,itype2,ichir21,ichir22)
4279 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4281 c write (iout,*) "thet_pred_mean",thet_pred_mean
4282 dthett=thet_pred_mean*ssd
4283 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4284 c write (iout,*) "thet_pred_mean",thet_pred_mean
4285 C Derivatives of the "mean" values in gamma1 and gamma2.
4286 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4287 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4288 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4289 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4291 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4292 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4293 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4294 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4296 if (theta(i).gt.pi-delta) then
4297 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4299 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4300 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4301 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4303 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4305 else if (theta(i).lt.delta) then
4306 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4307 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4308 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4310 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4311 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4314 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4317 etheta=etheta+ethetai
4318 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4319 c & 'ebend',i,ethetai,theta(i),itype(i)
4320 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4321 c & rad2deg*phii,rad2deg*phii1,ethetai
4322 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4323 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4324 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4328 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4329 do i=1,ntheta_constr
4330 itheta=itheta_constr(i)
4331 thetiii=theta(itheta)
4332 difi=pinorm(thetiii-theta_constr0(i))
4333 if (difi.gt.theta_drange(i)) then
4334 difi=difi-theta_drange(i)
4335 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4336 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4337 & +for_thet_constr(i)*difi**3
4338 else if (difi.lt.-drange(i)) then
4340 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4341 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4342 & +for_thet_constr(i)*difi**3
4346 C if (energy_dec) then
4347 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4348 C & i,itheta,rad2deg*thetiii,
4349 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4350 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4351 C & gloc(itheta+nphi-2,icg)
4354 C Ufff.... We've done all this!!!
4357 C---------------------------------------------------------------------------
4358 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4360 implicit real*8 (a-h,o-z)
4361 include 'DIMENSIONS'
4362 include 'COMMON.LOCAL'
4363 include 'COMMON.IOUNITS'
4364 common /calcthet/ term1,term2,termm,diffak,ratak,
4365 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4366 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4367 C Calculate the contributions to both Gaussian lobes.
4368 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4369 C The "polynomial part" of the "standard deviation" of this part of
4373 sig=sig*thet_pred_mean+polthet(j,it)
4375 C Derivative of the "interior part" of the "standard deviation of the"
4376 C gamma-dependent Gaussian lobe in t_c.
4377 sigtc=3*polthet(3,it)
4379 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4382 C Set the parameters of both Gaussian lobes of the distribution.
4383 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4384 fac=sig*sig+sigc0(it)
4387 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4388 sigsqtc=-4.0D0*sigcsq*sigtc
4389 c print *,i,sig,sigtc,sigsqtc
4390 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4391 sigtc=-sigtc/(fac*fac)
4392 C Following variable is sigma(t_c)**(-2)
4393 sigcsq=sigcsq*sigcsq
4395 sig0inv=1.0D0/sig0i**2
4396 delthec=thetai-thet_pred_mean
4397 delthe0=thetai-theta0i
4398 term1=-0.5D0*sigcsq*delthec*delthec
4399 term2=-0.5D0*sig0inv*delthe0*delthe0
4400 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4401 C NaNs in taking the logarithm. We extract the largest exponent which is added
4402 C to the energy (this being the log of the distribution) at the end of energy
4403 C term evaluation for this virtual-bond angle.
4404 if (term1.gt.term2) then
4406 term2=dexp(term2-termm)
4410 term1=dexp(term1-termm)
4413 C The ratio between the gamma-independent and gamma-dependent lobes of
4414 C the distribution is a Gaussian function of thet_pred_mean too.
4415 diffak=gthet(2,it)-thet_pred_mean
4416 ratak=diffak/gthet(3,it)**2
4417 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4418 C Let's differentiate it in thet_pred_mean NOW.
4420 C Now put together the distribution terms to make complete distribution.
4421 termexp=term1+ak*term2
4422 termpre=sigc+ak*sig0i
4423 C Contribution of the bending energy from this theta is just the -log of
4424 C the sum of the contributions from the two lobes and the pre-exponential
4425 C factor. Simple enough, isn't it?
4426 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4427 C NOW the derivatives!!!
4428 C 6/6/97 Take into account the deformation.
4429 E_theta=(delthec*sigcsq*term1
4430 & +ak*delthe0*sig0inv*term2)/termexp
4431 E_tc=((sigtc+aktc*sig0i)/termpre
4432 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4433 & aktc*term2)/termexp)
4436 c-----------------------------------------------------------------------------
4437 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4438 implicit real*8 (a-h,o-z)
4439 include 'DIMENSIONS'
4440 include 'COMMON.LOCAL'
4441 include 'COMMON.IOUNITS'
4442 common /calcthet/ term1,term2,termm,diffak,ratak,
4443 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4444 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4445 delthec=thetai-thet_pred_mean
4446 delthe0=thetai-theta0i
4447 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4448 t3 = thetai-thet_pred_mean
4452 t14 = t12+t6*sigsqtc
4454 t21 = thetai-theta0i
4460 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4461 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4462 & *(-t12*t9-ak*sig0inv*t27)
4466 C--------------------------------------------------------------------------
4467 subroutine ebend(etheta)
4469 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4470 C angles gamma and its derivatives in consecutive thetas and gammas.
4471 C ab initio-derived potentials from
4472 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4474 implicit real*8 (a-h,o-z)
4475 include 'DIMENSIONS'
4476 include 'DIMENSIONS.ZSCOPT'
4477 include 'DIMENSIONS.FREE'
4478 include 'COMMON.LOCAL'
4479 include 'COMMON.GEO'
4480 include 'COMMON.INTERACT'
4481 include 'COMMON.DERIV'
4482 include 'COMMON.VAR'
4483 include 'COMMON.CHAIN'
4484 include 'COMMON.IOUNITS'
4485 include 'COMMON.NAMES'
4486 include 'COMMON.FFIELD'
4487 include 'COMMON.CONTROL'
4488 include 'COMMON.TORCNSTR'
4489 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4490 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4491 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4492 & sinph1ph2(maxdouble,maxdouble)
4493 logical lprn /.false./, lprn1 /.false./
4495 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4496 do i=ithet_start,ithet_end
4498 c print *,i,itype(i-1),itype(i),itype(i-2)
4499 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4500 & .or.(itype(i).eq.ntyp1)) cycle
4501 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4503 if (iabs(itype(i+1)).eq.20) iblock=2
4504 if (iabs(itype(i+1)).ne.20) iblock=1
4508 theti2=0.5d0*theta(i)
4509 ityp2=ithetyp((itype(i-1)))
4511 coskt(k)=dcos(k*theti2)
4512 sinkt(k)=dsin(k*theti2)
4514 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4517 if (phii.ne.phii) phii=150.0
4521 ityp1=ithetyp((itype(i-2)))
4523 cosph1(k)=dcos(k*phii)
4524 sinph1(k)=dsin(k*phii)
4528 ityp1=ithetyp(itype(i-2))
4534 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4537 if (phii1.ne.phii1) phii1=150.0
4542 ityp3=ithetyp((itype(i)))
4544 cosph2(k)=dcos(k*phii1)
4545 sinph2(k)=dsin(k*phii1)
4549 ityp3=ithetyp(itype(i))
4555 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4556 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4558 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4561 ccl=cosph1(l)*cosph2(k-l)
4562 ssl=sinph1(l)*sinph2(k-l)
4563 scl=sinph1(l)*cosph2(k-l)
4564 csl=cosph1(l)*sinph2(k-l)
4565 cosph1ph2(l,k)=ccl-ssl
4566 cosph1ph2(k,l)=ccl+ssl
4567 sinph1ph2(l,k)=scl+csl
4568 sinph1ph2(k,l)=scl-csl
4572 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4573 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4574 write (iout,*) "coskt and sinkt"
4576 write (iout,*) k,coskt(k),sinkt(k)
4580 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4581 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4584 & write (iout,*) "k",k,"
4585 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4586 & " ethetai",ethetai
4589 write (iout,*) "cosph and sinph"
4591 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4593 write (iout,*) "cosph1ph2 and sinph2ph2"
4596 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4597 & sinph1ph2(l,k),sinph1ph2(k,l)
4600 write(iout,*) "ethetai",ethetai
4604 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4605 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4606 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4607 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4608 ethetai=ethetai+sinkt(m)*aux
4609 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4610 dephii=dephii+k*sinkt(m)*(
4611 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4612 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4613 dephii1=dephii1+k*sinkt(m)*(
4614 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4615 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4617 & write (iout,*) "m",m," k",k," bbthet",
4618 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4619 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4620 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4621 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4625 & write(iout,*) "ethetai",ethetai
4629 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4630 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4631 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4632 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4633 ethetai=ethetai+sinkt(m)*aux
4634 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4635 dephii=dephii+l*sinkt(m)*(
4636 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4637 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4638 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4639 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4640 dephii1=dephii1+(k-l)*sinkt(m)*(
4641 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4642 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4643 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4644 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4646 write (iout,*) "m",m," k",k," l",l," ffthet",
4647 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4648 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4649 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4650 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4651 & " ethetai",ethetai
4652 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4653 & cosph1ph2(k,l)*sinkt(m),
4654 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4660 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4661 & i,theta(i)*rad2deg,phii*rad2deg,
4662 & phii1*rad2deg,ethetai
4663 etheta=etheta+ethetai
4664 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4665 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4666 c gloc(nphi+i-2,icg)=wang*dethetai
4667 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4671 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4672 do i=1,ntheta_constr
4673 itheta=itheta_constr(i)
4674 thetiii=theta(itheta)
4675 difi=pinorm(thetiii-theta_constr0(i))
4676 if (difi.gt.theta_drange(i)) then
4677 difi=difi-theta_drange(i)
4678 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4679 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4680 & +for_thet_constr(i)*difi**3
4681 else if (difi.lt.-drange(i)) then
4683 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4684 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4685 & +for_thet_constr(i)*difi**3
4689 C if (energy_dec) then
4690 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4691 C & i,itheta,rad2deg*thetiii,
4692 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4693 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4694 C & gloc(itheta+nphi-2,icg)
4702 c-----------------------------------------------------------------------------
4703 subroutine esc(escloc)
4704 C Calculate the local energy of a side chain and its derivatives in the
4705 C corresponding virtual-bond valence angles THETA and the spherical angles
4707 implicit real*8 (a-h,o-z)
4708 include 'DIMENSIONS'
4709 include 'DIMENSIONS.ZSCOPT'
4710 include 'COMMON.GEO'
4711 include 'COMMON.LOCAL'
4712 include 'COMMON.VAR'
4713 include 'COMMON.INTERACT'
4714 include 'COMMON.DERIV'
4715 include 'COMMON.CHAIN'
4716 include 'COMMON.IOUNITS'
4717 include 'COMMON.NAMES'
4718 include 'COMMON.FFIELD'
4719 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4720 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4721 common /sccalc/ time11,time12,time112,theti,it,nlobit
4724 C write (iout,*) 'ESC'
4725 do i=loc_start,loc_end
4727 if (it.eq.ntyp1) cycle
4728 if (it.eq.10) goto 1
4729 nlobit=nlob(iabs(it))
4730 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4731 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4732 theti=theta(i+1)-pipol
4736 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4738 if (x(2).gt.pi-delta) then
4742 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4744 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4745 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4747 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4748 & ddersc0(1),dersc(1))
4749 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4750 & ddersc0(3),dersc(3))
4752 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4754 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4755 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4756 & dersc0(2),esclocbi,dersc02)
4757 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4759 call splinthet(x(2),0.5d0*delta,ss,ssd)
4764 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4766 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4767 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4769 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4771 c write (iout,*) escloci
4772 else if (x(2).lt.delta) then
4776 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4778 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4779 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4781 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4782 & ddersc0(1),dersc(1))
4783 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4784 & ddersc0(3),dersc(3))
4786 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4788 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4789 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4790 & dersc0(2),esclocbi,dersc02)
4791 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4796 call splinthet(x(2),0.5d0*delta,ss,ssd)
4798 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4800 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4801 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4803 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4804 C write (iout,*) 'i=',i, escloci
4806 call enesc(x,escloci,dersc,ddummy,.false.)
4809 escloc=escloc+escloci
4810 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4811 write (iout,'(a6,i5,0pf7.3)')
4812 & 'escloc',i,escloci
4814 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4816 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4817 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4822 C---------------------------------------------------------------------------
4823 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4824 implicit real*8 (a-h,o-z)
4825 include 'DIMENSIONS'
4826 include 'COMMON.GEO'
4827 include 'COMMON.LOCAL'
4828 include 'COMMON.IOUNITS'
4829 common /sccalc/ time11,time12,time112,theti,it,nlobit
4830 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4831 double precision contr(maxlob,-1:1)
4833 c write (iout,*) 'it=',it,' nlobit=',nlobit
4837 if (mixed) ddersc(j)=0.0d0
4841 C Because of periodicity of the dependence of the SC energy in omega we have
4842 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4843 C To avoid underflows, first compute & store the exponents.
4851 z(k)=x(k)-censc(k,j,it)
4856 Axk=Axk+gaussc(l,k,j,it)*z(l)
4862 expfac=expfac+Ax(k,j,iii)*z(k)
4870 C As in the case of ebend, we want to avoid underflows in exponentiation and
4871 C subsequent NaNs and INFs in energy calculation.
4872 C Find the largest exponent
4876 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4880 cd print *,'it=',it,' emin=',emin
4882 C Compute the contribution to SC energy and derivatives
4886 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4887 cd print *,'j=',j,' expfac=',expfac
4888 escloc_i=escloc_i+expfac
4890 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4894 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4895 & +gaussc(k,2,j,it))*expfac
4902 dersc(1)=dersc(1)/cos(theti)**2
4903 ddersc(1)=ddersc(1)/cos(theti)**2
4906 escloci=-(dlog(escloc_i)-emin)
4908 dersc(j)=dersc(j)/escloc_i
4912 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4917 C------------------------------------------------------------------------------
4918 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4919 implicit real*8 (a-h,o-z)
4920 include 'DIMENSIONS'
4921 include 'COMMON.GEO'
4922 include 'COMMON.LOCAL'
4923 include 'COMMON.IOUNITS'
4924 common /sccalc/ time11,time12,time112,theti,it,nlobit
4925 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4926 double precision contr(maxlob)
4937 z(k)=x(k)-censc(k,j,it)
4943 Axk=Axk+gaussc(l,k,j,it)*z(l)
4949 expfac=expfac+Ax(k,j)*z(k)
4954 C As in the case of ebend, we want to avoid underflows in exponentiation and
4955 C subsequent NaNs and INFs in energy calculation.
4956 C Find the largest exponent
4959 if (emin.gt.contr(j)) emin=contr(j)
4963 C Compute the contribution to SC energy and derivatives
4967 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4968 escloc_i=escloc_i+expfac
4970 dersc(k)=dersc(k)+Ax(k,j)*expfac
4972 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4973 & +gaussc(1,2,j,it))*expfac
4977 dersc(1)=dersc(1)/cos(theti)**2
4978 dersc12=dersc12/cos(theti)**2
4979 escloci=-(dlog(escloc_i)-emin)
4981 dersc(j)=dersc(j)/escloc_i
4983 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4987 c----------------------------------------------------------------------------------
4988 subroutine esc(escloc)
4989 C Calculate the local energy of a side chain and its derivatives in the
4990 C corresponding virtual-bond valence angles THETA and the spherical angles
4991 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4992 C added by Urszula Kozlowska. 07/11/2007
4994 implicit real*8 (a-h,o-z)
4995 include 'DIMENSIONS'
4996 include 'DIMENSIONS.ZSCOPT'
4997 include 'DIMENSIONS.FREE'
4998 include 'COMMON.GEO'
4999 include 'COMMON.LOCAL'
5000 include 'COMMON.VAR'
5001 include 'COMMON.SCROT'
5002 include 'COMMON.INTERACT'
5003 include 'COMMON.DERIV'
5004 include 'COMMON.CHAIN'
5005 include 'COMMON.IOUNITS'
5006 include 'COMMON.NAMES'
5007 include 'COMMON.FFIELD'
5008 include 'COMMON.CONTROL'
5009 include 'COMMON.VECTORS'
5010 double precision x_prime(3),y_prime(3),z_prime(3)
5011 & , sumene,dsc_i,dp2_i,x(65),
5012 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5013 & de_dxx,de_dyy,de_dzz,de_dt
5014 double precision s1_t,s1_6_t,s2_t,s2_6_t
5016 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5017 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5018 & dt_dCi(3),dt_dCi1(3)
5019 common /sccalc/ time11,time12,time112,theti,it,nlobit
5022 do i=loc_start,loc_end
5023 if (itype(i).eq.ntyp1) cycle
5024 costtab(i+1) =dcos(theta(i+1))
5025 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5026 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5027 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5028 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5029 cosfac=dsqrt(cosfac2)
5030 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5031 sinfac=dsqrt(sinfac2)
5033 if (it.eq.10) goto 1
5035 C Compute the axes of tghe local cartesian coordinates system; store in
5036 c x_prime, y_prime and z_prime
5043 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5044 C & dc_norm(3,i+nres)
5046 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5047 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5050 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5053 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5054 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5055 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5056 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5057 c & " xy",scalar(x_prime(1),y_prime(1)),
5058 c & " xz",scalar(x_prime(1),z_prime(1)),
5059 c & " yy",scalar(y_prime(1),y_prime(1)),
5060 c & " yz",scalar(y_prime(1),z_prime(1)),
5061 c & " zz",scalar(z_prime(1),z_prime(1))
5063 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5064 C to local coordinate system. Store in xx, yy, zz.
5070 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5071 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5072 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5079 C Compute the energy of the ith side cbain
5081 c write (2,*) "xx",xx," yy",yy," zz",zz
5084 x(j) = sc_parmin(j,it)
5087 Cc diagnostics - remove later
5089 yy1 = dsin(alph(2))*dcos(omeg(2))
5090 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5091 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5092 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5094 C," --- ", xx_w,yy_w,zz_w
5097 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5098 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5100 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5101 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5103 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5104 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5105 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5106 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5107 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5109 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5110 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5111 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5112 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5113 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5115 dsc_i = 0.743d0+x(61)
5117 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5118 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5119 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5120 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5121 s1=(1+x(63))/(0.1d0 + dscp1)
5122 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5123 s2=(1+x(65))/(0.1d0 + dscp2)
5124 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5125 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5126 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5127 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5129 c & dscp1,dscp2,sumene
5130 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5131 escloc = escloc + sumene
5132 c write (2,*) "escloc",escloc
5133 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5135 if (.not. calc_grad) goto 1
5138 C This section to check the numerical derivatives of the energy of ith side
5139 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5140 C #define DEBUG in the code to turn it on.
5142 write (2,*) "sumene =",sumene
5146 write (2,*) xx,yy,zz
5147 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5148 de_dxx_num=(sumenep-sumene)/aincr
5150 write (2,*) "xx+ sumene from enesc=",sumenep
5153 write (2,*) xx,yy,zz
5154 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5155 de_dyy_num=(sumenep-sumene)/aincr
5157 write (2,*) "yy+ sumene from enesc=",sumenep
5160 write (2,*) xx,yy,zz
5161 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5162 de_dzz_num=(sumenep-sumene)/aincr
5164 write (2,*) "zz+ sumene from enesc=",sumenep
5165 costsave=cost2tab(i+1)
5166 sintsave=sint2tab(i+1)
5167 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5168 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5169 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5170 de_dt_num=(sumenep-sumene)/aincr
5171 write (2,*) " t+ sumene from enesc=",sumenep
5172 cost2tab(i+1)=costsave
5173 sint2tab(i+1)=sintsave
5174 C End of diagnostics section.
5177 C Compute the gradient of esc
5179 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5180 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5181 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5182 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5183 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5184 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5185 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5186 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5187 pom1=(sumene3*sint2tab(i+1)+sumene1)
5188 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5189 pom2=(sumene4*cost2tab(i+1)+sumene2)
5190 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5191 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5192 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5193 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5195 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5196 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5197 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5199 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5200 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5201 & +(pom1+pom2)*pom_dx
5203 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5206 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5207 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5208 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5210 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5211 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5212 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5213 & +x(59)*zz**2 +x(60)*xx*zz
5214 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5215 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5216 & +(pom1-pom2)*pom_dy
5218 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5221 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5222 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5223 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5224 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5225 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5226 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5227 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5228 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5230 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5233 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5234 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5235 & +pom1*pom_dt1+pom2*pom_dt2
5237 write(2,*), "de_dt = ", de_dt,de_dt_num
5241 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5242 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5243 cosfac2xx=cosfac2*xx
5244 sinfac2yy=sinfac2*yy
5246 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5248 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5250 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5251 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5252 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5253 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5254 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5255 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5256 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5257 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5258 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5259 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5263 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5264 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5265 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5266 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5269 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5270 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5271 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5273 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5274 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5278 dXX_Ctab(k,i)=dXX_Ci(k)
5279 dXX_C1tab(k,i)=dXX_Ci1(k)
5280 dYY_Ctab(k,i)=dYY_Ci(k)
5281 dYY_C1tab(k,i)=dYY_Ci1(k)
5282 dZZ_Ctab(k,i)=dZZ_Ci(k)
5283 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5284 dXX_XYZtab(k,i)=dXX_XYZ(k)
5285 dYY_XYZtab(k,i)=dYY_XYZ(k)
5286 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5290 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5291 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5292 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5293 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5294 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5296 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5297 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5298 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5299 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5300 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5301 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5302 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5303 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5305 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5306 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5308 C to check gradient call subroutine check_grad
5315 c------------------------------------------------------------------------------
5316 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5318 C This procedure calculates two-body contact function g(rij) and its derivative:
5321 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5324 C where x=(rij-r0ij)/delta
5326 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5329 double precision rij,r0ij,eps0ij,fcont,fprimcont
5330 double precision x,x2,x4,delta
5334 if (x.lt.-1.0D0) then
5337 else if (x.le.1.0D0) then
5340 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5341 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5348 c------------------------------------------------------------------------------
5349 subroutine splinthet(theti,delta,ss,ssder)
5350 implicit real*8 (a-h,o-z)
5351 include 'DIMENSIONS'
5352 include 'DIMENSIONS.ZSCOPT'
5353 include 'COMMON.VAR'
5354 include 'COMMON.GEO'
5357 if (theti.gt.pipol) then
5358 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5360 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5365 c------------------------------------------------------------------------------
5366 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5368 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5369 double precision ksi,ksi2,ksi3,a1,a2,a3
5370 a1=fprim0*delta/(f1-f0)
5376 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5377 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5380 c------------------------------------------------------------------------------
5381 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5383 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5384 double precision ksi,ksi2,ksi3,a1,a2,a3
5389 a2=3*(f1x-f0x)-2*fprim0x*delta
5390 a3=fprim0x*delta-2*(f1x-f0x)
5391 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5394 C-----------------------------------------------------------------------------
5396 C-----------------------------------------------------------------------------
5397 subroutine etor(etors,edihcnstr,fact)
5398 implicit real*8 (a-h,o-z)
5399 include 'DIMENSIONS'
5400 include 'DIMENSIONS.ZSCOPT'
5401 include 'COMMON.VAR'
5402 include 'COMMON.GEO'
5403 include 'COMMON.LOCAL'
5404 include 'COMMON.TORSION'
5405 include 'COMMON.INTERACT'
5406 include 'COMMON.DERIV'
5407 include 'COMMON.CHAIN'
5408 include 'COMMON.NAMES'
5409 include 'COMMON.IOUNITS'
5410 include 'COMMON.FFIELD'
5411 include 'COMMON.TORCNSTR'
5413 C Set lprn=.true. for debugging
5417 do i=iphi_start,iphi_end
5418 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5419 & .or. itype(i).eq.ntyp1) cycle
5420 itori=itortyp(itype(i-2))
5421 itori1=itortyp(itype(i-1))
5424 C Proline-Proline pair is a special case...
5425 if (itori.eq.3 .and. itori1.eq.3) then
5426 if (phii.gt.-dwapi3) then
5428 fac=1.0D0/(1.0D0-cosphi)
5429 etorsi=v1(1,3,3)*fac
5430 etorsi=etorsi+etorsi
5431 etors=etors+etorsi-v1(1,3,3)
5432 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5435 v1ij=v1(j+1,itori,itori1)
5436 v2ij=v2(j+1,itori,itori1)
5439 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5440 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5444 v1ij=v1(j,itori,itori1)
5445 v2ij=v2(j,itori,itori1)
5448 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5449 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5453 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5454 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5455 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5456 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5457 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5459 ! 6/20/98 - dihedral angle constraints
5462 itori=idih_constr(i)
5465 if (difi.gt.drange(i)) then
5467 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5468 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5469 else if (difi.lt.-drange(i)) then
5471 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5472 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5474 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5475 C & i,itori,rad2deg*phii,
5476 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5478 ! write (iout,*) 'edihcnstr',edihcnstr
5481 c------------------------------------------------------------------------------
5483 subroutine etor(etors,edihcnstr,fact)
5484 implicit real*8 (a-h,o-z)
5485 include 'DIMENSIONS'
5486 include 'DIMENSIONS.ZSCOPT'
5487 include 'COMMON.VAR'
5488 include 'COMMON.GEO'
5489 include 'COMMON.LOCAL'
5490 include 'COMMON.TORSION'
5491 include 'COMMON.INTERACT'
5492 include 'COMMON.DERIV'
5493 include 'COMMON.CHAIN'
5494 include 'COMMON.NAMES'
5495 include 'COMMON.IOUNITS'
5496 include 'COMMON.FFIELD'
5497 include 'COMMON.TORCNSTR'
5499 C Set lprn=.true. for debugging
5503 do i=iphi_start,iphi_end
5505 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5506 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5507 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5508 C & .or. itype(i).eq.ntyp1) cycle
5509 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5510 if (iabs(itype(i)).eq.20) then
5515 itori=itortyp(itype(i-2))
5516 itori1=itortyp(itype(i-1))
5519 C Regular cosine and sine terms
5520 do j=1,nterm(itori,itori1,iblock)
5521 v1ij=v1(j,itori,itori1,iblock)
5522 v2ij=v2(j,itori,itori1,iblock)
5525 etors=etors+v1ij*cosphi+v2ij*sinphi
5526 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5530 C E = SUM ----------------------------------- - v1
5531 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5533 cosphi=dcos(0.5d0*phii)
5534 sinphi=dsin(0.5d0*phii)
5535 do j=1,nlor(itori,itori1,iblock)
5536 vl1ij=vlor1(j,itori,itori1)
5537 vl2ij=vlor2(j,itori,itori1)
5538 vl3ij=vlor3(j,itori,itori1)
5539 pom=vl2ij*cosphi+vl3ij*sinphi
5540 pom1=1.0d0/(pom*pom+1.0d0)
5541 etors=etors+vl1ij*pom1
5542 c if (energy_dec) etors_ii=etors_ii+
5545 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5547 C Subtract the constant term
5548 etors=etors-v0(itori,itori1,iblock)
5550 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5551 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5552 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5553 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5554 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5557 ! 6/20/98 - dihedral angle constraints
5560 itori=idih_constr(i)
5562 difi=pinorm(phii-phi0(i))
5564 if (difi.gt.drange(i)) then
5566 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5567 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5568 edihi=0.25d0*ftors(i)*difi**4
5569 else if (difi.lt.-drange(i)) then
5571 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5572 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5573 edihi=0.25d0*ftors(i)*difi**4
5577 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5578 & i,itori,rad2deg*phii,
5579 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5580 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5582 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5583 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5585 ! write (iout,*) 'edihcnstr',edihcnstr
5588 c----------------------------------------------------------------------------
5589 subroutine etor_d(etors_d,fact2)
5590 C 6/23/01 Compute double torsional energy
5591 implicit real*8 (a-h,o-z)
5592 include 'DIMENSIONS'
5593 include 'DIMENSIONS.ZSCOPT'
5594 include 'COMMON.VAR'
5595 include 'COMMON.GEO'
5596 include 'COMMON.LOCAL'
5597 include 'COMMON.TORSION'
5598 include 'COMMON.INTERACT'
5599 include 'COMMON.DERIV'
5600 include 'COMMON.CHAIN'
5601 include 'COMMON.NAMES'
5602 include 'COMMON.IOUNITS'
5603 include 'COMMON.FFIELD'
5604 include 'COMMON.TORCNSTR'
5606 C Set lprn=.true. for debugging
5610 do i=iphi_start,iphi_end-1
5612 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5613 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5614 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5615 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5616 & (itype(i+1).eq.ntyp1)) cycle
5617 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5619 itori=itortyp(itype(i-2))
5620 itori1=itortyp(itype(i-1))
5621 itori2=itortyp(itype(i))
5627 if (iabs(itype(i+1)).eq.20) iblock=2
5628 C Regular cosine and sine terms
5629 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5630 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5631 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5632 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5633 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5634 cosphi1=dcos(j*phii)
5635 sinphi1=dsin(j*phii)
5636 cosphi2=dcos(j*phii1)
5637 sinphi2=dsin(j*phii1)
5638 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5639 & v2cij*cosphi2+v2sij*sinphi2
5640 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5641 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5643 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5645 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5646 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5647 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5648 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5649 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5650 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5651 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5652 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5653 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5654 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5655 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5656 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5657 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5658 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5661 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5662 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5668 c------------------------------------------------------------------------------
5669 subroutine eback_sc_corr(esccor)
5670 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5671 c conformational states; temporarily implemented as differences
5672 c between UNRES torsional potentials (dependent on three types of
5673 c residues) and the torsional potentials dependent on all 20 types
5674 c of residues computed from AM1 energy surfaces of terminally-blocked
5675 c amino-acid residues.
5676 implicit real*8 (a-h,o-z)
5677 include 'DIMENSIONS'
5678 include 'DIMENSIONS.ZSCOPT'
5679 include 'DIMENSIONS.FREE'
5680 include 'COMMON.VAR'
5681 include 'COMMON.GEO'
5682 include 'COMMON.LOCAL'
5683 include 'COMMON.TORSION'
5684 include 'COMMON.SCCOR'
5685 include 'COMMON.INTERACT'
5686 include 'COMMON.DERIV'
5687 include 'COMMON.CHAIN'
5688 include 'COMMON.NAMES'
5689 include 'COMMON.IOUNITS'
5690 include 'COMMON.FFIELD'
5691 include 'COMMON.CONTROL'
5693 C Set lprn=.true. for debugging
5696 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5698 do i=itau_start,itau_end
5699 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5701 isccori=isccortyp(itype(i-2))
5702 isccori1=isccortyp(itype(i-1))
5704 do intertyp=1,3 !intertyp
5705 cc Added 09 May 2012 (Adasko)
5706 cc Intertyp means interaction type of backbone mainchain correlation:
5707 c 1 = SC...Ca...Ca...Ca
5708 c 2 = Ca...Ca...Ca...SC
5709 c 3 = SC...Ca...Ca...SCi
5711 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5712 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5713 & (itype(i-1).eq.ntyp1)))
5714 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5715 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5716 & .or.(itype(i).eq.ntyp1)))
5717 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5718 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5719 & (itype(i-3).eq.ntyp1)))) cycle
5720 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5721 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5723 do j=1,nterm_sccor(isccori,isccori1)
5724 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5725 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5726 cosphi=dcos(j*tauangle(intertyp,i))
5727 sinphi=dsin(j*tauangle(intertyp,i))
5728 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5729 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5731 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5732 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5733 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5735 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5736 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5737 & (v1sccor(j,1,itori,itori1),j=1,6)
5738 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5739 c gsccor_loc(i-3)=gloci
5744 c------------------------------------------------------------------------------
5745 subroutine multibody(ecorr)
5746 C This subroutine calculates multi-body contributions to energy following
5747 C the idea of Skolnick et al. If side chains I and J make a contact and
5748 C at the same time side chains I+1 and J+1 make a contact, an extra
5749 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5750 implicit real*8 (a-h,o-z)
5751 include 'DIMENSIONS'
5752 include 'COMMON.IOUNITS'
5753 include 'COMMON.DERIV'
5754 include 'COMMON.INTERACT'
5755 include 'COMMON.CONTACTS'
5756 double precision gx(3),gx1(3)
5759 C Set lprn=.true. for debugging
5763 write (iout,'(a)') 'Contact function values:'
5765 write (iout,'(i2,20(1x,i2,f10.5))')
5766 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5781 num_conti=num_cont(i)
5782 num_conti1=num_cont(i1)
5787 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5788 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5789 cd & ' ishift=',ishift
5790 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5791 C The system gains extra energy.
5792 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5793 endif ! j1==j+-ishift
5802 c------------------------------------------------------------------------------
5803 double precision function esccorr(i,j,k,l,jj,kk)
5804 implicit real*8 (a-h,o-z)
5805 include 'DIMENSIONS'
5806 include 'COMMON.IOUNITS'
5807 include 'COMMON.DERIV'
5808 include 'COMMON.INTERACT'
5809 include 'COMMON.CONTACTS'
5810 double precision gx(3),gx1(3)
5815 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5816 C Calculate the multi-body contribution to energy.
5817 C Calculate multi-body contributions to the gradient.
5818 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5819 cd & k,l,(gacont(m,kk,k),m=1,3)
5821 gx(m) =ekl*gacont(m,jj,i)
5822 gx1(m)=eij*gacont(m,kk,k)
5823 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5824 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5825 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5826 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5830 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5835 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5841 c------------------------------------------------------------------------------
5843 subroutine pack_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),ees0m(ntyp,maxres),
5851 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5852 num_kont=num_cont_hb(atom)
5856 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5859 buffer(i,indx+22)=facont_hb(i,atom)
5860 buffer(i,indx+23)=ees0p(i,atom)
5861 buffer(i,indx+24)=ees0m(i,atom)
5862 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5864 buffer(1,indx+26)=dfloat(num_kont)
5867 c------------------------------------------------------------------------------
5868 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5869 implicit real*8 (a-h,o-z)
5870 include 'DIMENSIONS'
5871 integer dimen1,dimen2,atom,indx
5872 double precision buffer(dimen1,dimen2)
5873 double precision zapas
5874 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5875 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5876 & ees0m(ntyp,maxres),
5877 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5878 num_kont=buffer(1,indx+26)
5879 num_kont_old=num_cont_hb(atom)
5880 num_cont_hb(atom)=num_kont+num_kont_old
5885 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5888 facont_hb(ii,atom)=buffer(i,indx+22)
5889 ees0p(ii,atom)=buffer(i,indx+23)
5890 ees0m(ii,atom)=buffer(i,indx+24)
5891 jcont_hb(ii,atom)=buffer(i,indx+25)
5895 c------------------------------------------------------------------------------
5897 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5898 C This subroutine calculates multi-body contributions to hydrogen-bonding
5899 implicit real*8 (a-h,o-z)
5900 include 'DIMENSIONS'
5901 include 'DIMENSIONS.ZSCOPT'
5902 include 'COMMON.IOUNITS'
5904 include 'COMMON.INFO'
5906 include 'COMMON.FFIELD'
5907 include 'COMMON.DERIV'
5908 include 'COMMON.INTERACT'
5909 include 'COMMON.CONTACTS'
5911 parameter (max_cont=maxconts)
5912 parameter (max_dim=2*(8*3+2))
5913 parameter (msglen1=max_cont*max_dim*4)
5914 parameter (msglen2=2*msglen1)
5915 integer source,CorrelType,CorrelID,Error
5916 double precision buffer(max_cont,max_dim)
5918 double precision gx(3),gx1(3)
5921 C Set lprn=.true. for debugging
5926 if (fgProcs.le.1) goto 30
5928 write (iout,'(a)') 'Contact function values:'
5930 write (iout,'(2i3,50(1x,i2,f5.2))')
5931 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5932 & j=1,num_cont_hb(i))
5935 C Caution! Following code assumes that electrostatic interactions concerning
5936 C a given atom are split among at most two processors!
5946 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5949 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5950 if (MyRank.gt.0) then
5951 C Send correlation contributions to the preceding processor
5953 nn=num_cont_hb(iatel_s)
5954 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5955 cd write (iout,*) 'The BUFFER array:'
5957 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5959 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5961 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5962 C Clear the contacts of the atom passed to the neighboring processor
5963 nn=num_cont_hb(iatel_s+1)
5965 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5967 num_cont_hb(iatel_s)=0
5969 cd write (iout,*) 'Processor ',MyID,MyRank,
5970 cd & ' is sending correlation contribution to processor',MyID-1,
5971 cd & ' msglen=',msglen
5972 cd write (*,*) 'Processor ',MyID,MyRank,
5973 cd & ' is sending correlation contribution to processor',MyID-1,
5974 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5975 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5976 cd write (iout,*) 'Processor ',MyID,
5977 cd & ' has sent correlation contribution to processor',MyID-1,
5978 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5979 cd write (*,*) 'Processor ',MyID,
5980 cd & ' has sent correlation contribution to processor',MyID-1,
5981 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5983 endif ! (MyRank.gt.0)
5987 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5988 if (MyRank.lt.fgProcs-1) then
5989 C Receive correlation contributions from the next processor
5991 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5992 cd write (iout,*) 'Processor',MyID,
5993 cd & ' is receiving correlation contribution from processor',MyID+1,
5994 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5995 cd write (*,*) 'Processor',MyID,
5996 cd & ' is receiving correlation contribution from processor',MyID+1,
5997 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5999 do while (nbytes.le.0)
6000 call mp_probe(MyID+1,CorrelType,nbytes)
6002 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6003 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6004 cd write (iout,*) 'Processor',MyID,
6005 cd & ' has received correlation contribution from processor',MyID+1,
6006 cd & ' msglen=',msglen,' nbytes=',nbytes
6007 cd write (iout,*) 'The received BUFFER array:'
6009 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6011 if (msglen.eq.msglen1) then
6012 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6013 else if (msglen.eq.msglen2) then
6014 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6015 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6018 & 'ERROR!!!! message length changed while processing correlations.'
6020 & 'ERROR!!!! message length changed while processing correlations.'
6021 call mp_stopall(Error)
6022 endif ! msglen.eq.msglen1
6023 endif ! MyRank.lt.fgProcs-1
6030 write (iout,'(a)') 'Contact function values:'
6032 write (iout,'(2i3,50(1x,i2,f5.2))')
6033 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6034 & j=1,num_cont_hb(i))
6038 C Remove the loop below after debugging !!!
6045 C Calculate the local-electrostatic correlation terms
6046 do i=iatel_s,iatel_e+1
6048 num_conti=num_cont_hb(i)
6049 num_conti1=num_cont_hb(i+1)
6054 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6055 c & ' jj=',jj,' kk=',kk
6056 if (j1.eq.j+1 .or. j1.eq.j-1) then
6057 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6058 C The system gains extra energy.
6059 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6061 else if (j1.eq.j) then
6062 C Contacts I-J and I-(J+1) occur simultaneously.
6063 C The system loses extra energy.
6064 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6069 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6070 c & ' jj=',jj,' kk=',kk
6072 C Contacts I-J and (I+1)-J occur simultaneously.
6073 C The system loses extra energy.
6074 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6081 c------------------------------------------------------------------------------
6082 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6084 C This subroutine calculates multi-body contributions to hydrogen-bonding
6085 implicit real*8 (a-h,o-z)
6086 include 'DIMENSIONS'
6087 include 'DIMENSIONS.ZSCOPT'
6088 include 'COMMON.IOUNITS'
6090 include 'COMMON.INFO'
6092 include 'COMMON.FFIELD'
6093 include 'COMMON.DERIV'
6094 include 'COMMON.INTERACT'
6095 include 'COMMON.CONTACTS'
6097 parameter (max_cont=maxconts)
6098 parameter (max_dim=2*(8*3+2))
6099 parameter (msglen1=max_cont*max_dim*4)
6100 parameter (msglen2=2*msglen1)
6101 integer source,CorrelType,CorrelID,Error
6102 double precision buffer(max_cont,max_dim)
6104 double precision gx(3),gx1(3)
6107 C Set lprn=.true. for debugging
6114 if (fgProcs.le.1) goto 30
6116 write (iout,'(a)') 'Contact function values:'
6118 write (iout,'(2i3,50(1x,i2,f5.2))')
6119 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6120 & j=1,num_cont_hb(i))
6123 C Caution! Following code assumes that electrostatic interactions concerning
6124 C a given atom are split among at most two processors!
6134 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6137 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6138 if (MyRank.gt.0) then
6139 C Send correlation contributions to the preceding processor
6141 nn=num_cont_hb(iatel_s)
6142 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6143 cd write (iout,*) 'The BUFFER array:'
6145 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6147 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6149 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6150 C Clear the contacts of the atom passed to the neighboring processor
6151 nn=num_cont_hb(iatel_s+1)
6153 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6155 num_cont_hb(iatel_s)=0
6157 cd write (iout,*) 'Processor ',MyID,MyRank,
6158 cd & ' is sending correlation contribution to processor',MyID-1,
6159 cd & ' msglen=',msglen
6160 cd write (*,*) 'Processor ',MyID,MyRank,
6161 cd & ' is sending correlation contribution to processor',MyID-1,
6162 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6163 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6164 cd write (iout,*) 'Processor ',MyID,
6165 cd & ' has sent correlation contribution to processor',MyID-1,
6166 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6167 cd write (*,*) 'Processor ',MyID,
6168 cd & ' has sent correlation contribution to processor',MyID-1,
6169 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6171 endif ! (MyRank.gt.0)
6175 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6176 if (MyRank.lt.fgProcs-1) then
6177 C Receive correlation contributions from the next processor
6179 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6180 cd write (iout,*) 'Processor',MyID,
6181 cd & ' is receiving correlation contribution from processor',MyID+1,
6182 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6183 cd write (*,*) 'Processor',MyID,
6184 cd & ' is receiving correlation contribution from processor',MyID+1,
6185 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6187 do while (nbytes.le.0)
6188 call mp_probe(MyID+1,CorrelType,nbytes)
6190 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6191 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6192 cd write (iout,*) 'Processor',MyID,
6193 cd & ' has received correlation contribution from processor',MyID+1,
6194 cd & ' msglen=',msglen,' nbytes=',nbytes
6195 cd write (iout,*) 'The received BUFFER array:'
6197 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6199 if (msglen.eq.msglen1) then
6200 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6201 else if (msglen.eq.msglen2) then
6202 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6203 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6206 & 'ERROR!!!! message length changed while processing correlations.'
6208 & 'ERROR!!!! message length changed while processing correlations.'
6209 call mp_stopall(Error)
6210 endif ! msglen.eq.msglen1
6211 endif ! MyRank.lt.fgProcs-1
6218 write (iout,'(a)') 'Contact function values:'
6220 write (iout,'(2i3,50(1x,i2,f5.2))')
6221 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6222 & j=1,num_cont_hb(i))
6228 C Remove the loop below after debugging !!!
6235 C Calculate the dipole-dipole interaction energies
6236 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6237 do i=iatel_s,iatel_e+1
6238 num_conti=num_cont_hb(i)
6245 C Calculate the local-electrostatic correlation terms
6246 do i=iatel_s,iatel_e+1
6248 num_conti=num_cont_hb(i)
6249 num_conti1=num_cont_hb(i+1)
6254 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6255 c & ' jj=',jj,' kk=',kk
6256 if (j1.eq.j+1 .or. j1.eq.j-1) then
6257 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6258 C The system gains extra energy.
6260 sqd1=dsqrt(d_cont(jj,i))
6261 sqd2=dsqrt(d_cont(kk,i1))
6262 sred_geom = sqd1*sqd2
6263 IF (sred_geom.lt.cutoff_corr) THEN
6264 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6266 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6267 c & ' jj=',jj,' kk=',kk
6268 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6269 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6271 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6272 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6275 cd write (iout,*) 'sred_geom=',sred_geom,
6276 cd & ' ekont=',ekont,' fprim=',fprimcont
6277 call calc_eello(i,j,i+1,j1,jj,kk)
6278 if (wcorr4.gt.0.0d0)
6279 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6280 if (wcorr5.gt.0.0d0)
6281 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6282 c print *,"wcorr5",ecorr5
6283 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6284 cd write(2,*)'ijkl',i,j,i+1,j1
6285 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6286 & .or. wturn6.eq.0.0d0))then
6287 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6288 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6289 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6290 cd & 'ecorr6=',ecorr6
6291 cd write (iout,'(4e15.5)') sred_geom,
6292 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6293 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6294 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6295 else if (wturn6.gt.0.0d0
6296 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6297 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6298 eturn6=eturn6+eello_turn6(i,jj,kk)
6299 cd write (2,*) 'multibody_eello:eturn6',eturn6
6300 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6307 else if (j1.eq.j) then
6308 C Contacts I-J and I-(J+1) occur simultaneously.
6309 C The system loses extra energy.
6310 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6315 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6316 c & ' jj=',jj,' kk=',kk
6318 C Contacts I-J and (I+1)-J occur simultaneously.
6319 C The system loses extra energy.
6320 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6325 write (iout,*) "eturn6",eturn6,ecorr6
6328 c------------------------------------------------------------------------------
6329 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6330 implicit real*8 (a-h,o-z)
6331 include 'DIMENSIONS'
6332 include 'COMMON.IOUNITS'
6333 include 'COMMON.DERIV'
6334 include 'COMMON.INTERACT'
6335 include 'COMMON.CONTACTS'
6336 double precision gx(3),gx1(3)
6346 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6347 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6348 C Following 4 lines for diagnostics.
6353 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6355 c write (iout,*)'Contacts have occurred for peptide groups',
6356 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6357 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6358 C Calculate the multi-body contribution to energy.
6359 ecorr=ecorr+ekont*ees
6361 C Calculate multi-body contributions to the gradient.
6363 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6364 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6365 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6366 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6367 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6368 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6369 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6370 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6371 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6372 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6373 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6374 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6375 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6376 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6380 gradcorr(ll,m)=gradcorr(ll,m)+
6381 & ees*ekl*gacont_hbr(ll,jj,i)-
6382 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6383 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6388 gradcorr(ll,m)=gradcorr(ll,m)+
6389 & ees*eij*gacont_hbr(ll,kk,k)-
6390 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6391 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6398 C---------------------------------------------------------------------------
6399 subroutine dipole(i,j,jj)
6400 implicit real*8 (a-h,o-z)
6401 include 'DIMENSIONS'
6402 include 'DIMENSIONS.ZSCOPT'
6403 include 'COMMON.IOUNITS'
6404 include 'COMMON.CHAIN'
6405 include 'COMMON.FFIELD'
6406 include 'COMMON.DERIV'
6407 include 'COMMON.INTERACT'
6408 include 'COMMON.CONTACTS'
6409 include 'COMMON.TORSION'
6410 include 'COMMON.VAR'
6411 include 'COMMON.GEO'
6412 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6414 iti1 = itortyp(itype(i+1))
6415 if (j.lt.nres-1) then
6416 if (itype(j).le.ntyp) then
6417 itj1 = itortyp(itype(j+1))
6425 dipi(iii,1)=Ub2(iii,i)
6426 dipderi(iii)=Ub2der(iii,i)
6427 dipi(iii,2)=b1(iii,iti1)
6428 dipj(iii,1)=Ub2(iii,j)
6429 dipderj(iii)=Ub2der(iii,j)
6430 dipj(iii,2)=b1(iii,itj1)
6434 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6437 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6440 if (.not.calc_grad) return
6445 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6449 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6454 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6455 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6457 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6459 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6461 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6465 C---------------------------------------------------------------------------
6466 subroutine calc_eello(i,j,k,l,jj,kk)
6468 C This subroutine computes matrices and vectors needed to calculate
6469 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6471 implicit real*8 (a-h,o-z)
6472 include 'DIMENSIONS'
6473 include 'DIMENSIONS.ZSCOPT'
6474 include 'COMMON.IOUNITS'
6475 include 'COMMON.CHAIN'
6476 include 'COMMON.DERIV'
6477 include 'COMMON.INTERACT'
6478 include 'COMMON.CONTACTS'
6479 include 'COMMON.TORSION'
6480 include 'COMMON.VAR'
6481 include 'COMMON.GEO'
6482 include 'COMMON.FFIELD'
6483 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6484 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6487 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6488 cd & ' jj=',jj,' kk=',kk
6489 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6492 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6493 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6496 call transpose2(aa1(1,1),aa1t(1,1))
6497 call transpose2(aa2(1,1),aa2t(1,1))
6500 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6501 & aa1tder(1,1,lll,kkk))
6502 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6503 & aa2tder(1,1,lll,kkk))
6507 C parallel orientation of the two CA-CA-CA frames.
6508 if (i.gt.1 .and. itype(i).le.ntyp) then
6509 iti=itortyp(itype(i))
6513 itk1=itortyp(itype(k+1))
6514 itj=itortyp(itype(j))
6515 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6516 itl1=itortyp(itype(l+1))
6520 C A1 kernel(j+1) A2T
6522 cd write (iout,'(3f10.5,5x,3f10.5)')
6523 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6525 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6526 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6527 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6528 C Following matrices are needed only for 6-th order cumulants
6529 IF (wcorr6.gt.0.0d0) THEN
6530 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6531 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6532 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6533 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6534 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6535 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6536 & ADtEAderx(1,1,1,1,1,1))
6538 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6539 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6540 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6541 & ADtEA1derx(1,1,1,1,1,1))
6543 C End 6-th order cumulants
6546 cd write (2,*) 'In calc_eello6'
6548 cd write (2,*) 'iii=',iii
6550 cd write (2,*) 'kkk=',kkk
6552 cd write (2,'(3(2f10.5),5x)')
6553 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6558 call transpose2(EUgder(1,1,k),auxmat(1,1))
6559 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6560 call transpose2(EUg(1,1,k),auxmat(1,1))
6561 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6562 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6566 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6567 & EAEAderx(1,1,lll,kkk,iii,1))
6571 C A1T kernel(i+1) A2
6572 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6573 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6574 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6575 C Following matrices are needed only for 6-th order cumulants
6576 IF (wcorr6.gt.0.0d0) THEN
6577 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6578 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6579 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6580 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6581 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6582 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6583 & ADtEAderx(1,1,1,1,1,2))
6584 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6585 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6586 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6587 & ADtEA1derx(1,1,1,1,1,2))
6589 C End 6-th order cumulants
6590 call transpose2(EUgder(1,1,l),auxmat(1,1))
6591 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6592 call transpose2(EUg(1,1,l),auxmat(1,1))
6593 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6594 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6598 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6599 & EAEAderx(1,1,lll,kkk,iii,2))
6604 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6605 C They are needed only when the fifth- or the sixth-order cumulants are
6607 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6608 call transpose2(AEA(1,1,1),auxmat(1,1))
6609 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6610 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6611 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6612 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6613 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6614 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6615 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6616 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6617 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6618 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6619 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6620 call transpose2(AEA(1,1,2),auxmat(1,1))
6621 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6622 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6623 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6624 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6625 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6626 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6627 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6628 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6629 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6630 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6631 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6632 C Calculate the Cartesian derivatives of the vectors.
6636 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6637 call matvec2(auxmat(1,1),b1(1,iti),
6638 & AEAb1derx(1,lll,kkk,iii,1,1))
6639 call matvec2(auxmat(1,1),Ub2(1,i),
6640 & AEAb2derx(1,lll,kkk,iii,1,1))
6641 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6642 & AEAb1derx(1,lll,kkk,iii,2,1))
6643 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6644 & AEAb2derx(1,lll,kkk,iii,2,1))
6645 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6646 call matvec2(auxmat(1,1),b1(1,itj),
6647 & AEAb1derx(1,lll,kkk,iii,1,2))
6648 call matvec2(auxmat(1,1),Ub2(1,j),
6649 & AEAb2derx(1,lll,kkk,iii,1,2))
6650 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6651 & AEAb1derx(1,lll,kkk,iii,2,2))
6652 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6653 & AEAb2derx(1,lll,kkk,iii,2,2))
6660 C Antiparallel orientation of the two CA-CA-CA frames.
6661 if (i.gt.1 .and. itype(i).le.ntyp) then
6662 iti=itortyp(itype(i))
6666 itk1=itortyp(itype(k+1))
6667 itl=itortyp(itype(l))
6668 itj=itortyp(itype(j))
6669 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6670 itj1=itortyp(itype(j+1))
6674 C A2 kernel(j-1)T A1T
6675 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6676 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6677 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6678 C Following matrices are needed only for 6-th order cumulants
6679 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6680 & j.eq.i+4 .and. l.eq.i+3)) THEN
6681 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6682 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6683 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6684 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6685 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6686 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6687 & ADtEAderx(1,1,1,1,1,1))
6688 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6689 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6690 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6691 & ADtEA1derx(1,1,1,1,1,1))
6693 C End 6-th order cumulants
6694 call transpose2(EUgder(1,1,k),auxmat(1,1))
6695 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6696 call transpose2(EUg(1,1,k),auxmat(1,1))
6697 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6698 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6702 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6703 & EAEAderx(1,1,lll,kkk,iii,1))
6707 C A2T kernel(i+1)T A1
6708 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6709 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6710 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6711 C Following matrices are needed only for 6-th order cumulants
6712 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6713 & j.eq.i+4 .and. l.eq.i+3)) THEN
6714 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6715 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6716 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6717 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6718 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6719 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6720 & ADtEAderx(1,1,1,1,1,2))
6721 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6722 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6723 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6724 & ADtEA1derx(1,1,1,1,1,2))
6726 C End 6-th order cumulants
6727 call transpose2(EUgder(1,1,j),auxmat(1,1))
6728 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6729 call transpose2(EUg(1,1,j),auxmat(1,1))
6730 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6731 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6735 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6736 & EAEAderx(1,1,lll,kkk,iii,2))
6741 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6742 C They are needed only when the fifth- or the sixth-order cumulants are
6744 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6745 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6746 call transpose2(AEA(1,1,1),auxmat(1,1))
6747 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6748 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6749 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6750 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6751 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6752 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6753 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6754 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6755 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6756 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6757 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6758 call transpose2(AEA(1,1,2),auxmat(1,1))
6759 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6760 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6761 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6762 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6763 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6764 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6765 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6766 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6767 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6768 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6769 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6770 C Calculate the Cartesian derivatives of the vectors.
6774 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6775 call matvec2(auxmat(1,1),b1(1,iti),
6776 & AEAb1derx(1,lll,kkk,iii,1,1))
6777 call matvec2(auxmat(1,1),Ub2(1,i),
6778 & AEAb2derx(1,lll,kkk,iii,1,1))
6779 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6780 & AEAb1derx(1,lll,kkk,iii,2,1))
6781 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6782 & AEAb2derx(1,lll,kkk,iii,2,1))
6783 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6784 call matvec2(auxmat(1,1),b1(1,itl),
6785 & AEAb1derx(1,lll,kkk,iii,1,2))
6786 call matvec2(auxmat(1,1),Ub2(1,l),
6787 & AEAb2derx(1,lll,kkk,iii,1,2))
6788 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6789 & AEAb1derx(1,lll,kkk,iii,2,2))
6790 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6791 & AEAb2derx(1,lll,kkk,iii,2,2))
6800 C---------------------------------------------------------------------------
6801 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6802 & KK,KKderg,AKA,AKAderg,AKAderx)
6806 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6807 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6808 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6813 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6815 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6818 cd if (lprn) write (2,*) 'In kernel'
6820 cd if (lprn) write (2,*) 'kkk=',kkk
6822 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6823 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6825 cd write (2,*) 'lll=',lll
6826 cd write (2,*) 'iii=1'
6828 cd write (2,'(3(2f10.5),5x)')
6829 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6832 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6833 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6835 cd write (2,*) 'lll=',lll
6836 cd write (2,*) 'iii=2'
6838 cd write (2,'(3(2f10.5),5x)')
6839 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6846 C---------------------------------------------------------------------------
6847 double precision function eello4(i,j,k,l,jj,kk)
6848 implicit real*8 (a-h,o-z)
6849 include 'DIMENSIONS'
6850 include 'DIMENSIONS.ZSCOPT'
6851 include 'COMMON.IOUNITS'
6852 include 'COMMON.CHAIN'
6853 include 'COMMON.DERIV'
6854 include 'COMMON.INTERACT'
6855 include 'COMMON.CONTACTS'
6856 include 'COMMON.TORSION'
6857 include 'COMMON.VAR'
6858 include 'COMMON.GEO'
6859 double precision pizda(2,2),ggg1(3),ggg2(3)
6860 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6864 cd print *,'eello4:',i,j,k,l,jj,kk
6865 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6866 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6867 cold eij=facont_hb(jj,i)
6868 cold ekl=facont_hb(kk,k)
6870 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6872 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6873 gcorr_loc(k-1)=gcorr_loc(k-1)
6874 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6876 gcorr_loc(l-1)=gcorr_loc(l-1)
6877 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6879 gcorr_loc(j-1)=gcorr_loc(j-1)
6880 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6885 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6886 & -EAEAderx(2,2,lll,kkk,iii,1)
6887 cd derx(lll,kkk,iii)=0.0d0
6891 cd gcorr_loc(l-1)=0.0d0
6892 cd gcorr_loc(j-1)=0.0d0
6893 cd gcorr_loc(k-1)=0.0d0
6895 cd write (iout,*)'Contacts have occurred for peptide groups',
6896 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6897 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6898 if (j.lt.nres-1) then
6905 if (l.lt.nres-1) then
6913 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6914 ggg1(ll)=eel4*g_contij(ll,1)
6915 ggg2(ll)=eel4*g_contij(ll,2)
6916 ghalf=0.5d0*ggg1(ll)
6918 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6919 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6920 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6921 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6922 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6923 ghalf=0.5d0*ggg2(ll)
6925 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6926 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6927 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6928 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6933 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6934 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6939 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6940 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6946 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6951 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6955 cd write (2,*) iii,gcorr_loc(iii)
6959 cd write (2,*) 'ekont',ekont
6960 cd write (iout,*) 'eello4',ekont*eel4
6963 C---------------------------------------------------------------------------
6964 double precision function eello5(i,j,k,l,jj,kk)
6965 implicit real*8 (a-h,o-z)
6966 include 'DIMENSIONS'
6967 include 'DIMENSIONS.ZSCOPT'
6968 include 'COMMON.IOUNITS'
6969 include 'COMMON.CHAIN'
6970 include 'COMMON.DERIV'
6971 include 'COMMON.INTERACT'
6972 include 'COMMON.CONTACTS'
6973 include 'COMMON.TORSION'
6974 include 'COMMON.VAR'
6975 include 'COMMON.GEO'
6976 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6977 double precision ggg1(3),ggg2(3)
6978 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6983 C /l\ / \ \ / \ / \ / C
6984 C / \ / \ \ / \ / \ / C
6985 C j| o |l1 | o | o| o | | o |o C
6986 C \ |/k\| |/ \| / |/ \| |/ \| C
6987 C \i/ \ / \ / / \ / \ C
6989 C (I) (II) (III) (IV) C
6991 C eello5_1 eello5_2 eello5_3 eello5_4 C
6993 C Antiparallel chains C
6996 C /j\ / \ \ / \ / \ / C
6997 C / \ / \ \ / \ / \ / C
6998 C j1| o |l | o | o| o | | o |o C
6999 C \ |/k\| |/ \| / |/ \| |/ \| C
7000 C \i/ \ / \ / / \ / \ C
7002 C (I) (II) (III) (IV) C
7004 C eello5_1 eello5_2 eello5_3 eello5_4 C
7006 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7008 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7009 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7014 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7016 itk=itortyp(itype(k))
7017 itl=itortyp(itype(l))
7018 itj=itortyp(itype(j))
7023 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7024 cd & eel5_3_num,eel5_4_num)
7028 derx(lll,kkk,iii)=0.0d0
7032 cd eij=facont_hb(jj,i)
7033 cd ekl=facont_hb(kk,k)
7035 cd write (iout,*)'Contacts have occurred for peptide groups',
7036 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7038 C Contribution from the graph I.
7039 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7040 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7041 call transpose2(EUg(1,1,k),auxmat(1,1))
7042 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7043 vv(1)=pizda(1,1)-pizda(2,2)
7044 vv(2)=pizda(1,2)+pizda(2,1)
7045 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7046 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7048 C Explicit gradient in virtual-dihedral angles.
7049 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7050 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7051 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7052 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7053 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7054 vv(1)=pizda(1,1)-pizda(2,2)
7055 vv(2)=pizda(1,2)+pizda(2,1)
7056 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7057 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7058 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7059 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7060 vv(1)=pizda(1,1)-pizda(2,2)
7061 vv(2)=pizda(1,2)+pizda(2,1)
7063 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7064 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7065 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7067 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7068 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7069 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7071 C Cartesian gradient
7075 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7077 vv(1)=pizda(1,1)-pizda(2,2)
7078 vv(2)=pizda(1,2)+pizda(2,1)
7079 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7080 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7081 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7088 C Contribution from graph II
7089 call transpose2(EE(1,1,itk),auxmat(1,1))
7090 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7091 vv(1)=pizda(1,1)+pizda(2,2)
7092 vv(2)=pizda(2,1)-pizda(1,2)
7093 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7094 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7096 C Explicit gradient in virtual-dihedral angles.
7097 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7098 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7099 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7100 vv(1)=pizda(1,1)+pizda(2,2)
7101 vv(2)=pizda(2,1)-pizda(1,2)
7103 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7104 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7105 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7107 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7108 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7109 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7111 C Cartesian gradient
7115 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7117 vv(1)=pizda(1,1)+pizda(2,2)
7118 vv(2)=pizda(2,1)-pizda(1,2)
7119 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7120 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7121 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7130 C Parallel orientation
7131 C Contribution from graph III
7132 call transpose2(EUg(1,1,l),auxmat(1,1))
7133 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7134 vv(1)=pizda(1,1)-pizda(2,2)
7135 vv(2)=pizda(1,2)+pizda(2,1)
7136 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7137 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7139 C Explicit gradient in virtual-dihedral angles.
7140 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7141 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7142 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7143 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7144 vv(1)=pizda(1,1)-pizda(2,2)
7145 vv(2)=pizda(1,2)+pizda(2,1)
7146 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7147 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7148 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7149 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7150 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7151 vv(1)=pizda(1,1)-pizda(2,2)
7152 vv(2)=pizda(1,2)+pizda(2,1)
7153 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7154 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7155 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7156 C Cartesian gradient
7160 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7162 vv(1)=pizda(1,1)-pizda(2,2)
7163 vv(2)=pizda(1,2)+pizda(2,1)
7164 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7165 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7166 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7172 C Contribution from graph IV
7174 call transpose2(EE(1,1,itl),auxmat(1,1))
7175 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7176 vv(1)=pizda(1,1)+pizda(2,2)
7177 vv(2)=pizda(2,1)-pizda(1,2)
7178 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7179 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7181 C Explicit gradient in virtual-dihedral angles.
7182 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7183 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7184 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7185 vv(1)=pizda(1,1)+pizda(2,2)
7186 vv(2)=pizda(2,1)-pizda(1,2)
7187 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7188 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7189 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7190 C Cartesian gradient
7194 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7196 vv(1)=pizda(1,1)+pizda(2,2)
7197 vv(2)=pizda(2,1)-pizda(1,2)
7198 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7199 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7200 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7206 C Antiparallel orientation
7207 C Contribution from graph III
7209 call transpose2(EUg(1,1,j),auxmat(1,1))
7210 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7211 vv(1)=pizda(1,1)-pizda(2,2)
7212 vv(2)=pizda(1,2)+pizda(2,1)
7213 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7214 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7216 C Explicit gradient in virtual-dihedral angles.
7217 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7218 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7219 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7220 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7221 vv(1)=pizda(1,1)-pizda(2,2)
7222 vv(2)=pizda(1,2)+pizda(2,1)
7223 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7224 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7225 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7226 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7227 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7228 vv(1)=pizda(1,1)-pizda(2,2)
7229 vv(2)=pizda(1,2)+pizda(2,1)
7230 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7231 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7232 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7233 C Cartesian gradient
7237 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7239 vv(1)=pizda(1,1)-pizda(2,2)
7240 vv(2)=pizda(1,2)+pizda(2,1)
7241 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7242 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7243 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7249 C Contribution from graph IV
7251 call transpose2(EE(1,1,itj),auxmat(1,1))
7252 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7253 vv(1)=pizda(1,1)+pizda(2,2)
7254 vv(2)=pizda(2,1)-pizda(1,2)
7255 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7256 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7258 C Explicit gradient in virtual-dihedral angles.
7259 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7260 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7261 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7262 vv(1)=pizda(1,1)+pizda(2,2)
7263 vv(2)=pizda(2,1)-pizda(1,2)
7264 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7265 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7266 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7267 C Cartesian gradient
7271 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7273 vv(1)=pizda(1,1)+pizda(2,2)
7274 vv(2)=pizda(2,1)-pizda(1,2)
7275 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7276 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7277 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7284 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7285 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7286 cd write (2,*) 'ijkl',i,j,k,l
7287 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7288 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7290 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7291 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7292 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7293 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7295 if (j.lt.nres-1) then
7302 if (l.lt.nres-1) then
7312 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7314 ggg1(ll)=eel5*g_contij(ll,1)
7315 ggg2(ll)=eel5*g_contij(ll,2)
7316 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7317 ghalf=0.5d0*ggg1(ll)
7319 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7320 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7321 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7322 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7323 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7324 ghalf=0.5d0*ggg2(ll)
7326 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7327 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7328 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7329 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7334 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7335 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7340 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7341 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7347 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7352 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7356 cd write (2,*) iii,g_corr5_loc(iii)
7360 cd write (2,*) 'ekont',ekont
7361 cd write (iout,*) 'eello5',ekont*eel5
7364 c--------------------------------------------------------------------------
7365 double precision function eello6(i,j,k,l,jj,kk)
7366 implicit real*8 (a-h,o-z)
7367 include 'DIMENSIONS'
7368 include 'DIMENSIONS.ZSCOPT'
7369 include 'COMMON.IOUNITS'
7370 include 'COMMON.CHAIN'
7371 include 'COMMON.DERIV'
7372 include 'COMMON.INTERACT'
7373 include 'COMMON.CONTACTS'
7374 include 'COMMON.TORSION'
7375 include 'COMMON.VAR'
7376 include 'COMMON.GEO'
7377 include 'COMMON.FFIELD'
7378 double precision ggg1(3),ggg2(3)
7379 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7384 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7392 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7393 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7397 derx(lll,kkk,iii)=0.0d0
7401 cd eij=facont_hb(jj,i)
7402 cd ekl=facont_hb(kk,k)
7408 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7409 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7410 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7411 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7412 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7413 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7415 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7416 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7417 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7418 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7419 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7420 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7424 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7426 C If turn contributions are considered, they will be handled separately.
7427 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7428 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7429 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7430 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7431 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7432 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7433 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7436 if (j.lt.nres-1) then
7443 if (l.lt.nres-1) then
7451 ggg1(ll)=eel6*g_contij(ll,1)
7452 ggg2(ll)=eel6*g_contij(ll,2)
7453 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7454 ghalf=0.5d0*ggg1(ll)
7456 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7457 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7458 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7459 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7460 ghalf=0.5d0*ggg2(ll)
7461 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7463 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7464 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7465 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7466 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7471 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7472 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7477 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7478 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7484 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7489 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7493 cd write (2,*) iii,g_corr6_loc(iii)
7497 cd write (2,*) 'ekont',ekont
7498 cd write (iout,*) 'eello6',ekont*eel6
7501 c--------------------------------------------------------------------------
7502 double precision function eello6_graph1(i,j,k,l,imat,swap)
7503 implicit real*8 (a-h,o-z)
7504 include 'DIMENSIONS'
7505 include 'DIMENSIONS.ZSCOPT'
7506 include 'COMMON.IOUNITS'
7507 include 'COMMON.CHAIN'
7508 include 'COMMON.DERIV'
7509 include 'COMMON.INTERACT'
7510 include 'COMMON.CONTACTS'
7511 include 'COMMON.TORSION'
7512 include 'COMMON.VAR'
7513 include 'COMMON.GEO'
7514 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7520 C Parallel Antiparallel C
7526 C \ j|/k\| / \ |/k\|l / C
7531 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7532 itk=itortyp(itype(k))
7533 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7534 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7535 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7536 call transpose2(EUgC(1,1,k),auxmat(1,1))
7537 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7538 vv1(1)=pizda1(1,1)-pizda1(2,2)
7539 vv1(2)=pizda1(1,2)+pizda1(2,1)
7540 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7541 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7542 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7543 s5=scalar2(vv(1),Dtobr2(1,i))
7544 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7545 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7546 if (.not. calc_grad) return
7547 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7548 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7549 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7550 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7551 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7552 & +scalar2(vv(1),Dtobr2der(1,i)))
7553 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7554 vv1(1)=pizda1(1,1)-pizda1(2,2)
7555 vv1(2)=pizda1(1,2)+pizda1(2,1)
7556 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7557 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7559 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7560 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7561 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7562 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7563 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7565 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7566 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7567 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7568 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7569 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7571 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7572 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7573 vv1(1)=pizda1(1,1)-pizda1(2,2)
7574 vv1(2)=pizda1(1,2)+pizda1(2,1)
7575 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7576 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7577 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7578 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7587 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7588 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7589 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7590 call transpose2(EUgC(1,1,k),auxmat(1,1))
7591 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7593 vv1(1)=pizda1(1,1)-pizda1(2,2)
7594 vv1(2)=pizda1(1,2)+pizda1(2,1)
7595 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7596 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7597 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7598 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7599 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7600 s5=scalar2(vv(1),Dtobr2(1,i))
7601 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7607 c----------------------------------------------------------------------------
7608 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7609 implicit real*8 (a-h,o-z)
7610 include 'DIMENSIONS'
7611 include 'DIMENSIONS.ZSCOPT'
7612 include 'COMMON.IOUNITS'
7613 include 'COMMON.CHAIN'
7614 include 'COMMON.DERIV'
7615 include 'COMMON.INTERACT'
7616 include 'COMMON.CONTACTS'
7617 include 'COMMON.TORSION'
7618 include 'COMMON.VAR'
7619 include 'COMMON.GEO'
7621 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7622 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7625 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7627 C Parallel Antiparallel C
7633 C \ j|/k\| \ |/k\|l C
7638 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7639 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7640 C AL 7/4/01 s1 would occur in the sixth-order moment,
7641 C but not in a cluster cumulant
7643 s1=dip(1,jj,i)*dip(1,kk,k)
7645 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7646 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7647 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7648 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7649 call transpose2(EUg(1,1,k),auxmat(1,1))
7650 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7651 vv(1)=pizda(1,1)-pizda(2,2)
7652 vv(2)=pizda(1,2)+pizda(2,1)
7653 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7654 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7656 eello6_graph2=-(s1+s2+s3+s4)
7658 eello6_graph2=-(s2+s3+s4)
7661 if (.not. calc_grad) return
7662 C Derivatives in gamma(i-1)
7665 s1=dipderg(1,jj,i)*dip(1,kk,k)
7667 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7668 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7669 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7670 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7672 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7674 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7676 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7678 C Derivatives in gamma(k-1)
7680 s1=dip(1,jj,i)*dipderg(1,kk,k)
7682 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7683 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7684 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7685 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7686 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7687 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7688 vv(1)=pizda(1,1)-pizda(2,2)
7689 vv(2)=pizda(1,2)+pizda(2,1)
7690 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7692 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7694 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7696 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7697 C Derivatives in gamma(j-1) or gamma(l-1)
7700 s1=dipderg(3,jj,i)*dip(1,kk,k)
7702 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7703 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7704 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7705 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7706 vv(1)=pizda(1,1)-pizda(2,2)
7707 vv(2)=pizda(1,2)+pizda(2,1)
7708 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7711 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7713 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7716 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7717 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7719 C Derivatives in gamma(l-1) or gamma(j-1)
7722 s1=dip(1,jj,i)*dipderg(3,kk,k)
7724 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7725 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7726 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7727 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7728 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7729 vv(1)=pizda(1,1)-pizda(2,2)
7730 vv(2)=pizda(1,2)+pizda(2,1)
7731 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7734 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7736 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7739 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7740 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7742 C Cartesian derivatives.
7744 write (2,*) 'In eello6_graph2'
7746 write (2,*) 'iii=',iii
7748 write (2,*) 'kkk=',kkk
7750 write (2,'(3(2f10.5),5x)')
7751 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7761 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7763 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7766 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7768 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7769 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7771 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7772 call transpose2(EUg(1,1,k),auxmat(1,1))
7773 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7775 vv(1)=pizda(1,1)-pizda(2,2)
7776 vv(2)=pizda(1,2)+pizda(2,1)
7777 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7778 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7780 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7782 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7785 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7787 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7794 c----------------------------------------------------------------------------
7795 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7796 implicit real*8 (a-h,o-z)
7797 include 'DIMENSIONS'
7798 include 'DIMENSIONS.ZSCOPT'
7799 include 'COMMON.IOUNITS'
7800 include 'COMMON.CHAIN'
7801 include 'COMMON.DERIV'
7802 include 'COMMON.INTERACT'
7803 include 'COMMON.CONTACTS'
7804 include 'COMMON.TORSION'
7805 include 'COMMON.VAR'
7806 include 'COMMON.GEO'
7807 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7811 C Parallel Antiparallel C
7817 C j|/k\| / |/k\|l / C
7822 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7824 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7825 C energy moment and not to the cluster cumulant.
7826 iti=itortyp(itype(i))
7827 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7828 itj1=itortyp(itype(j+1))
7832 itk=itortyp(itype(k))
7833 itk1=itortyp(itype(k+1))
7834 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7835 itl1=itortyp(itype(l+1))
7840 s1=dip(4,jj,i)*dip(4,kk,k)
7842 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7843 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7844 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7845 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7846 call transpose2(EE(1,1,itk),auxmat(1,1))
7847 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7848 vv(1)=pizda(1,1)+pizda(2,2)
7849 vv(2)=pizda(2,1)-pizda(1,2)
7850 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7851 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7853 eello6_graph3=-(s1+s2+s3+s4)
7855 eello6_graph3=-(s2+s3+s4)
7858 if (.not. calc_grad) return
7859 C Derivatives in gamma(k-1)
7860 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7861 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7862 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7863 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7864 C Derivatives in gamma(l-1)
7865 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7866 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7867 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7868 vv(1)=pizda(1,1)+pizda(2,2)
7869 vv(2)=pizda(2,1)-pizda(1,2)
7870 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7871 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7872 C Cartesian derivatives.
7878 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7880 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7883 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7885 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7886 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7888 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7889 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7891 vv(1)=pizda(1,1)+pizda(2,2)
7892 vv(2)=pizda(2,1)-pizda(1,2)
7893 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7895 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7897 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7900 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7902 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7904 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7910 c----------------------------------------------------------------------------
7911 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7912 implicit real*8 (a-h,o-z)
7913 include 'DIMENSIONS'
7914 include 'DIMENSIONS.ZSCOPT'
7915 include 'COMMON.IOUNITS'
7916 include 'COMMON.CHAIN'
7917 include 'COMMON.DERIV'
7918 include 'COMMON.INTERACT'
7919 include 'COMMON.CONTACTS'
7920 include 'COMMON.TORSION'
7921 include 'COMMON.VAR'
7922 include 'COMMON.GEO'
7923 include 'COMMON.FFIELD'
7924 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7925 & auxvec1(2),auxmat1(2,2)
7927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7929 C Parallel Antiparallel C
7935 C \ j|/k\| \ |/k\|l C
7940 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7942 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7943 C energy moment and not to the cluster cumulant.
7944 cd write (2,*) 'eello_graph4: wturn6',wturn6
7945 iti=itortyp(itype(i))
7946 itj=itortyp(itype(j))
7947 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7948 itj1=itortyp(itype(j+1))
7952 itk=itortyp(itype(k))
7953 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7954 itk1=itortyp(itype(k+1))
7958 itl=itortyp(itype(l))
7959 if (l.lt.nres-1) then
7960 itl1=itortyp(itype(l+1))
7964 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7965 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7966 cd & ' itl',itl,' itl1',itl1
7969 s1=dip(3,jj,i)*dip(3,kk,k)
7971 s1=dip(2,jj,j)*dip(2,kk,l)
7974 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7975 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7977 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7978 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7980 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7981 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7983 call transpose2(EUg(1,1,k),auxmat(1,1))
7984 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7985 vv(1)=pizda(1,1)-pizda(2,2)
7986 vv(2)=pizda(2,1)+pizda(1,2)
7987 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7988 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7990 eello6_graph4=-(s1+s2+s3+s4)
7992 eello6_graph4=-(s2+s3+s4)
7994 if (.not. calc_grad) return
7995 C Derivatives in gamma(i-1)
7999 s1=dipderg(2,jj,i)*dip(3,kk,k)
8001 s1=dipderg(4,jj,j)*dip(2,kk,l)
8004 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8006 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8007 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8009 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8010 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8012 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8013 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8014 cd write (2,*) 'turn6 derivatives'
8016 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8018 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8022 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8024 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8028 C Derivatives in gamma(k-1)
8031 s1=dip(3,jj,i)*dipderg(2,kk,k)
8033 s1=dip(2,jj,j)*dipderg(4,kk,l)
8036 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8037 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8039 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8040 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8042 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8043 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8045 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8046 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8047 vv(1)=pizda(1,1)-pizda(2,2)
8048 vv(2)=pizda(2,1)+pizda(1,2)
8049 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8050 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8052 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8054 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8058 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8060 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8063 C Derivatives in gamma(j-1) or gamma(l-1)
8064 if (l.eq.j+1 .and. l.gt.1) then
8065 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8066 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8067 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8068 vv(1)=pizda(1,1)-pizda(2,2)
8069 vv(2)=pizda(2,1)+pizda(1,2)
8070 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8071 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8072 else if (j.gt.1) then
8073 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8074 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8075 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8076 vv(1)=pizda(1,1)-pizda(2,2)
8077 vv(2)=pizda(2,1)+pizda(1,2)
8078 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8079 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8080 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8082 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8085 C Cartesian derivatives.
8092 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8094 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8098 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8100 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8104 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8106 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8108 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8109 & b1(1,itj1),auxvec(1))
8110 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8112 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8113 & b1(1,itl1),auxvec(1))
8114 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8116 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8118 vv(1)=pizda(1,1)-pizda(2,2)
8119 vv(2)=pizda(2,1)+pizda(1,2)
8120 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8124 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8127 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8130 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8133 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8135 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8137 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8141 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8143 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8146 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8148 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8156 c----------------------------------------------------------------------------
8157 double precision function eello_turn6(i,jj,kk)
8158 implicit real*8 (a-h,o-z)
8159 include 'DIMENSIONS'
8160 include 'DIMENSIONS.ZSCOPT'
8161 include 'COMMON.IOUNITS'
8162 include 'COMMON.CHAIN'
8163 include 'COMMON.DERIV'
8164 include 'COMMON.INTERACT'
8165 include 'COMMON.CONTACTS'
8166 include 'COMMON.TORSION'
8167 include 'COMMON.VAR'
8168 include 'COMMON.GEO'
8169 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8170 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8172 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8173 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8174 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8175 C the respective energy moment and not to the cluster cumulant.
8180 iti=itortyp(itype(i))
8181 itk=itortyp(itype(k))
8182 itk1=itortyp(itype(k+1))
8183 itl=itortyp(itype(l))
8184 itj=itortyp(itype(j))
8185 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8186 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8187 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8192 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8194 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8198 derx_turn(lll,kkk,iii)=0.0d0
8205 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8207 cd write (2,*) 'eello6_5',eello6_5
8209 call transpose2(AEA(1,1,1),auxmat(1,1))
8210 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8211 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8212 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8216 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8217 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8218 s2 = scalar2(b1(1,itk),vtemp1(1))
8220 call transpose2(AEA(1,1,2),atemp(1,1))
8221 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8222 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8223 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8227 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8228 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8229 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8231 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8232 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8233 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8234 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8235 ss13 = scalar2(b1(1,itk),vtemp4(1))
8236 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8240 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8246 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8248 C Derivatives in gamma(i+2)
8250 call transpose2(AEA(1,1,1),auxmatd(1,1))
8251 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8252 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8253 call transpose2(AEAderg(1,1,2),atempd(1,1))
8254 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8255 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8259 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8260 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8261 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8267 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8268 C Derivatives in gamma(i+3)
8270 call transpose2(AEA(1,1,1),auxmatd(1,1))
8271 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8272 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8273 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8277 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8278 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8279 s2d = scalar2(b1(1,itk),vtemp1d(1))
8281 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8282 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8284 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8286 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8287 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8288 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8298 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8299 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8301 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8302 & -0.5d0*ekont*(s2d+s12d)
8304 C Derivatives in gamma(i+4)
8305 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8306 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8307 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8309 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8310 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8311 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8321 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8323 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8325 C Derivatives in gamma(i+5)
8327 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8328 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8329 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8333 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8334 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8335 s2d = scalar2(b1(1,itk),vtemp1d(1))
8337 call transpose2(AEA(1,1,2),atempd(1,1))
8338 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8339 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8343 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8344 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8346 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8347 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8348 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8358 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8359 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8361 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8362 & -0.5d0*ekont*(s2d+s12d)
8364 C Cartesian derivatives
8369 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8370 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8371 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8375 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8376 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8378 s2d = scalar2(b1(1,itk),vtemp1d(1))
8380 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8381 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8382 s8d = -(atempd(1,1)+atempd(2,2))*
8383 & scalar2(cc(1,1,itl),vtemp2(1))
8387 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8389 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8390 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8397 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8400 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8404 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8405 & - 0.5d0*(s8d+s12d)
8407 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8416 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8418 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8419 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8420 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8421 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8422 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8424 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8425 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8426 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8430 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8431 cd & 16*eel_turn6_num
8433 if (j.lt.nres-1) then
8440 if (l.lt.nres-1) then
8448 ggg1(ll)=eel_turn6*g_contij(ll,1)
8449 ggg2(ll)=eel_turn6*g_contij(ll,2)
8450 ghalf=0.5d0*ggg1(ll)
8452 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8453 & +ekont*derx_turn(ll,2,1)
8454 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8455 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8456 & +ekont*derx_turn(ll,4,1)
8457 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8458 ghalf=0.5d0*ggg2(ll)
8460 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8461 & +ekont*derx_turn(ll,2,2)
8462 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8463 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8464 & +ekont*derx_turn(ll,4,2)
8465 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8470 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8475 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8481 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8486 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8490 cd write (2,*) iii,g_corr6_loc(iii)
8493 eello_turn6=ekont*eel_turn6
8494 cd write (2,*) 'ekont',ekont
8495 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8498 crc-------------------------------------------------
8499 SUBROUTINE MATVEC2(A1,V1,V2)
8500 implicit real*8 (a-h,o-z)
8501 include 'DIMENSIONS'
8502 DIMENSION A1(2,2),V1(2),V2(2)
8506 c 3 VI=VI+A1(I,K)*V1(K)
8510 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8511 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8516 C---------------------------------------
8517 SUBROUTINE MATMAT2(A1,A2,A3)
8518 implicit real*8 (a-h,o-z)
8519 include 'DIMENSIONS'
8520 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8521 c DIMENSION AI3(2,2)
8525 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8531 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8532 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8533 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8534 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8542 c-------------------------------------------------------------------------
8543 double precision function scalar2(u,v)
8545 double precision u(2),v(2)
8548 scalar2=u(1)*v(1)+u(2)*v(2)
8552 C-----------------------------------------------------------------------------
8554 subroutine transpose2(a,at)
8556 double precision a(2,2),at(2,2)
8563 c--------------------------------------------------------------------------
8564 subroutine transpose(n,a,at)
8567 double precision a(n,n),at(n,n)
8575 C---------------------------------------------------------------------------
8576 subroutine prodmat3(a1,a2,kk,transp,prod)
8579 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8581 crc double precision auxmat(2,2),prod_(2,2)
8584 crc call transpose2(kk(1,1),auxmat(1,1))
8585 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8586 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8588 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8589 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8590 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8591 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8592 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8593 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8594 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8595 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8598 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8599 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8601 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8602 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8603 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8604 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8605 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8606 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8607 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8608 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8611 c call transpose2(a2(1,1),a2t(1,1))
8614 crc print *,((prod_(i,j),i=1,2),j=1,2)
8615 crc print *,((prod(i,j),i=1,2),j=1,2)
8619 C-----------------------------------------------------------------------------
8620 double precision function scalar(u,v)
8622 double precision u(3),v(3)
8632 C-----------------------------------------------------------------------
8633 double precision function sscale(r)
8634 double precision r,gamm
8635 include "COMMON.SPLITELE"
8636 if(r.lt.r_cut-rlamb) then
8638 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8639 gamm=(r-(r_cut-rlamb))/rlamb
8640 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8646 C-----------------------------------------------------------------------
8647 C-----------------------------------------------------------------------
8648 double precision function sscagrad(r)
8649 double precision r,gamm
8650 include "COMMON.SPLITELE"
8651 if(r.lt.r_cut-rlamb) then
8653 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8654 gamm=(r-(r_cut-rlamb))/rlamb
8655 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8661 C-----------------------------------------------------------------------
8662 C-----------------------------------------------------------------------
8663 double precision function sscalelip(r)
8664 double precision r,gamm
8665 include "COMMON.SPLITELE"
8666 C if(r.lt.r_cut-rlamb) then
8668 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8669 C gamm=(r-(r_cut-rlamb))/rlamb
8670 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8676 C-----------------------------------------------------------------------
8677 double precision function sscagradlip(r)
8678 double precision r,gamm
8679 include "COMMON.SPLITELE"
8680 C if(r.lt.r_cut-rlamb) then
8682 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8683 C gamm=(r-(r_cut-rlamb))/rlamb
8684 sscagradlip=r*(6*r-6.0d0)
8690 c----------------------------------------------------------------------------
8691 double precision function sscale2(r,r_cut,r0,rlamb)
8693 double precision r,gamm,r_cut,r0,rlamb,rr
8695 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
8696 c write (2,*) "rr",rr
8697 if(rr.lt.r_cut-rlamb) then
8699 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8700 gamm=(rr-(r_cut-rlamb))/rlamb
8701 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8707 C-----------------------------------------------------------------------
8708 double precision function sscalgrad2(r,r_cut,r0,rlamb)
8710 double precision r,gamm,r_cut,r0,rlamb,rr
8712 if(rr.lt.r_cut-rlamb) then
8714 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8715 gamm=(rr-(r_cut-rlamb))/rlamb
8717 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
8719 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
8726 c----------------------------------------------------------------------------
8727 subroutine e_saxs(Esaxs_constr)
8729 include 'DIMENSIONS'
8730 include 'DIMENSIONS.ZSCOPT'
8731 include 'DIMENSIONS.FREE'
8734 include "COMMON.SETUP"
8737 include 'COMMON.SBRIDGE'
8738 include 'COMMON.CHAIN'
8739 include 'COMMON.GEO'
8740 include 'COMMON.LOCAL'
8741 include 'COMMON.INTERACT'
8742 include 'COMMON.VAR'
8743 include 'COMMON.IOUNITS'
8744 include 'COMMON.DERIV'
8745 include 'COMMON.CONTROL'
8746 include 'COMMON.NAMES'
8747 include 'COMMON.FFIELD'
8748 include 'COMMON.LANGEVIN'
8750 double precision Esaxs_constr
8751 integer i,iint,j,k,l
8752 double precision PgradC(maxSAXS,3,maxres),
8753 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
8755 double precision PgradC_(maxSAXS,3,maxres),
8756 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
8758 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
8759 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
8760 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
8761 & auxX,auxX1,CACAgrad,Cnorm
8762 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
8763 double precision dist
8765 c SAXS restraint penalty function
8767 write(iout,*) "------- SAXS penalty function start -------"
8768 write (iout,*) "nsaxs",nsaxs
8769 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
8770 write (iout,*) "Psaxs"
8772 write (iout,'(i5,e15.5)') i, Psaxs(i)
8775 Esaxs_constr = 0.0d0
8785 do i=iatsc_s,iatsc_e
8786 if (itype(i).eq.ntyp1) cycle
8787 do iint=1,nint_gr(i)
8788 do j=istart(i,iint),iend(i,iint)
8789 if (itype(j).eq.ntyp1) cycle
8792 dijCASC=dist(i,j+nres)
8793 dijSCCA=dist(i+nres,j)
8794 dijSCSC=dist(i+nres,j+nres)
8795 sigma2CACA=2.0d0/(pstok**2)
8796 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
8797 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
8798 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
8801 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8802 if (itype(j).ne.10) then
8803 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
8807 if (itype(i).ne.10) then
8808 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
8812 if (itype(i).ne.10 .and. itype(j).ne.10) then
8813 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
8817 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
8819 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8821 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8822 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
8823 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
8824 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
8827 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8828 PgradC(k,l,i) = PgradC(k,l,i)-aux
8829 PgradC(k,l,j) = PgradC(k,l,j)+aux
8831 if (itype(j).ne.10) then
8832 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
8833 PgradC(k,l,i) = PgradC(k,l,i)-aux
8834 PgradC(k,l,j) = PgradC(k,l,j)+aux
8835 PgradX(k,l,j) = PgradX(k,l,j)+aux
8838 if (itype(i).ne.10) then
8839 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
8840 PgradX(k,l,i) = PgradX(k,l,i)-aux
8841 PgradC(k,l,i) = PgradC(k,l,i)-aux
8842 PgradC(k,l,j) = PgradC(k,l,j)+aux
8845 if (itype(i).ne.10 .and. itype(j).ne.10) then
8846 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
8847 PgradC(k,l,i) = PgradC(k,l,i)-aux
8848 PgradC(k,l,j) = PgradC(k,l,j)+aux
8849 PgradX(k,l,i) = PgradX(k,l,i)-aux
8850 PgradX(k,l,j) = PgradX(k,l,j)+aux
8856 sigma2CACA=scal_rad**2*0.25d0/
8857 & (restok(itype(j))**2+restok(itype(i))**2)
8859 IF (saxs_cutoff.eq.0) THEN
8862 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8863 Pcalc(k) = Pcalc(k)+expCACA
8864 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8866 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8867 PgradC(k,l,i) = PgradC(k,l,i)-aux
8868 PgradC(k,l,j) = PgradC(k,l,j)+aux
8872 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
8875 c write (2,*) "ijk",i,j,k
8876 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
8877 if (sss2.eq.0.0d0) cycle
8878 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
8879 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
8880 Pcalc(k) = Pcalc(k)+expCACA
8882 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8884 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
8885 & ssgrad2*expCACA/sss2
8888 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8889 PgradC(k,l,i) = PgradC(k,l,i)+aux
8890 PgradC(k,l,j) = PgradC(k,l,j)-aux
8899 if (nfgtasks.gt.1) then
8900 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
8901 & MPI_SUM,king,FG_COMM,IERR)
8902 if (fg_rank.eq.king) then
8904 Pcalc(k) = Pcalc_(k)
8907 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
8908 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8909 if (fg_rank.eq.king) then
8913 PgradC(k,l,i) = PgradC_(k,l,i)
8919 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
8920 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8921 if (fg_rank.eq.king) then
8925 PgradX(k,l,i) = PgradX_(k,l,i)
8934 if (fg_rank.eq.king) then
8938 Cnorm = Cnorm + Pcalc(k)
8940 Esaxs_constr = dlog(Cnorm)-wsaxs0
8942 if (Pcalc(k).gt.0.0d0)
8943 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
8945 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
8949 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
8959 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
8960 auxC1 = auxC1+PgradC(k,l,i)
8962 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
8963 auxX1 = auxX1+PgradX(k,l,i)
8966 gsaxsC(l,i) = auxC - auxC1/Cnorm
8968 gsaxsX(l,i) = auxX - auxX1/Cnorm
8970 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
8971 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
8979 c----------------------------------------------------------------------------
8980 subroutine e_saxsC(Esaxs_constr)
8982 include 'DIMENSIONS'
8983 include 'DIMENSIONS.ZSCOPT'
8984 include 'DIMENSIONS.FREE'
8987 include "COMMON.SETUP"
8990 include 'COMMON.SBRIDGE'
8991 include 'COMMON.CHAIN'
8992 include 'COMMON.GEO'
8993 include 'COMMON.LOCAL'
8994 include 'COMMON.INTERACT'
8995 include 'COMMON.VAR'
8996 include 'COMMON.IOUNITS'
8997 include 'COMMON.DERIV'
8998 include 'COMMON.CONTROL'
8999 include 'COMMON.NAMES'
9000 include 'COMMON.FFIELD'
9001 include 'COMMON.LANGEVIN'
9003 double precision Esaxs_constr
9004 integer i,iint,j,k,l
9005 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
9007 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9009 double precision dk,dijCASPH,dijSCSPH,
9010 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9011 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9013 c SAXS restraint penalty function
9015 write(iout,*) "------- SAXS penalty function start -------"
9016 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9017 & " isaxs_end",isaxs_end
9018 write (iout,*) "nnt",nnt," ntc",nct
9020 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9021 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9024 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9027 Esaxs_constr = 0.0d0
9029 do j=isaxs_start,isaxs_end
9041 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9043 if (itype(i).ne.10) then
9045 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9048 sigma2CA=2.0d0/pstok**2
9049 sigma2SC=4.0d0/restok(itype(i))**2
9050 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9051 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9052 Pcalc = Pcalc+expCASPH+expSCSPH
9054 write(*,*) "processor i j Pcalc",
9055 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
9057 CASPHgrad = sigma2CA*expCASPH
9058 SCSPHgrad = sigma2SC*expSCSPH
9060 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9061 PgradX(l,i) = PgradX(l,i) + aux
9062 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9067 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
9068 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
9071 logPtot = logPtot - dlog(Pcalc)
9072 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
9073 c & " logPtot",logPtot
9076 if (nfgtasks.gt.1) then
9077 c write (iout,*) "logPtot before reduction",logPtot
9078 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9079 & MPI_SUM,king,FG_COMM,IERR)
9081 c write (iout,*) "logPtot after reduction",logPtot
9082 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9083 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9084 if (fg_rank.eq.king) then
9087 gsaxsC(l,i) = gsaxsC_(l,i)
9091 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9092 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9093 if (fg_rank.eq.king) then
9096 gsaxsX(l,i) = gsaxsX_(l,i)
9102 Esaxs_constr = logPtot