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
3508 do k=1,constr_homology
3509 if(.not.l_homo(k,ii)) cycle
3510 distance(k)=odl(k,ii)-dij
3511 c write (iout,*) "distance(",k,") =",distance(k)
3513 c For Gaussian-type Urestr
3515 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3516 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3517 c write (iout,*) "distancek(",k,") =",distancek(k)
3518 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3520 c For Lorentzian-type Urestr
3522 if (waga_dist.lt.0.0d0) then
3523 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3524 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3525 & (distance(k)**2+sigma_odlir(k,ii)**2))
3529 c min_odl=minval(distancek)
3530 do kk=1,constr_homology
3531 if(l_homo(kk,ii)) then
3532 min_odl=distancek(kk)
3536 do kk=1,constr_homology
3537 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3538 & min_odl=distancek(kk)
3540 c write (iout,* )"min_odl",min_odl
3542 write (iout,*) "ij dij",i,j,dij
3543 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3544 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3545 write (iout,* )"min_odl",min_odl
3548 do k=1,constr_homology
3549 c Nie wiem po co to liczycie jeszcze raz!
3550 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3551 c & (2*(sigma_odl(i,j,k))**2))
3552 if(.not.l_homo(k,ii)) cycle
3553 if (waga_dist.ge.0.0d0) then
3555 c For Gaussian-type Urestr
3557 godl(k)=dexp(-distancek(k)+min_odl)
3558 odleg2=odleg2+godl(k)
3560 c For Lorentzian-type Urestr
3563 odleg2=odleg2+distancek(k)
3566 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3567 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3568 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3569 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3572 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3573 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3575 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3576 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3578 if (waga_dist.ge.0.0d0) then
3580 c For Gaussian-type Urestr
3582 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3584 c For Lorentzian-type Urestr
3587 odleg=odleg+odleg2/constr_homology
3591 c write (iout,*) "odleg",odleg ! sum of -ln-s
3594 c For Gaussian-type Urestr
3596 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3598 do k=1,constr_homology
3599 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3600 c & *waga_dist)+min_odl
3601 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3603 if(.not.l_homo(k,ii)) cycle
3604 if (waga_dist.ge.0.0d0) then
3605 c For Gaussian-type Urestr
3607 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3609 c For Lorentzian-type Urestr
3612 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3613 & sigma_odlir(k,ii)**2)**2)
3615 sum_sgodl=sum_sgodl+sgodl
3617 c sgodl2=sgodl2+sgodl
3618 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3619 c write(iout,*) "constr_homology=",constr_homology
3620 c write(iout,*) i, j, k, "TEST K"
3622 if (waga_dist.ge.0.0d0) then
3624 c For Gaussian-type Urestr
3626 grad_odl3=waga_homology(iset)*waga_dist
3627 & *sum_sgodl/(sum_godl*dij)
3629 c For Lorentzian-type Urestr
3632 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3633 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3634 grad_odl3=-waga_homology(iset)*waga_dist*
3635 & sum_sgodl/(constr_homology*dij)
3638 c grad_odl3=sum_sgodl/(sum_godl*dij)
3641 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3642 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3643 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3645 ccc write(iout,*) godl, sgodl, grad_odl3
3647 c grad_odl=grad_odl+grad_odl3
3650 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3651 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3652 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3653 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3654 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3655 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3656 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3657 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3658 c if (i.eq.25.and.j.eq.27) then
3659 c write(iout,*) "jik",jik,"i",i,"j",j
3660 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3661 c write(iout,*) "grad_odl3",grad_odl3
3662 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3663 c write(iout,*) "ggodl",ggodl
3664 c write(iout,*) "ghpbc(",jik,i,")",
3665 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3670 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3671 ccc & dLOG(odleg2),"-odleg=", -odleg
3673 enddo ! ii-loop for dist
3675 write(iout,*) "------- dist restrs end -------"
3676 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3677 c & waga_d.eq.1.0d0) call sum_gradient
3679 c Pseudo-energy and gradient from dihedral-angle restraints from
3680 c homology templates
3681 c write (iout,*) "End of distance loop"
3684 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3686 write(iout,*) "------- dih restrs start -------"
3687 do i=idihconstr_start_homo,idihconstr_end_homo
3688 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3691 do i=idihconstr_start_homo,idihconstr_end_homo
3693 c betai=beta(i,i+1,i+2,i+3)
3695 c write (iout,*) "betai =",betai
3696 do k=1,constr_homology
3697 dih_diff(k)=pinorm(dih(k,i)-betai)
3698 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3699 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3700 c & -(6.28318-dih_diff(i,k))
3701 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3702 c & 6.28318+dih_diff(i,k)
3704 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3705 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3708 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3711 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3712 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3714 write (iout,*) "i",i," betai",betai," kat2",kat2
3715 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3717 if (kat2.le.1.0d-14) cycle
3718 kat=kat-dLOG(kat2/constr_homology)
3719 c write (iout,*) "kat",kat ! sum of -ln-s
3721 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3722 ccc & dLOG(kat2), "-kat=", -kat
3725 c ----------------------------------------------------------------------
3727 c ----------------------------------------------------------------------
3731 do k=1,constr_homology
3732 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3733 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3734 sum_sgdih=sum_sgdih+sgdih
3736 c grad_dih3=sum_sgdih/sum_gdih
3737 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3739 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3740 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3741 ccc & gloc(nphi+i-3,icg)
3742 gloc(i,icg)=gloc(i,icg)+grad_dih3
3744 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3746 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3747 ccc & gloc(nphi+i-3,icg)
3749 enddo ! i-loop for dih
3751 write(iout,*) "------- dih restrs end -------"
3754 c Pseudo-energy and gradient for theta angle restraints from
3755 c homology templates
3756 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3760 c For constr_homology reference structures (FP)
3762 c Uconst_back_tot=0.0d0
3765 c Econstr_back legacy
3768 c do i=ithet_start,ithet_end
3771 c do i=loc_start,loc_end
3774 duscdiffx(j,i)=0.0d0
3780 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3781 c write (iout,*) "waga_theta",waga_theta
3782 if (waga_theta.gt.0.0d0) then
3784 write (iout,*) "usampl",usampl
3785 write(iout,*) "------- theta restrs start -------"
3786 c do i=ithet_start,ithet_end
3787 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3790 c write (iout,*) "maxres",maxres,"nres",nres
3792 do i=ithet_start,ithet_end
3795 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3797 c Deviation of theta angles wrt constr_homology ref structures
3799 utheta_i=0.0d0 ! argument of Gaussian for single k
3800 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3801 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3802 c over residues in a fragment
3803 c write (iout,*) "theta(",i,")=",theta(i)
3804 do k=1,constr_homology
3806 c dtheta_i=theta(j)-thetaref(j,iref)
3807 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3808 theta_diff(k)=thetatpl(k,i)-theta(i)
3810 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3811 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3812 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3813 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3814 c Gradient for single Gaussian restraint in subr Econstr_back
3815 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3818 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3819 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3823 c Gradient for multiple Gaussian restraint
3824 sum_gtheta=gutheta_i
3826 do k=1,constr_homology
3827 c New generalized expr for multiple Gaussian from Econstr_back
3828 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3830 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3831 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3834 c Final value of gradient using same var as in Econstr_back
3835 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3836 & *waga_homology(iset)
3837 c dutheta(i)=sum_sgtheta/sum_gtheta
3839 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3841 Eval=Eval-dLOG(gutheta_i/constr_homology)
3842 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3843 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3844 c Uconst_back=Uconst_back+utheta(i)
3845 enddo ! (i-loop for theta)
3847 write(iout,*) "------- theta restrs end -------"
3851 c Deviation of local SC geometry
3853 c Separation of two i-loops (instructed by AL - 11/3/2014)
3855 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3856 c write (iout,*) "waga_d",waga_d
3859 write(iout,*) "------- SC restrs start -------"
3860 write (iout,*) "Initial duscdiff,duscdiffx"
3861 do i=loc_start,loc_end
3862 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3863 & (duscdiffx(jik,i),jik=1,3)
3866 do i=loc_start,loc_end
3867 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3868 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3869 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3870 c write(iout,*) "xxtab, yytab, zztab"
3871 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3872 do k=1,constr_homology
3874 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3875 c Original sign inverted for calc of gradients (s. Econstr_back)
3876 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3877 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3878 c write(iout,*) "dxx, dyy, dzz"
3879 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3881 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3882 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3883 c uscdiffk(k)=usc_diff(i)
3884 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3885 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3886 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3887 c & xxref(j),yyref(j),zzref(j)
3892 c Generalized expression for multiple Gaussian acc to that for a single
3893 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3895 c Original implementation
3896 c sum_guscdiff=guscdiff(i)
3898 c sum_sguscdiff=0.0d0
3899 c do k=1,constr_homology
3900 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3901 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3902 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3905 c Implementation of new expressions for gradient (Jan. 2015)
3907 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3909 do k=1,constr_homology
3911 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3912 c before. Now the drivatives should be correct
3914 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3915 c Original sign inverted for calc of gradients (s. Econstr_back)
3916 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3917 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3919 c New implementation
3921 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3922 & sigma_d(k,i) ! for the grad wrt r'
3923 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3926 c New implementation
3927 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3929 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3930 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3931 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3932 duscdiff(jik,i)=duscdiff(jik,i)+
3933 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3934 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3935 duscdiffx(jik,i)=duscdiffx(jik,i)+
3936 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3937 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3940 write(iout,*) "jik",jik,"i",i
3941 write(iout,*) "dxx, dyy, dzz"
3942 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3943 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3944 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3945 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3946 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3947 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3948 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3949 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3950 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3951 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3952 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3953 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3954 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3955 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3956 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3963 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3964 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3966 c write (iout,*) i," uscdiff",uscdiff(i)
3968 c Put together deviations from local geometry
3970 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3971 c & wfrag_back(3,i,iset)*uscdiff(i)
3972 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3973 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3974 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3975 c Uconst_back=Uconst_back+usc_diff(i)
3977 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3979 c New implment: multiplied by sum_sguscdiff
3982 enddo ! (i-loop for dscdiff)
3987 write(iout,*) "------- SC restrs end -------"
3988 write (iout,*) "------ After SC loop in e_modeller ------"
3989 do i=loc_start,loc_end
3990 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3991 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3993 if (waga_theta.eq.1.0d0) then
3994 write (iout,*) "in e_modeller after SC restr end: dutheta"
3995 do i=ithet_start,ithet_end
3996 write (iout,*) i,dutheta(i)
3999 if (waga_d.eq.1.0d0) then
4000 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4002 write (iout,*) i,(duscdiff(j,i),j=1,3)
4003 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4008 c Total energy from homology restraints
4010 write (iout,*) "odleg",odleg," kat",kat
4011 write (iout,*) "odleg",odleg," kat",kat
4012 write (iout,*) "Eval",Eval," Erot",Erot
4013 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4014 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4015 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4018 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4020 c ehomology_constr=odleg+kat
4022 c For Lorentzian-type Urestr
4025 if (waga_dist.ge.0.0d0) then
4027 c For Gaussian-type Urestr
4029 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4030 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4031 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4032 & waga_theta*Eval+waga_d*Erot
4033 c write (iout,*) "ehomology_constr=",ehomology_constr
4036 c For Lorentzian-type Urestr
4038 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4039 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4040 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4041 & waga_theta*Eval+waga_d*Erot
4042 c write (iout,*) "ehomology_constr=",ehomology_constr
4045 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4046 & "Eval",waga_theta,eval,
4047 & "Erot",waga_d,Erot
4048 write (iout,*) "ehomology_constr",ehomology_constr
4052 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4053 747 format(a12,i4,i4,i4,f8.3,f8.3)
4054 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4055 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4056 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4057 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4059 c-----------------------------------------------------------------------
4060 subroutine ebond(estr)
4062 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4064 implicit real*8 (a-h,o-z)
4065 include 'DIMENSIONS'
4066 include 'DIMENSIONS.ZSCOPT'
4067 include 'DIMENSIONS.FREE'
4068 include 'COMMON.LOCAL'
4069 include 'COMMON.GEO'
4070 include 'COMMON.INTERACT'
4071 include 'COMMON.DERIV'
4072 include 'COMMON.VAR'
4073 include 'COMMON.CHAIN'
4074 include 'COMMON.IOUNITS'
4075 include 'COMMON.NAMES'
4076 include 'COMMON.FFIELD'
4077 include 'COMMON.CONTROL'
4078 logical energy_dec /.false./
4079 double precision u(3),ud(3)
4081 C write (iout,*) "distchainmax",distchainmax
4083 c write (iout,*) "distchainmax",distchainmax
4085 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4086 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4088 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4089 C & *dc(j,i-1)/vbld(i)
4091 C if (energy_dec) write(iout,*)
4092 C & "estr1",i,vbld(i),distchainmax,
4093 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4095 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4096 diff = vbld(i)-vbldpDUM
4097 C write(iout,*) i,diff
4099 diff = vbld(i)-vbldp0
4100 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4104 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4107 C write (iout,'(a7,i5,4f7.3)')
4108 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4110 estr=0.5d0*AKP*estr+estr1
4112 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4116 if (iti.ne.10 .and. iti.ne.ntyp1) then
4119 diff=vbld(i+nres)-vbldsc0(1,iti)
4120 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4121 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4122 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4124 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4128 diff=vbld(i+nres)-vbldsc0(j,iti)
4129 ud(j)=aksc(j,iti)*diff
4130 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4144 uprod2=uprod2*u(k)*u(k)
4148 usumsqder=usumsqder+ud(j)*uprod2
4150 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4151 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4152 estr=estr+uprod/usum
4154 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4162 C--------------------------------------------------------------------------
4163 subroutine ebend(etheta)
4165 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4166 C angles gamma and its derivatives in consecutive thetas and gammas.
4168 implicit real*8 (a-h,o-z)
4169 include 'DIMENSIONS'
4170 include 'DIMENSIONS.ZSCOPT'
4171 include 'COMMON.LOCAL'
4172 include 'COMMON.GEO'
4173 include 'COMMON.INTERACT'
4174 include 'COMMON.DERIV'
4175 include 'COMMON.VAR'
4176 include 'COMMON.CHAIN'
4177 include 'COMMON.IOUNITS'
4178 include 'COMMON.NAMES'
4179 include 'COMMON.FFIELD'
4180 common /calcthet/ term1,term2,termm,diffak,ratak,
4181 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4182 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4183 double precision y(2),z(2)
4185 time11=dexp(-2*time)
4188 c write (iout,*) "nres",nres
4189 c write (*,'(a,i2)') 'EBEND ICG=',icg
4190 c write (iout,*) ithet_start,ithet_end
4191 do i=ithet_start,ithet_end
4192 C if (itype(i-1).eq.ntyp1) cycle
4194 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4195 & .or.itype(i).eq.ntyp1) cycle
4196 C Zero the energy function and its derivative at 0 or pi.
4197 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4199 ichir1=isign(1,itype(i-2))
4200 ichir2=isign(1,itype(i))
4201 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4202 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4203 if (itype(i-1).eq.10) then
4204 itype1=isign(10,itype(i-2))
4205 ichir11=isign(1,itype(i-2))
4206 ichir12=isign(1,itype(i-2))
4207 itype2=isign(10,itype(i))
4208 ichir21=isign(1,itype(i))
4209 ichir22=isign(1,itype(i))
4216 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4220 c call proc_proc(phii,icrc)
4221 if (icrc.eq.1) phii=150.0
4232 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4236 c call proc_proc(phii1,icrc)
4237 if (icrc.eq.1) phii1=150.0
4249 C Calculate the "mean" value of theta from the part of the distribution
4250 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4251 C In following comments this theta will be referred to as t_c.
4252 thet_pred_mean=0.0d0
4254 athetk=athet(k,it,ichir1,ichir2)
4255 bthetk=bthet(k,it,ichir1,ichir2)
4257 athetk=athet(k,itype1,ichir11,ichir12)
4258 bthetk=bthet(k,itype2,ichir21,ichir22)
4260 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4262 c write (iout,*) "thet_pred_mean",thet_pred_mean
4263 dthett=thet_pred_mean*ssd
4264 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4265 c write (iout,*) "thet_pred_mean",thet_pred_mean
4266 C Derivatives of the "mean" values in gamma1 and gamma2.
4267 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4268 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4269 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4270 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4272 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4273 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4274 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4275 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4277 if (theta(i).gt.pi-delta) then
4278 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4280 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4281 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4282 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4284 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4286 else if (theta(i).lt.delta) then
4287 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4288 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4289 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4291 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4292 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4295 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4298 etheta=etheta+ethetai
4299 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4300 c & 'ebend',i,ethetai,theta(i),itype(i)
4301 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4302 c & rad2deg*phii,rad2deg*phii1,ethetai
4303 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4304 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4305 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4309 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4310 do i=1,ntheta_constr
4311 itheta=itheta_constr(i)
4312 thetiii=theta(itheta)
4313 difi=pinorm(thetiii-theta_constr0(i))
4314 if (difi.gt.theta_drange(i)) then
4315 difi=difi-theta_drange(i)
4316 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4317 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4318 & +for_thet_constr(i)*difi**3
4319 else if (difi.lt.-drange(i)) then
4321 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4322 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4323 & +for_thet_constr(i)*difi**3
4327 C if (energy_dec) then
4328 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4329 C & i,itheta,rad2deg*thetiii,
4330 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4331 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4332 C & gloc(itheta+nphi-2,icg)
4335 C Ufff.... We've done all this!!!
4338 C---------------------------------------------------------------------------
4339 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4341 implicit real*8 (a-h,o-z)
4342 include 'DIMENSIONS'
4343 include 'COMMON.LOCAL'
4344 include 'COMMON.IOUNITS'
4345 common /calcthet/ term1,term2,termm,diffak,ratak,
4346 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4347 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4348 C Calculate the contributions to both Gaussian lobes.
4349 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4350 C The "polynomial part" of the "standard deviation" of this part of
4354 sig=sig*thet_pred_mean+polthet(j,it)
4356 C Derivative of the "interior part" of the "standard deviation of the"
4357 C gamma-dependent Gaussian lobe in t_c.
4358 sigtc=3*polthet(3,it)
4360 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4363 C Set the parameters of both Gaussian lobes of the distribution.
4364 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4365 fac=sig*sig+sigc0(it)
4368 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4369 sigsqtc=-4.0D0*sigcsq*sigtc
4370 c print *,i,sig,sigtc,sigsqtc
4371 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4372 sigtc=-sigtc/(fac*fac)
4373 C Following variable is sigma(t_c)**(-2)
4374 sigcsq=sigcsq*sigcsq
4376 sig0inv=1.0D0/sig0i**2
4377 delthec=thetai-thet_pred_mean
4378 delthe0=thetai-theta0i
4379 term1=-0.5D0*sigcsq*delthec*delthec
4380 term2=-0.5D0*sig0inv*delthe0*delthe0
4381 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4382 C NaNs in taking the logarithm. We extract the largest exponent which is added
4383 C to the energy (this being the log of the distribution) at the end of energy
4384 C term evaluation for this virtual-bond angle.
4385 if (term1.gt.term2) then
4387 term2=dexp(term2-termm)
4391 term1=dexp(term1-termm)
4394 C The ratio between the gamma-independent and gamma-dependent lobes of
4395 C the distribution is a Gaussian function of thet_pred_mean too.
4396 diffak=gthet(2,it)-thet_pred_mean
4397 ratak=diffak/gthet(3,it)**2
4398 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4399 C Let's differentiate it in thet_pred_mean NOW.
4401 C Now put together the distribution terms to make complete distribution.
4402 termexp=term1+ak*term2
4403 termpre=sigc+ak*sig0i
4404 C Contribution of the bending energy from this theta is just the -log of
4405 C the sum of the contributions from the two lobes and the pre-exponential
4406 C factor. Simple enough, isn't it?
4407 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4408 C NOW the derivatives!!!
4409 C 6/6/97 Take into account the deformation.
4410 E_theta=(delthec*sigcsq*term1
4411 & +ak*delthe0*sig0inv*term2)/termexp
4412 E_tc=((sigtc+aktc*sig0i)/termpre
4413 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4414 & aktc*term2)/termexp)
4417 c-----------------------------------------------------------------------------
4418 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4419 implicit real*8 (a-h,o-z)
4420 include 'DIMENSIONS'
4421 include 'COMMON.LOCAL'
4422 include 'COMMON.IOUNITS'
4423 common /calcthet/ term1,term2,termm,diffak,ratak,
4424 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4425 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4426 delthec=thetai-thet_pred_mean
4427 delthe0=thetai-theta0i
4428 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4429 t3 = thetai-thet_pred_mean
4433 t14 = t12+t6*sigsqtc
4435 t21 = thetai-theta0i
4441 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4442 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4443 & *(-t12*t9-ak*sig0inv*t27)
4447 C--------------------------------------------------------------------------
4448 subroutine ebend(etheta)
4450 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4451 C angles gamma and its derivatives in consecutive thetas and gammas.
4452 C ab initio-derived potentials from
4453 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4455 implicit real*8 (a-h,o-z)
4456 include 'DIMENSIONS'
4457 include 'DIMENSIONS.ZSCOPT'
4458 include 'DIMENSIONS.FREE'
4459 include 'COMMON.LOCAL'
4460 include 'COMMON.GEO'
4461 include 'COMMON.INTERACT'
4462 include 'COMMON.DERIV'
4463 include 'COMMON.VAR'
4464 include 'COMMON.CHAIN'
4465 include 'COMMON.IOUNITS'
4466 include 'COMMON.NAMES'
4467 include 'COMMON.FFIELD'
4468 include 'COMMON.CONTROL'
4469 include 'COMMON.TORCNSTR'
4470 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4471 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4472 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4473 & sinph1ph2(maxdouble,maxdouble)
4474 logical lprn /.false./, lprn1 /.false./
4476 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4477 do i=ithet_start,ithet_end
4479 c print *,i,itype(i-1),itype(i),itype(i-2)
4480 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4481 & .or.(itype(i).eq.ntyp1)) cycle
4482 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4484 if (iabs(itype(i+1)).eq.20) iblock=2
4485 if (iabs(itype(i+1)).ne.20) iblock=1
4489 theti2=0.5d0*theta(i)
4490 ityp2=ithetyp((itype(i-1)))
4492 coskt(k)=dcos(k*theti2)
4493 sinkt(k)=dsin(k*theti2)
4495 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4498 if (phii.ne.phii) phii=150.0
4502 ityp1=ithetyp((itype(i-2)))
4504 cosph1(k)=dcos(k*phii)
4505 sinph1(k)=dsin(k*phii)
4509 ityp1=ithetyp(itype(i-2))
4515 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4518 if (phii1.ne.phii1) phii1=150.0
4523 ityp3=ithetyp((itype(i)))
4525 cosph2(k)=dcos(k*phii1)
4526 sinph2(k)=dsin(k*phii1)
4530 ityp3=ithetyp(itype(i))
4536 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4537 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4539 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4542 ccl=cosph1(l)*cosph2(k-l)
4543 ssl=sinph1(l)*sinph2(k-l)
4544 scl=sinph1(l)*cosph2(k-l)
4545 csl=cosph1(l)*sinph2(k-l)
4546 cosph1ph2(l,k)=ccl-ssl
4547 cosph1ph2(k,l)=ccl+ssl
4548 sinph1ph2(l,k)=scl+csl
4549 sinph1ph2(k,l)=scl-csl
4553 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4554 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4555 write (iout,*) "coskt and sinkt"
4557 write (iout,*) k,coskt(k),sinkt(k)
4561 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4562 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4565 & write (iout,*) "k",k,"
4566 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4567 & " ethetai",ethetai
4570 write (iout,*) "cosph and sinph"
4572 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4574 write (iout,*) "cosph1ph2 and sinph2ph2"
4577 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4578 & sinph1ph2(l,k),sinph1ph2(k,l)
4581 write(iout,*) "ethetai",ethetai
4585 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4586 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4587 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4588 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4589 ethetai=ethetai+sinkt(m)*aux
4590 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4591 dephii=dephii+k*sinkt(m)*(
4592 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4593 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4594 dephii1=dephii1+k*sinkt(m)*(
4595 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4596 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4598 & write (iout,*) "m",m," k",k," bbthet",
4599 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4600 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4601 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4602 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4606 & write(iout,*) "ethetai",ethetai
4610 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4611 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4612 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4613 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4614 ethetai=ethetai+sinkt(m)*aux
4615 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4616 dephii=dephii+l*sinkt(m)*(
4617 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4618 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4619 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4620 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4621 dephii1=dephii1+(k-l)*sinkt(m)*(
4622 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4623 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4624 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4625 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4627 write (iout,*) "m",m," k",k," l",l," ffthet",
4628 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4629 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4630 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4631 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4632 & " ethetai",ethetai
4633 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4634 & cosph1ph2(k,l)*sinkt(m),
4635 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4641 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4642 & i,theta(i)*rad2deg,phii*rad2deg,
4643 & phii1*rad2deg,ethetai
4644 etheta=etheta+ethetai
4645 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4646 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4647 c gloc(nphi+i-2,icg)=wang*dethetai
4648 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4652 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4653 do i=1,ntheta_constr
4654 itheta=itheta_constr(i)
4655 thetiii=theta(itheta)
4656 difi=pinorm(thetiii-theta_constr0(i))
4657 if (difi.gt.theta_drange(i)) then
4658 difi=difi-theta_drange(i)
4659 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4660 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4661 & +for_thet_constr(i)*difi**3
4662 else if (difi.lt.-drange(i)) then
4664 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4665 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4666 & +for_thet_constr(i)*difi**3
4670 C if (energy_dec) then
4671 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4672 C & i,itheta,rad2deg*thetiii,
4673 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4674 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4675 C & gloc(itheta+nphi-2,icg)
4683 c-----------------------------------------------------------------------------
4684 subroutine esc(escloc)
4685 C Calculate the local energy of a side chain and its derivatives in the
4686 C corresponding virtual-bond valence angles THETA and the spherical angles
4688 implicit real*8 (a-h,o-z)
4689 include 'DIMENSIONS'
4690 include 'DIMENSIONS.ZSCOPT'
4691 include 'COMMON.GEO'
4692 include 'COMMON.LOCAL'
4693 include 'COMMON.VAR'
4694 include 'COMMON.INTERACT'
4695 include 'COMMON.DERIV'
4696 include 'COMMON.CHAIN'
4697 include 'COMMON.IOUNITS'
4698 include 'COMMON.NAMES'
4699 include 'COMMON.FFIELD'
4700 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4701 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4702 common /sccalc/ time11,time12,time112,theti,it,nlobit
4705 C write (iout,*) 'ESC'
4706 do i=loc_start,loc_end
4708 if (it.eq.ntyp1) cycle
4709 if (it.eq.10) goto 1
4710 nlobit=nlob(iabs(it))
4711 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4712 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4713 theti=theta(i+1)-pipol
4717 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4719 if (x(2).gt.pi-delta) then
4723 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4725 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4726 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4728 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4729 & ddersc0(1),dersc(1))
4730 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4731 & ddersc0(3),dersc(3))
4733 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4735 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4736 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4737 & dersc0(2),esclocbi,dersc02)
4738 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4740 call splinthet(x(2),0.5d0*delta,ss,ssd)
4745 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4747 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4748 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4750 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4752 c write (iout,*) escloci
4753 else if (x(2).lt.delta) then
4757 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4759 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4760 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4762 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4763 & ddersc0(1),dersc(1))
4764 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4765 & ddersc0(3),dersc(3))
4767 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4769 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4770 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4771 & dersc0(2),esclocbi,dersc02)
4772 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4777 call splinthet(x(2),0.5d0*delta,ss,ssd)
4779 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4781 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4782 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4784 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4785 C write (iout,*) 'i=',i, escloci
4787 call enesc(x,escloci,dersc,ddummy,.false.)
4790 escloc=escloc+escloci
4791 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4792 write (iout,'(a6,i5,0pf7.3)')
4793 & 'escloc',i,escloci
4795 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4797 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4798 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4803 C---------------------------------------------------------------------------
4804 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4805 implicit real*8 (a-h,o-z)
4806 include 'DIMENSIONS'
4807 include 'COMMON.GEO'
4808 include 'COMMON.LOCAL'
4809 include 'COMMON.IOUNITS'
4810 common /sccalc/ time11,time12,time112,theti,it,nlobit
4811 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4812 double precision contr(maxlob,-1:1)
4814 c write (iout,*) 'it=',it,' nlobit=',nlobit
4818 if (mixed) ddersc(j)=0.0d0
4822 C Because of periodicity of the dependence of the SC energy in omega we have
4823 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4824 C To avoid underflows, first compute & store the exponents.
4832 z(k)=x(k)-censc(k,j,it)
4837 Axk=Axk+gaussc(l,k,j,it)*z(l)
4843 expfac=expfac+Ax(k,j,iii)*z(k)
4851 C As in the case of ebend, we want to avoid underflows in exponentiation and
4852 C subsequent NaNs and INFs in energy calculation.
4853 C Find the largest exponent
4857 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4861 cd print *,'it=',it,' emin=',emin
4863 C Compute the contribution to SC energy and derivatives
4867 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4868 cd print *,'j=',j,' expfac=',expfac
4869 escloc_i=escloc_i+expfac
4871 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4875 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4876 & +gaussc(k,2,j,it))*expfac
4883 dersc(1)=dersc(1)/cos(theti)**2
4884 ddersc(1)=ddersc(1)/cos(theti)**2
4887 escloci=-(dlog(escloc_i)-emin)
4889 dersc(j)=dersc(j)/escloc_i
4893 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4898 C------------------------------------------------------------------------------
4899 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4900 implicit real*8 (a-h,o-z)
4901 include 'DIMENSIONS'
4902 include 'COMMON.GEO'
4903 include 'COMMON.LOCAL'
4904 include 'COMMON.IOUNITS'
4905 common /sccalc/ time11,time12,time112,theti,it,nlobit
4906 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4907 double precision contr(maxlob)
4918 z(k)=x(k)-censc(k,j,it)
4924 Axk=Axk+gaussc(l,k,j,it)*z(l)
4930 expfac=expfac+Ax(k,j)*z(k)
4935 C As in the case of ebend, we want to avoid underflows in exponentiation and
4936 C subsequent NaNs and INFs in energy calculation.
4937 C Find the largest exponent
4940 if (emin.gt.contr(j)) emin=contr(j)
4944 C Compute the contribution to SC energy and derivatives
4948 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4949 escloc_i=escloc_i+expfac
4951 dersc(k)=dersc(k)+Ax(k,j)*expfac
4953 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4954 & +gaussc(1,2,j,it))*expfac
4958 dersc(1)=dersc(1)/cos(theti)**2
4959 dersc12=dersc12/cos(theti)**2
4960 escloci=-(dlog(escloc_i)-emin)
4962 dersc(j)=dersc(j)/escloc_i
4964 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4968 c----------------------------------------------------------------------------------
4969 subroutine esc(escloc)
4970 C Calculate the local energy of a side chain and its derivatives in the
4971 C corresponding virtual-bond valence angles THETA and the spherical angles
4972 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4973 C added by Urszula Kozlowska. 07/11/2007
4975 implicit real*8 (a-h,o-z)
4976 include 'DIMENSIONS'
4977 include 'DIMENSIONS.ZSCOPT'
4978 include 'DIMENSIONS.FREE'
4979 include 'COMMON.GEO'
4980 include 'COMMON.LOCAL'
4981 include 'COMMON.VAR'
4982 include 'COMMON.SCROT'
4983 include 'COMMON.INTERACT'
4984 include 'COMMON.DERIV'
4985 include 'COMMON.CHAIN'
4986 include 'COMMON.IOUNITS'
4987 include 'COMMON.NAMES'
4988 include 'COMMON.FFIELD'
4989 include 'COMMON.CONTROL'
4990 include 'COMMON.VECTORS'
4991 double precision x_prime(3),y_prime(3),z_prime(3)
4992 & , sumene,dsc_i,dp2_i,x(65),
4993 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4994 & de_dxx,de_dyy,de_dzz,de_dt
4995 double precision s1_t,s1_6_t,s2_t,s2_6_t
4997 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4998 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4999 & dt_dCi(3),dt_dCi1(3)
5000 common /sccalc/ time11,time12,time112,theti,it,nlobit
5003 do i=loc_start,loc_end
5004 if (itype(i).eq.ntyp1) cycle
5005 costtab(i+1) =dcos(theta(i+1))
5006 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5007 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5008 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5009 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5010 cosfac=dsqrt(cosfac2)
5011 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5012 sinfac=dsqrt(sinfac2)
5014 if (it.eq.10) goto 1
5016 C Compute the axes of tghe local cartesian coordinates system; store in
5017 c x_prime, y_prime and z_prime
5024 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5025 C & dc_norm(3,i+nres)
5027 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5028 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5031 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5034 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5035 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5036 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5037 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5038 c & " xy",scalar(x_prime(1),y_prime(1)),
5039 c & " xz",scalar(x_prime(1),z_prime(1)),
5040 c & " yy",scalar(y_prime(1),y_prime(1)),
5041 c & " yz",scalar(y_prime(1),z_prime(1)),
5042 c & " zz",scalar(z_prime(1),z_prime(1))
5044 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5045 C to local coordinate system. Store in xx, yy, zz.
5051 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5052 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5053 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5060 C Compute the energy of the ith side cbain
5062 c write (2,*) "xx",xx," yy",yy," zz",zz
5065 x(j) = sc_parmin(j,it)
5068 Cc diagnostics - remove later
5070 yy1 = dsin(alph(2))*dcos(omeg(2))
5071 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5072 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5073 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5075 C," --- ", xx_w,yy_w,zz_w
5078 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5079 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5081 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5082 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5084 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5085 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5086 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5087 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5088 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5090 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5091 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5092 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5093 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5094 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5096 dsc_i = 0.743d0+x(61)
5098 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5099 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5100 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5101 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5102 s1=(1+x(63))/(0.1d0 + dscp1)
5103 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5104 s2=(1+x(65))/(0.1d0 + dscp2)
5105 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5106 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5107 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5108 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5110 c & dscp1,dscp2,sumene
5111 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5112 escloc = escloc + sumene
5113 c write (2,*) "escloc",escloc
5114 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5116 if (.not. calc_grad) goto 1
5119 C This section to check the numerical derivatives of the energy of ith side
5120 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5121 C #define DEBUG in the code to turn it on.
5123 write (2,*) "sumene =",sumene
5127 write (2,*) xx,yy,zz
5128 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5129 de_dxx_num=(sumenep-sumene)/aincr
5131 write (2,*) "xx+ sumene from enesc=",sumenep
5134 write (2,*) xx,yy,zz
5135 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5136 de_dyy_num=(sumenep-sumene)/aincr
5138 write (2,*) "yy+ sumene from enesc=",sumenep
5141 write (2,*) xx,yy,zz
5142 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5143 de_dzz_num=(sumenep-sumene)/aincr
5145 write (2,*) "zz+ sumene from enesc=",sumenep
5146 costsave=cost2tab(i+1)
5147 sintsave=sint2tab(i+1)
5148 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5149 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5150 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5151 de_dt_num=(sumenep-sumene)/aincr
5152 write (2,*) " t+ sumene from enesc=",sumenep
5153 cost2tab(i+1)=costsave
5154 sint2tab(i+1)=sintsave
5155 C End of diagnostics section.
5158 C Compute the gradient of esc
5160 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5161 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5162 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5163 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5164 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5165 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5166 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5167 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5168 pom1=(sumene3*sint2tab(i+1)+sumene1)
5169 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5170 pom2=(sumene4*cost2tab(i+1)+sumene2)
5171 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5172 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5173 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5174 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5176 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5177 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5178 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5180 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5181 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5182 & +(pom1+pom2)*pom_dx
5184 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5187 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5188 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5189 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5191 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5192 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5193 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5194 & +x(59)*zz**2 +x(60)*xx*zz
5195 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5196 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5197 & +(pom1-pom2)*pom_dy
5199 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5202 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5203 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5204 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5205 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5206 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5207 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5208 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5209 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5211 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5214 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5215 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5216 & +pom1*pom_dt1+pom2*pom_dt2
5218 write(2,*), "de_dt = ", de_dt,de_dt_num
5222 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5223 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5224 cosfac2xx=cosfac2*xx
5225 sinfac2yy=sinfac2*yy
5227 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5229 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5231 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5232 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5233 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5234 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5235 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5236 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5237 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5238 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5239 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5240 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5244 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5245 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5246 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5247 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5250 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5251 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5252 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5254 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5255 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5259 dXX_Ctab(k,i)=dXX_Ci(k)
5260 dXX_C1tab(k,i)=dXX_Ci1(k)
5261 dYY_Ctab(k,i)=dYY_Ci(k)
5262 dYY_C1tab(k,i)=dYY_Ci1(k)
5263 dZZ_Ctab(k,i)=dZZ_Ci(k)
5264 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5265 dXX_XYZtab(k,i)=dXX_XYZ(k)
5266 dYY_XYZtab(k,i)=dYY_XYZ(k)
5267 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5271 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5272 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5273 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5274 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5275 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5277 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5278 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5279 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5280 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5281 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5282 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5283 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5284 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5286 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5287 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5289 C to check gradient call subroutine check_grad
5296 c------------------------------------------------------------------------------
5297 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5299 C This procedure calculates two-body contact function g(rij) and its derivative:
5302 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5305 C where x=(rij-r0ij)/delta
5307 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5310 double precision rij,r0ij,eps0ij,fcont,fprimcont
5311 double precision x,x2,x4,delta
5315 if (x.lt.-1.0D0) then
5318 else if (x.le.1.0D0) then
5321 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5322 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5329 c------------------------------------------------------------------------------
5330 subroutine splinthet(theti,delta,ss,ssder)
5331 implicit real*8 (a-h,o-z)
5332 include 'DIMENSIONS'
5333 include 'DIMENSIONS.ZSCOPT'
5334 include 'COMMON.VAR'
5335 include 'COMMON.GEO'
5338 if (theti.gt.pipol) then
5339 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5341 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5346 c------------------------------------------------------------------------------
5347 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5349 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5350 double precision ksi,ksi2,ksi3,a1,a2,a3
5351 a1=fprim0*delta/(f1-f0)
5357 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5358 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5361 c------------------------------------------------------------------------------
5362 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5364 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5365 double precision ksi,ksi2,ksi3,a1,a2,a3
5370 a2=3*(f1x-f0x)-2*fprim0x*delta
5371 a3=fprim0x*delta-2*(f1x-f0x)
5372 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5375 C-----------------------------------------------------------------------------
5377 C-----------------------------------------------------------------------------
5378 subroutine etor(etors,edihcnstr,fact)
5379 implicit real*8 (a-h,o-z)
5380 include 'DIMENSIONS'
5381 include 'DIMENSIONS.ZSCOPT'
5382 include 'COMMON.VAR'
5383 include 'COMMON.GEO'
5384 include 'COMMON.LOCAL'
5385 include 'COMMON.TORSION'
5386 include 'COMMON.INTERACT'
5387 include 'COMMON.DERIV'
5388 include 'COMMON.CHAIN'
5389 include 'COMMON.NAMES'
5390 include 'COMMON.IOUNITS'
5391 include 'COMMON.FFIELD'
5392 include 'COMMON.TORCNSTR'
5394 C Set lprn=.true. for debugging
5398 do i=iphi_start,iphi_end
5399 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5400 & .or. itype(i).eq.ntyp1) cycle
5401 itori=itortyp(itype(i-2))
5402 itori1=itortyp(itype(i-1))
5405 C Proline-Proline pair is a special case...
5406 if (itori.eq.3 .and. itori1.eq.3) then
5407 if (phii.gt.-dwapi3) then
5409 fac=1.0D0/(1.0D0-cosphi)
5410 etorsi=v1(1,3,3)*fac
5411 etorsi=etorsi+etorsi
5412 etors=etors+etorsi-v1(1,3,3)
5413 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5416 v1ij=v1(j+1,itori,itori1)
5417 v2ij=v2(j+1,itori,itori1)
5420 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5421 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5425 v1ij=v1(j,itori,itori1)
5426 v2ij=v2(j,itori,itori1)
5429 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5430 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5434 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5435 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5436 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5437 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5438 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5440 ! 6/20/98 - dihedral angle constraints
5443 itori=idih_constr(i)
5446 if (difi.gt.drange(i)) then
5448 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5449 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5450 else if (difi.lt.-drange(i)) then
5452 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5453 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5455 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5456 C & i,itori,rad2deg*phii,
5457 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5459 ! write (iout,*) 'edihcnstr',edihcnstr
5462 c------------------------------------------------------------------------------
5464 subroutine etor(etors,edihcnstr,fact)
5465 implicit real*8 (a-h,o-z)
5466 include 'DIMENSIONS'
5467 include 'DIMENSIONS.ZSCOPT'
5468 include 'COMMON.VAR'
5469 include 'COMMON.GEO'
5470 include 'COMMON.LOCAL'
5471 include 'COMMON.TORSION'
5472 include 'COMMON.INTERACT'
5473 include 'COMMON.DERIV'
5474 include 'COMMON.CHAIN'
5475 include 'COMMON.NAMES'
5476 include 'COMMON.IOUNITS'
5477 include 'COMMON.FFIELD'
5478 include 'COMMON.TORCNSTR'
5480 C Set lprn=.true. for debugging
5484 do i=iphi_start,iphi_end
5486 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5487 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5488 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5489 C & .or. itype(i).eq.ntyp1) cycle
5490 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5491 if (iabs(itype(i)).eq.20) then
5496 itori=itortyp(itype(i-2))
5497 itori1=itortyp(itype(i-1))
5500 C Regular cosine and sine terms
5501 do j=1,nterm(itori,itori1,iblock)
5502 v1ij=v1(j,itori,itori1,iblock)
5503 v2ij=v2(j,itori,itori1,iblock)
5506 etors=etors+v1ij*cosphi+v2ij*sinphi
5507 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5511 C E = SUM ----------------------------------- - v1
5512 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5514 cosphi=dcos(0.5d0*phii)
5515 sinphi=dsin(0.5d0*phii)
5516 do j=1,nlor(itori,itori1,iblock)
5517 vl1ij=vlor1(j,itori,itori1)
5518 vl2ij=vlor2(j,itori,itori1)
5519 vl3ij=vlor3(j,itori,itori1)
5520 pom=vl2ij*cosphi+vl3ij*sinphi
5521 pom1=1.0d0/(pom*pom+1.0d0)
5522 etors=etors+vl1ij*pom1
5523 c if (energy_dec) etors_ii=etors_ii+
5526 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5528 C Subtract the constant term
5529 etors=etors-v0(itori,itori1,iblock)
5531 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5532 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5533 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5534 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5535 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5538 ! 6/20/98 - dihedral angle constraints
5541 itori=idih_constr(i)
5543 difi=pinorm(phii-phi0(i))
5545 if (difi.gt.drange(i)) then
5547 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5548 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5549 edihi=0.25d0*ftors(i)*difi**4
5550 else if (difi.lt.-drange(i)) then
5552 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5553 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5554 edihi=0.25d0*ftors(i)*difi**4
5558 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5559 & i,itori,rad2deg*phii,
5560 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5561 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5563 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5564 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5566 ! write (iout,*) 'edihcnstr',edihcnstr
5569 c----------------------------------------------------------------------------
5570 subroutine etor_d(etors_d,fact2)
5571 C 6/23/01 Compute double torsional energy
5572 implicit real*8 (a-h,o-z)
5573 include 'DIMENSIONS'
5574 include 'DIMENSIONS.ZSCOPT'
5575 include 'COMMON.VAR'
5576 include 'COMMON.GEO'
5577 include 'COMMON.LOCAL'
5578 include 'COMMON.TORSION'
5579 include 'COMMON.INTERACT'
5580 include 'COMMON.DERIV'
5581 include 'COMMON.CHAIN'
5582 include 'COMMON.NAMES'
5583 include 'COMMON.IOUNITS'
5584 include 'COMMON.FFIELD'
5585 include 'COMMON.TORCNSTR'
5587 C Set lprn=.true. for debugging
5591 do i=iphi_start,iphi_end-1
5593 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5594 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5595 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5596 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5597 & (itype(i+1).eq.ntyp1)) cycle
5598 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5600 itori=itortyp(itype(i-2))
5601 itori1=itortyp(itype(i-1))
5602 itori2=itortyp(itype(i))
5608 if (iabs(itype(i+1)).eq.20) iblock=2
5609 C Regular cosine and sine terms
5610 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5611 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5612 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5613 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5614 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5615 cosphi1=dcos(j*phii)
5616 sinphi1=dsin(j*phii)
5617 cosphi2=dcos(j*phii1)
5618 sinphi2=dsin(j*phii1)
5619 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5620 & v2cij*cosphi2+v2sij*sinphi2
5621 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5622 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5624 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5626 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5627 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5628 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5629 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5630 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5631 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5632 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5633 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5634 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5635 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5636 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5637 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5638 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5639 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5642 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5643 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5649 c------------------------------------------------------------------------------
5650 subroutine eback_sc_corr(esccor)
5651 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5652 c conformational states; temporarily implemented as differences
5653 c between UNRES torsional potentials (dependent on three types of
5654 c residues) and the torsional potentials dependent on all 20 types
5655 c of residues computed from AM1 energy surfaces of terminally-blocked
5656 c amino-acid residues.
5657 implicit real*8 (a-h,o-z)
5658 include 'DIMENSIONS'
5659 include 'DIMENSIONS.ZSCOPT'
5660 include 'DIMENSIONS.FREE'
5661 include 'COMMON.VAR'
5662 include 'COMMON.GEO'
5663 include 'COMMON.LOCAL'
5664 include 'COMMON.TORSION'
5665 include 'COMMON.SCCOR'
5666 include 'COMMON.INTERACT'
5667 include 'COMMON.DERIV'
5668 include 'COMMON.CHAIN'
5669 include 'COMMON.NAMES'
5670 include 'COMMON.IOUNITS'
5671 include 'COMMON.FFIELD'
5672 include 'COMMON.CONTROL'
5674 C Set lprn=.true. for debugging
5677 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5679 do i=itau_start,itau_end
5680 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5682 isccori=isccortyp(itype(i-2))
5683 isccori1=isccortyp(itype(i-1))
5685 do intertyp=1,3 !intertyp
5686 cc Added 09 May 2012 (Adasko)
5687 cc Intertyp means interaction type of backbone mainchain correlation:
5688 c 1 = SC...Ca...Ca...Ca
5689 c 2 = Ca...Ca...Ca...SC
5690 c 3 = SC...Ca...Ca...SCi
5692 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5693 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5694 & (itype(i-1).eq.ntyp1)))
5695 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5696 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5697 & .or.(itype(i).eq.ntyp1)))
5698 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5699 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5700 & (itype(i-3).eq.ntyp1)))) cycle
5701 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5702 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5704 do j=1,nterm_sccor(isccori,isccori1)
5705 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5706 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5707 cosphi=dcos(j*tauangle(intertyp,i))
5708 sinphi=dsin(j*tauangle(intertyp,i))
5709 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5710 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5712 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5713 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5714 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5716 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5717 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5718 & (v1sccor(j,1,itori,itori1),j=1,6)
5719 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5720 c gsccor_loc(i-3)=gloci
5725 c------------------------------------------------------------------------------
5726 subroutine multibody(ecorr)
5727 C This subroutine calculates multi-body contributions to energy following
5728 C the idea of Skolnick et al. If side chains I and J make a contact and
5729 C at the same time side chains I+1 and J+1 make a contact, an extra
5730 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5731 implicit real*8 (a-h,o-z)
5732 include 'DIMENSIONS'
5733 include 'COMMON.IOUNITS'
5734 include 'COMMON.DERIV'
5735 include 'COMMON.INTERACT'
5736 include 'COMMON.CONTACTS'
5737 double precision gx(3),gx1(3)
5740 C Set lprn=.true. for debugging
5744 write (iout,'(a)') 'Contact function values:'
5746 write (iout,'(i2,20(1x,i2,f10.5))')
5747 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5762 num_conti=num_cont(i)
5763 num_conti1=num_cont(i1)
5768 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5769 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5770 cd & ' ishift=',ishift
5771 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5772 C The system gains extra energy.
5773 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5774 endif ! j1==j+-ishift
5783 c------------------------------------------------------------------------------
5784 double precision function esccorr(i,j,k,l,jj,kk)
5785 implicit real*8 (a-h,o-z)
5786 include 'DIMENSIONS'
5787 include 'COMMON.IOUNITS'
5788 include 'COMMON.DERIV'
5789 include 'COMMON.INTERACT'
5790 include 'COMMON.CONTACTS'
5791 double precision gx(3),gx1(3)
5796 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5797 C Calculate the multi-body contribution to energy.
5798 C Calculate multi-body contributions to the gradient.
5799 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5800 cd & k,l,(gacont(m,kk,k),m=1,3)
5802 gx(m) =ekl*gacont(m,jj,i)
5803 gx1(m)=eij*gacont(m,kk,k)
5804 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5805 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5806 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5807 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5811 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5816 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5822 c------------------------------------------------------------------------------
5824 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5825 implicit real*8 (a-h,o-z)
5826 include 'DIMENSIONS'
5827 integer dimen1,dimen2,atom,indx
5828 double precision buffer(dimen1,dimen2)
5829 double precision zapas
5830 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5831 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5832 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5833 num_kont=num_cont_hb(atom)
5837 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5840 buffer(i,indx+22)=facont_hb(i,atom)
5841 buffer(i,indx+23)=ees0p(i,atom)
5842 buffer(i,indx+24)=ees0m(i,atom)
5843 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5845 buffer(1,indx+26)=dfloat(num_kont)
5848 c------------------------------------------------------------------------------
5849 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5850 implicit real*8 (a-h,o-z)
5851 include 'DIMENSIONS'
5852 integer dimen1,dimen2,atom,indx
5853 double precision buffer(dimen1,dimen2)
5854 double precision zapas
5855 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5856 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5857 & ees0m(ntyp,maxres),
5858 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5859 num_kont=buffer(1,indx+26)
5860 num_kont_old=num_cont_hb(atom)
5861 num_cont_hb(atom)=num_kont+num_kont_old
5866 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5869 facont_hb(ii,atom)=buffer(i,indx+22)
5870 ees0p(ii,atom)=buffer(i,indx+23)
5871 ees0m(ii,atom)=buffer(i,indx+24)
5872 jcont_hb(ii,atom)=buffer(i,indx+25)
5876 c------------------------------------------------------------------------------
5878 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5879 C This subroutine calculates multi-body contributions to hydrogen-bonding
5880 implicit real*8 (a-h,o-z)
5881 include 'DIMENSIONS'
5882 include 'DIMENSIONS.ZSCOPT'
5883 include 'COMMON.IOUNITS'
5885 include 'COMMON.INFO'
5887 include 'COMMON.FFIELD'
5888 include 'COMMON.DERIV'
5889 include 'COMMON.INTERACT'
5890 include 'COMMON.CONTACTS'
5892 parameter (max_cont=maxconts)
5893 parameter (max_dim=2*(8*3+2))
5894 parameter (msglen1=max_cont*max_dim*4)
5895 parameter (msglen2=2*msglen1)
5896 integer source,CorrelType,CorrelID,Error
5897 double precision buffer(max_cont,max_dim)
5899 double precision gx(3),gx1(3)
5902 C Set lprn=.true. for debugging
5907 if (fgProcs.le.1) goto 30
5909 write (iout,'(a)') 'Contact function values:'
5911 write (iout,'(2i3,50(1x,i2,f5.2))')
5912 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5913 & j=1,num_cont_hb(i))
5916 C Caution! Following code assumes that electrostatic interactions concerning
5917 C a given atom are split among at most two processors!
5927 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5930 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5931 if (MyRank.gt.0) then
5932 C Send correlation contributions to the preceding processor
5934 nn=num_cont_hb(iatel_s)
5935 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5936 cd write (iout,*) 'The BUFFER array:'
5938 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5940 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5942 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5943 C Clear the contacts of the atom passed to the neighboring processor
5944 nn=num_cont_hb(iatel_s+1)
5946 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5948 num_cont_hb(iatel_s)=0
5950 cd write (iout,*) 'Processor ',MyID,MyRank,
5951 cd & ' is sending correlation contribution to processor',MyID-1,
5952 cd & ' msglen=',msglen
5953 cd write (*,*) 'Processor ',MyID,MyRank,
5954 cd & ' is sending correlation contribution to processor',MyID-1,
5955 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5956 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5957 cd write (iout,*) 'Processor ',MyID,
5958 cd & ' has sent correlation contribution to processor',MyID-1,
5959 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5960 cd write (*,*) 'Processor ',MyID,
5961 cd & ' has sent correlation contribution to processor',MyID-1,
5962 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5964 endif ! (MyRank.gt.0)
5968 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5969 if (MyRank.lt.fgProcs-1) then
5970 C Receive correlation contributions from the next processor
5972 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5973 cd write (iout,*) 'Processor',MyID,
5974 cd & ' is receiving correlation contribution from processor',MyID+1,
5975 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5976 cd write (*,*) 'Processor',MyID,
5977 cd & ' is receiving correlation contribution from processor',MyID+1,
5978 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5980 do while (nbytes.le.0)
5981 call mp_probe(MyID+1,CorrelType,nbytes)
5983 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5984 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5985 cd write (iout,*) 'Processor',MyID,
5986 cd & ' has received correlation contribution from processor',MyID+1,
5987 cd & ' msglen=',msglen,' nbytes=',nbytes
5988 cd write (iout,*) 'The received BUFFER array:'
5990 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5992 if (msglen.eq.msglen1) then
5993 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5994 else if (msglen.eq.msglen2) then
5995 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5996 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5999 & 'ERROR!!!! message length changed while processing correlations.'
6001 & 'ERROR!!!! message length changed while processing correlations.'
6002 call mp_stopall(Error)
6003 endif ! msglen.eq.msglen1
6004 endif ! MyRank.lt.fgProcs-1
6011 write (iout,'(a)') 'Contact function values:'
6013 write (iout,'(2i3,50(1x,i2,f5.2))')
6014 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6015 & j=1,num_cont_hb(i))
6019 C Remove the loop below after debugging !!!
6026 C Calculate the local-electrostatic correlation terms
6027 do i=iatel_s,iatel_e+1
6029 num_conti=num_cont_hb(i)
6030 num_conti1=num_cont_hb(i+1)
6035 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6036 c & ' jj=',jj,' kk=',kk
6037 if (j1.eq.j+1 .or. j1.eq.j-1) then
6038 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6039 C The system gains extra energy.
6040 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6042 else if (j1.eq.j) then
6043 C Contacts I-J and I-(J+1) occur simultaneously.
6044 C The system loses extra energy.
6045 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6050 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6051 c & ' jj=',jj,' kk=',kk
6053 C Contacts I-J and (I+1)-J occur simultaneously.
6054 C The system loses extra energy.
6055 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6062 c------------------------------------------------------------------------------
6063 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6065 C This subroutine calculates multi-body contributions to hydrogen-bonding
6066 implicit real*8 (a-h,o-z)
6067 include 'DIMENSIONS'
6068 include 'DIMENSIONS.ZSCOPT'
6069 include 'COMMON.IOUNITS'
6071 include 'COMMON.INFO'
6073 include 'COMMON.FFIELD'
6074 include 'COMMON.DERIV'
6075 include 'COMMON.INTERACT'
6076 include 'COMMON.CONTACTS'
6078 parameter (max_cont=maxconts)
6079 parameter (max_dim=2*(8*3+2))
6080 parameter (msglen1=max_cont*max_dim*4)
6081 parameter (msglen2=2*msglen1)
6082 integer source,CorrelType,CorrelID,Error
6083 double precision buffer(max_cont,max_dim)
6085 double precision gx(3),gx1(3)
6088 C Set lprn=.true. for debugging
6095 if (fgProcs.le.1) goto 30
6097 write (iout,'(a)') 'Contact function values:'
6099 write (iout,'(2i3,50(1x,i2,f5.2))')
6100 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6101 & j=1,num_cont_hb(i))
6104 C Caution! Following code assumes that electrostatic interactions concerning
6105 C a given atom are split among at most two processors!
6115 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6118 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6119 if (MyRank.gt.0) then
6120 C Send correlation contributions to the preceding processor
6122 nn=num_cont_hb(iatel_s)
6123 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6124 cd write (iout,*) 'The BUFFER array:'
6126 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6128 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6130 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6131 C Clear the contacts of the atom passed to the neighboring processor
6132 nn=num_cont_hb(iatel_s+1)
6134 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6136 num_cont_hb(iatel_s)=0
6138 cd write (iout,*) 'Processor ',MyID,MyRank,
6139 cd & ' is sending correlation contribution to processor',MyID-1,
6140 cd & ' msglen=',msglen
6141 cd write (*,*) 'Processor ',MyID,MyRank,
6142 cd & ' is sending correlation contribution to processor',MyID-1,
6143 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6144 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6145 cd write (iout,*) 'Processor ',MyID,
6146 cd & ' has sent correlation contribution to processor',MyID-1,
6147 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6148 cd write (*,*) 'Processor ',MyID,
6149 cd & ' has sent correlation contribution to processor',MyID-1,
6150 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6152 endif ! (MyRank.gt.0)
6156 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6157 if (MyRank.lt.fgProcs-1) then
6158 C Receive correlation contributions from the next processor
6160 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6161 cd write (iout,*) 'Processor',MyID,
6162 cd & ' is receiving correlation contribution from processor',MyID+1,
6163 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6164 cd write (*,*) 'Processor',MyID,
6165 cd & ' is receiving correlation contribution from processor',MyID+1,
6166 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6168 do while (nbytes.le.0)
6169 call mp_probe(MyID+1,CorrelType,nbytes)
6171 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6172 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6173 cd write (iout,*) 'Processor',MyID,
6174 cd & ' has received correlation contribution from processor',MyID+1,
6175 cd & ' msglen=',msglen,' nbytes=',nbytes
6176 cd write (iout,*) 'The received BUFFER array:'
6178 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6180 if (msglen.eq.msglen1) then
6181 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6182 else if (msglen.eq.msglen2) then
6183 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6184 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6187 & 'ERROR!!!! message length changed while processing correlations.'
6189 & 'ERROR!!!! message length changed while processing correlations.'
6190 call mp_stopall(Error)
6191 endif ! msglen.eq.msglen1
6192 endif ! MyRank.lt.fgProcs-1
6199 write (iout,'(a)') 'Contact function values:'
6201 write (iout,'(2i3,50(1x,i2,f5.2))')
6202 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6203 & j=1,num_cont_hb(i))
6209 C Remove the loop below after debugging !!!
6216 C Calculate the dipole-dipole interaction energies
6217 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6218 do i=iatel_s,iatel_e+1
6219 num_conti=num_cont_hb(i)
6226 C Calculate the local-electrostatic correlation terms
6227 do i=iatel_s,iatel_e+1
6229 num_conti=num_cont_hb(i)
6230 num_conti1=num_cont_hb(i+1)
6235 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6236 c & ' jj=',jj,' kk=',kk
6237 if (j1.eq.j+1 .or. j1.eq.j-1) then
6238 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6239 C The system gains extra energy.
6241 sqd1=dsqrt(d_cont(jj,i))
6242 sqd2=dsqrt(d_cont(kk,i1))
6243 sred_geom = sqd1*sqd2
6244 IF (sred_geom.lt.cutoff_corr) THEN
6245 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6247 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6248 c & ' jj=',jj,' kk=',kk
6249 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6250 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6252 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6253 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6256 cd write (iout,*) 'sred_geom=',sred_geom,
6257 cd & ' ekont=',ekont,' fprim=',fprimcont
6258 call calc_eello(i,j,i+1,j1,jj,kk)
6259 if (wcorr4.gt.0.0d0)
6260 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6261 if (wcorr5.gt.0.0d0)
6262 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6263 c print *,"wcorr5",ecorr5
6264 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6265 cd write(2,*)'ijkl',i,j,i+1,j1
6266 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6267 & .or. wturn6.eq.0.0d0))then
6268 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6269 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6270 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6271 cd & 'ecorr6=',ecorr6
6272 cd write (iout,'(4e15.5)') sred_geom,
6273 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6274 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6275 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6276 else if (wturn6.gt.0.0d0
6277 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6278 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6279 eturn6=eturn6+eello_turn6(i,jj,kk)
6280 cd write (2,*) 'multibody_eello:eturn6',eturn6
6281 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6288 else if (j1.eq.j) then
6289 C Contacts I-J and I-(J+1) occur simultaneously.
6290 C The system loses extra energy.
6291 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6296 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6297 c & ' jj=',jj,' kk=',kk
6299 C Contacts I-J and (I+1)-J occur simultaneously.
6300 C The system loses extra energy.
6301 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6306 write (iout,*) "eturn6",eturn6,ecorr6
6309 c------------------------------------------------------------------------------
6310 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6311 implicit real*8 (a-h,o-z)
6312 include 'DIMENSIONS'
6313 include 'COMMON.IOUNITS'
6314 include 'COMMON.DERIV'
6315 include 'COMMON.INTERACT'
6316 include 'COMMON.CONTACTS'
6317 double precision gx(3),gx1(3)
6327 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6328 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6329 C Following 4 lines for diagnostics.
6334 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6336 c write (iout,*)'Contacts have occurred for peptide groups',
6337 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6338 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6339 C Calculate the multi-body contribution to energy.
6340 ecorr=ecorr+ekont*ees
6342 C Calculate multi-body contributions to the gradient.
6344 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6345 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6346 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6347 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6348 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6349 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6350 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6351 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6352 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6353 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6354 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6355 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6356 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6357 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6361 gradcorr(ll,m)=gradcorr(ll,m)+
6362 & ees*ekl*gacont_hbr(ll,jj,i)-
6363 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6364 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6369 gradcorr(ll,m)=gradcorr(ll,m)+
6370 & ees*eij*gacont_hbr(ll,kk,k)-
6371 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6372 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6379 C---------------------------------------------------------------------------
6380 subroutine dipole(i,j,jj)
6381 implicit real*8 (a-h,o-z)
6382 include 'DIMENSIONS'
6383 include 'DIMENSIONS.ZSCOPT'
6384 include 'COMMON.IOUNITS'
6385 include 'COMMON.CHAIN'
6386 include 'COMMON.FFIELD'
6387 include 'COMMON.DERIV'
6388 include 'COMMON.INTERACT'
6389 include 'COMMON.CONTACTS'
6390 include 'COMMON.TORSION'
6391 include 'COMMON.VAR'
6392 include 'COMMON.GEO'
6393 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6395 iti1 = itortyp(itype(i+1))
6396 if (j.lt.nres-1) then
6397 if (itype(j).le.ntyp) then
6398 itj1 = itortyp(itype(j+1))
6406 dipi(iii,1)=Ub2(iii,i)
6407 dipderi(iii)=Ub2der(iii,i)
6408 dipi(iii,2)=b1(iii,iti1)
6409 dipj(iii,1)=Ub2(iii,j)
6410 dipderj(iii)=Ub2der(iii,j)
6411 dipj(iii,2)=b1(iii,itj1)
6415 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6418 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6421 if (.not.calc_grad) return
6426 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6430 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6435 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6436 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6438 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6440 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6442 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6446 C---------------------------------------------------------------------------
6447 subroutine calc_eello(i,j,k,l,jj,kk)
6449 C This subroutine computes matrices and vectors needed to calculate
6450 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6452 implicit real*8 (a-h,o-z)
6453 include 'DIMENSIONS'
6454 include 'DIMENSIONS.ZSCOPT'
6455 include 'COMMON.IOUNITS'
6456 include 'COMMON.CHAIN'
6457 include 'COMMON.DERIV'
6458 include 'COMMON.INTERACT'
6459 include 'COMMON.CONTACTS'
6460 include 'COMMON.TORSION'
6461 include 'COMMON.VAR'
6462 include 'COMMON.GEO'
6463 include 'COMMON.FFIELD'
6464 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6465 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6468 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6469 cd & ' jj=',jj,' kk=',kk
6470 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6473 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6474 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6477 call transpose2(aa1(1,1),aa1t(1,1))
6478 call transpose2(aa2(1,1),aa2t(1,1))
6481 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6482 & aa1tder(1,1,lll,kkk))
6483 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6484 & aa2tder(1,1,lll,kkk))
6488 C parallel orientation of the two CA-CA-CA frames.
6489 if (i.gt.1 .and. itype(i).le.ntyp) then
6490 iti=itortyp(itype(i))
6494 itk1=itortyp(itype(k+1))
6495 itj=itortyp(itype(j))
6496 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6497 itl1=itortyp(itype(l+1))
6501 C A1 kernel(j+1) A2T
6503 cd write (iout,'(3f10.5,5x,3f10.5)')
6504 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6506 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6507 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6508 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6509 C Following matrices are needed only for 6-th order cumulants
6510 IF (wcorr6.gt.0.0d0) THEN
6511 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6512 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6513 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6514 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6515 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6516 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6517 & ADtEAderx(1,1,1,1,1,1))
6519 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6520 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6521 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6522 & ADtEA1derx(1,1,1,1,1,1))
6524 C End 6-th order cumulants
6527 cd write (2,*) 'In calc_eello6'
6529 cd write (2,*) 'iii=',iii
6531 cd write (2,*) 'kkk=',kkk
6533 cd write (2,'(3(2f10.5),5x)')
6534 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6539 call transpose2(EUgder(1,1,k),auxmat(1,1))
6540 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6541 call transpose2(EUg(1,1,k),auxmat(1,1))
6542 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6543 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6547 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6548 & EAEAderx(1,1,lll,kkk,iii,1))
6552 C A1T kernel(i+1) A2
6553 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6554 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6555 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6556 C Following matrices are needed only for 6-th order cumulants
6557 IF (wcorr6.gt.0.0d0) THEN
6558 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6559 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6560 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6561 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6562 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6563 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6564 & ADtEAderx(1,1,1,1,1,2))
6565 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6566 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6567 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6568 & ADtEA1derx(1,1,1,1,1,2))
6570 C End 6-th order cumulants
6571 call transpose2(EUgder(1,1,l),auxmat(1,1))
6572 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6573 call transpose2(EUg(1,1,l),auxmat(1,1))
6574 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6575 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6579 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6580 & EAEAderx(1,1,lll,kkk,iii,2))
6585 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6586 C They are needed only when the fifth- or the sixth-order cumulants are
6588 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6589 call transpose2(AEA(1,1,1),auxmat(1,1))
6590 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6591 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6592 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6593 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6594 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6595 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6596 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6597 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6598 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6599 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6600 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6601 call transpose2(AEA(1,1,2),auxmat(1,1))
6602 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6603 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6604 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6605 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6606 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6607 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6608 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6609 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6610 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6611 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6612 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6613 C Calculate the Cartesian derivatives of the vectors.
6617 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6618 call matvec2(auxmat(1,1),b1(1,iti),
6619 & AEAb1derx(1,lll,kkk,iii,1,1))
6620 call matvec2(auxmat(1,1),Ub2(1,i),
6621 & AEAb2derx(1,lll,kkk,iii,1,1))
6622 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6623 & AEAb1derx(1,lll,kkk,iii,2,1))
6624 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6625 & AEAb2derx(1,lll,kkk,iii,2,1))
6626 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6627 call matvec2(auxmat(1,1),b1(1,itj),
6628 & AEAb1derx(1,lll,kkk,iii,1,2))
6629 call matvec2(auxmat(1,1),Ub2(1,j),
6630 & AEAb2derx(1,lll,kkk,iii,1,2))
6631 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6632 & AEAb1derx(1,lll,kkk,iii,2,2))
6633 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6634 & AEAb2derx(1,lll,kkk,iii,2,2))
6641 C Antiparallel orientation of the two CA-CA-CA frames.
6642 if (i.gt.1 .and. itype(i).le.ntyp) then
6643 iti=itortyp(itype(i))
6647 itk1=itortyp(itype(k+1))
6648 itl=itortyp(itype(l))
6649 itj=itortyp(itype(j))
6650 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6651 itj1=itortyp(itype(j+1))
6655 C A2 kernel(j-1)T A1T
6656 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6657 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6658 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6659 C Following matrices are needed only for 6-th order cumulants
6660 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6661 & j.eq.i+4 .and. l.eq.i+3)) THEN
6662 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6663 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6664 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6665 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6666 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6667 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6668 & ADtEAderx(1,1,1,1,1,1))
6669 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6670 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6671 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6672 & ADtEA1derx(1,1,1,1,1,1))
6674 C End 6-th order cumulants
6675 call transpose2(EUgder(1,1,k),auxmat(1,1))
6676 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6677 call transpose2(EUg(1,1,k),auxmat(1,1))
6678 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6679 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6683 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6684 & EAEAderx(1,1,lll,kkk,iii,1))
6688 C A2T kernel(i+1)T A1
6689 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6690 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6691 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6692 C Following matrices are needed only for 6-th order cumulants
6693 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6694 & j.eq.i+4 .and. l.eq.i+3)) THEN
6695 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6696 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6697 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6698 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6699 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6700 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6701 & ADtEAderx(1,1,1,1,1,2))
6702 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6703 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6704 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6705 & ADtEA1derx(1,1,1,1,1,2))
6707 C End 6-th order cumulants
6708 call transpose2(EUgder(1,1,j),auxmat(1,1))
6709 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6710 call transpose2(EUg(1,1,j),auxmat(1,1))
6711 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6712 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6716 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6717 & EAEAderx(1,1,lll,kkk,iii,2))
6722 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6723 C They are needed only when the fifth- or the sixth-order cumulants are
6725 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6726 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6727 call transpose2(AEA(1,1,1),auxmat(1,1))
6728 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6729 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6730 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6731 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6732 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6733 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6734 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6735 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6736 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6737 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6738 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6739 call transpose2(AEA(1,1,2),auxmat(1,1))
6740 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6741 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6742 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6743 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6744 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6745 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6746 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6747 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6748 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6749 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6750 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6751 C Calculate the Cartesian derivatives of the vectors.
6755 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6756 call matvec2(auxmat(1,1),b1(1,iti),
6757 & AEAb1derx(1,lll,kkk,iii,1,1))
6758 call matvec2(auxmat(1,1),Ub2(1,i),
6759 & AEAb2derx(1,lll,kkk,iii,1,1))
6760 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6761 & AEAb1derx(1,lll,kkk,iii,2,1))
6762 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6763 & AEAb2derx(1,lll,kkk,iii,2,1))
6764 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6765 call matvec2(auxmat(1,1),b1(1,itl),
6766 & AEAb1derx(1,lll,kkk,iii,1,2))
6767 call matvec2(auxmat(1,1),Ub2(1,l),
6768 & AEAb2derx(1,lll,kkk,iii,1,2))
6769 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6770 & AEAb1derx(1,lll,kkk,iii,2,2))
6771 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6772 & AEAb2derx(1,lll,kkk,iii,2,2))
6781 C---------------------------------------------------------------------------
6782 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6783 & KK,KKderg,AKA,AKAderg,AKAderx)
6787 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6788 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6789 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6794 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6796 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6799 cd if (lprn) write (2,*) 'In kernel'
6801 cd if (lprn) write (2,*) 'kkk=',kkk
6803 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6804 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6806 cd write (2,*) 'lll=',lll
6807 cd write (2,*) 'iii=1'
6809 cd write (2,'(3(2f10.5),5x)')
6810 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6813 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6814 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6816 cd write (2,*) 'lll=',lll
6817 cd write (2,*) 'iii=2'
6819 cd write (2,'(3(2f10.5),5x)')
6820 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6827 C---------------------------------------------------------------------------
6828 double precision function eello4(i,j,k,l,jj,kk)
6829 implicit real*8 (a-h,o-z)
6830 include 'DIMENSIONS'
6831 include 'DIMENSIONS.ZSCOPT'
6832 include 'COMMON.IOUNITS'
6833 include 'COMMON.CHAIN'
6834 include 'COMMON.DERIV'
6835 include 'COMMON.INTERACT'
6836 include 'COMMON.CONTACTS'
6837 include 'COMMON.TORSION'
6838 include 'COMMON.VAR'
6839 include 'COMMON.GEO'
6840 double precision pizda(2,2),ggg1(3),ggg2(3)
6841 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6845 cd print *,'eello4:',i,j,k,l,jj,kk
6846 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6847 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6848 cold eij=facont_hb(jj,i)
6849 cold ekl=facont_hb(kk,k)
6851 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6853 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6854 gcorr_loc(k-1)=gcorr_loc(k-1)
6855 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6857 gcorr_loc(l-1)=gcorr_loc(l-1)
6858 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6860 gcorr_loc(j-1)=gcorr_loc(j-1)
6861 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6866 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6867 & -EAEAderx(2,2,lll,kkk,iii,1)
6868 cd derx(lll,kkk,iii)=0.0d0
6872 cd gcorr_loc(l-1)=0.0d0
6873 cd gcorr_loc(j-1)=0.0d0
6874 cd gcorr_loc(k-1)=0.0d0
6876 cd write (iout,*)'Contacts have occurred for peptide groups',
6877 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6878 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6879 if (j.lt.nres-1) then
6886 if (l.lt.nres-1) then
6894 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6895 ggg1(ll)=eel4*g_contij(ll,1)
6896 ggg2(ll)=eel4*g_contij(ll,2)
6897 ghalf=0.5d0*ggg1(ll)
6899 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6900 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6901 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6902 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6903 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6904 ghalf=0.5d0*ggg2(ll)
6906 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6907 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6908 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6909 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6914 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6915 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6920 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6921 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6927 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6932 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6936 cd write (2,*) iii,gcorr_loc(iii)
6940 cd write (2,*) 'ekont',ekont
6941 cd write (iout,*) 'eello4',ekont*eel4
6944 C---------------------------------------------------------------------------
6945 double precision function eello5(i,j,k,l,jj,kk)
6946 implicit real*8 (a-h,o-z)
6947 include 'DIMENSIONS'
6948 include 'DIMENSIONS.ZSCOPT'
6949 include 'COMMON.IOUNITS'
6950 include 'COMMON.CHAIN'
6951 include 'COMMON.DERIV'
6952 include 'COMMON.INTERACT'
6953 include 'COMMON.CONTACTS'
6954 include 'COMMON.TORSION'
6955 include 'COMMON.VAR'
6956 include 'COMMON.GEO'
6957 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6958 double precision ggg1(3),ggg2(3)
6959 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6964 C /l\ / \ \ / \ / \ / C
6965 C / \ / \ \ / \ / \ / C
6966 C j| o |l1 | o | o| o | | o |o C
6967 C \ |/k\| |/ \| / |/ \| |/ \| C
6968 C \i/ \ / \ / / \ / \ C
6970 C (I) (II) (III) (IV) C
6972 C eello5_1 eello5_2 eello5_3 eello5_4 C
6974 C Antiparallel chains C
6977 C /j\ / \ \ / \ / \ / C
6978 C / \ / \ \ / \ / \ / C
6979 C j1| o |l | o | o| o | | o |o C
6980 C \ |/k\| |/ \| / |/ \| |/ \| C
6981 C \i/ \ / \ / / \ / \ C
6983 C (I) (II) (III) (IV) C
6985 C eello5_1 eello5_2 eello5_3 eello5_4 C
6987 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6990 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6995 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6997 itk=itortyp(itype(k))
6998 itl=itortyp(itype(l))
6999 itj=itortyp(itype(j))
7004 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7005 cd & eel5_3_num,eel5_4_num)
7009 derx(lll,kkk,iii)=0.0d0
7013 cd eij=facont_hb(jj,i)
7014 cd ekl=facont_hb(kk,k)
7016 cd write (iout,*)'Contacts have occurred for peptide groups',
7017 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7019 C Contribution from the graph I.
7020 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7021 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7022 call transpose2(EUg(1,1,k),auxmat(1,1))
7023 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7024 vv(1)=pizda(1,1)-pizda(2,2)
7025 vv(2)=pizda(1,2)+pizda(2,1)
7026 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7027 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7029 C Explicit gradient in virtual-dihedral angles.
7030 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7031 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7032 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7033 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7034 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7035 vv(1)=pizda(1,1)-pizda(2,2)
7036 vv(2)=pizda(1,2)+pizda(2,1)
7037 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7038 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7039 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7040 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7041 vv(1)=pizda(1,1)-pizda(2,2)
7042 vv(2)=pizda(1,2)+pizda(2,1)
7044 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7045 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7046 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7048 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7049 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7050 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7052 C Cartesian gradient
7056 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7058 vv(1)=pizda(1,1)-pizda(2,2)
7059 vv(2)=pizda(1,2)+pizda(2,1)
7060 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7061 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7062 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7069 C Contribution from graph II
7070 call transpose2(EE(1,1,itk),auxmat(1,1))
7071 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7072 vv(1)=pizda(1,1)+pizda(2,2)
7073 vv(2)=pizda(2,1)-pizda(1,2)
7074 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7075 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7077 C Explicit gradient in virtual-dihedral angles.
7078 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7079 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7080 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7081 vv(1)=pizda(1,1)+pizda(2,2)
7082 vv(2)=pizda(2,1)-pizda(1,2)
7084 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7085 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7086 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7088 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7089 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7090 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7092 C Cartesian gradient
7096 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7098 vv(1)=pizda(1,1)+pizda(2,2)
7099 vv(2)=pizda(2,1)-pizda(1,2)
7100 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7101 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7102 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7111 C Parallel orientation
7112 C Contribution from graph III
7113 call transpose2(EUg(1,1,l),auxmat(1,1))
7114 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7115 vv(1)=pizda(1,1)-pizda(2,2)
7116 vv(2)=pizda(1,2)+pizda(2,1)
7117 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7118 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7120 C Explicit gradient in virtual-dihedral angles.
7121 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7122 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7123 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7124 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7125 vv(1)=pizda(1,1)-pizda(2,2)
7126 vv(2)=pizda(1,2)+pizda(2,1)
7127 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7128 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7129 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7130 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7131 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7132 vv(1)=pizda(1,1)-pizda(2,2)
7133 vv(2)=pizda(1,2)+pizda(2,1)
7134 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7135 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7136 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7137 C Cartesian gradient
7141 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7143 vv(1)=pizda(1,1)-pizda(2,2)
7144 vv(2)=pizda(1,2)+pizda(2,1)
7145 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7146 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7147 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7153 C Contribution from graph IV
7155 call transpose2(EE(1,1,itl),auxmat(1,1))
7156 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7157 vv(1)=pizda(1,1)+pizda(2,2)
7158 vv(2)=pizda(2,1)-pizda(1,2)
7159 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7160 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7162 C Explicit gradient in virtual-dihedral angles.
7163 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7164 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7165 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7166 vv(1)=pizda(1,1)+pizda(2,2)
7167 vv(2)=pizda(2,1)-pizda(1,2)
7168 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7169 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7170 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7171 C Cartesian gradient
7175 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7177 vv(1)=pizda(1,1)+pizda(2,2)
7178 vv(2)=pizda(2,1)-pizda(1,2)
7179 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7180 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7181 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7187 C Antiparallel orientation
7188 C Contribution from graph III
7190 call transpose2(EUg(1,1,j),auxmat(1,1))
7191 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7192 vv(1)=pizda(1,1)-pizda(2,2)
7193 vv(2)=pizda(1,2)+pizda(2,1)
7194 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7195 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7197 C Explicit gradient in virtual-dihedral angles.
7198 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7199 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7200 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7201 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7202 vv(1)=pizda(1,1)-pizda(2,2)
7203 vv(2)=pizda(1,2)+pizda(2,1)
7204 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7205 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7206 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7207 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7208 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7209 vv(1)=pizda(1,1)-pizda(2,2)
7210 vv(2)=pizda(1,2)+pizda(2,1)
7211 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7212 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7213 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7214 C Cartesian gradient
7218 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7220 vv(1)=pizda(1,1)-pizda(2,2)
7221 vv(2)=pizda(1,2)+pizda(2,1)
7222 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7223 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7224 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7230 C Contribution from graph IV
7232 call transpose2(EE(1,1,itj),auxmat(1,1))
7233 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7234 vv(1)=pizda(1,1)+pizda(2,2)
7235 vv(2)=pizda(2,1)-pizda(1,2)
7236 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7237 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7239 C Explicit gradient in virtual-dihedral angles.
7240 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7241 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7242 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7243 vv(1)=pizda(1,1)+pizda(2,2)
7244 vv(2)=pizda(2,1)-pizda(1,2)
7245 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7246 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7247 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7248 C Cartesian gradient
7252 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7254 vv(1)=pizda(1,1)+pizda(2,2)
7255 vv(2)=pizda(2,1)-pizda(1,2)
7256 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7257 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7258 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7265 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7266 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7267 cd write (2,*) 'ijkl',i,j,k,l
7268 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7269 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7271 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7272 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7273 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7274 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7276 if (j.lt.nres-1) then
7283 if (l.lt.nres-1) then
7293 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7295 ggg1(ll)=eel5*g_contij(ll,1)
7296 ggg2(ll)=eel5*g_contij(ll,2)
7297 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7298 ghalf=0.5d0*ggg1(ll)
7300 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7301 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7302 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7303 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7304 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7305 ghalf=0.5d0*ggg2(ll)
7307 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7308 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7309 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7310 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7315 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7316 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7321 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7322 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7328 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7333 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7337 cd write (2,*) iii,g_corr5_loc(iii)
7341 cd write (2,*) 'ekont',ekont
7342 cd write (iout,*) 'eello5',ekont*eel5
7345 c--------------------------------------------------------------------------
7346 double precision function eello6(i,j,k,l,jj,kk)
7347 implicit real*8 (a-h,o-z)
7348 include 'DIMENSIONS'
7349 include 'DIMENSIONS.ZSCOPT'
7350 include 'COMMON.IOUNITS'
7351 include 'COMMON.CHAIN'
7352 include 'COMMON.DERIV'
7353 include 'COMMON.INTERACT'
7354 include 'COMMON.CONTACTS'
7355 include 'COMMON.TORSION'
7356 include 'COMMON.VAR'
7357 include 'COMMON.GEO'
7358 include 'COMMON.FFIELD'
7359 double precision ggg1(3),ggg2(3)
7360 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7365 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7373 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7374 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7378 derx(lll,kkk,iii)=0.0d0
7382 cd eij=facont_hb(jj,i)
7383 cd ekl=facont_hb(kk,k)
7389 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7390 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7391 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7392 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7393 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7394 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7396 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7397 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7398 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7399 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7400 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7401 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7405 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7407 C If turn contributions are considered, they will be handled separately.
7408 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7409 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7410 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7411 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7412 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7413 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7414 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7417 if (j.lt.nres-1) then
7424 if (l.lt.nres-1) then
7432 ggg1(ll)=eel6*g_contij(ll,1)
7433 ggg2(ll)=eel6*g_contij(ll,2)
7434 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7435 ghalf=0.5d0*ggg1(ll)
7437 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7438 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7439 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7440 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7441 ghalf=0.5d0*ggg2(ll)
7442 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7444 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7445 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7446 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7447 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7452 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7453 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7458 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7459 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7465 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7470 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7474 cd write (2,*) iii,g_corr6_loc(iii)
7478 cd write (2,*) 'ekont',ekont
7479 cd write (iout,*) 'eello6',ekont*eel6
7482 c--------------------------------------------------------------------------
7483 double precision function eello6_graph1(i,j,k,l,imat,swap)
7484 implicit real*8 (a-h,o-z)
7485 include 'DIMENSIONS'
7486 include 'DIMENSIONS.ZSCOPT'
7487 include 'COMMON.IOUNITS'
7488 include 'COMMON.CHAIN'
7489 include 'COMMON.DERIV'
7490 include 'COMMON.INTERACT'
7491 include 'COMMON.CONTACTS'
7492 include 'COMMON.TORSION'
7493 include 'COMMON.VAR'
7494 include 'COMMON.GEO'
7495 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7499 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7501 C Parallel Antiparallel C
7507 C \ j|/k\| / \ |/k\|l / C
7512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7513 itk=itortyp(itype(k))
7514 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7515 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7516 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7517 call transpose2(EUgC(1,1,k),auxmat(1,1))
7518 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7519 vv1(1)=pizda1(1,1)-pizda1(2,2)
7520 vv1(2)=pizda1(1,2)+pizda1(2,1)
7521 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7522 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7523 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7524 s5=scalar2(vv(1),Dtobr2(1,i))
7525 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7526 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7527 if (.not. calc_grad) return
7528 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7529 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7530 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7531 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7532 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7533 & +scalar2(vv(1),Dtobr2der(1,i)))
7534 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7535 vv1(1)=pizda1(1,1)-pizda1(2,2)
7536 vv1(2)=pizda1(1,2)+pizda1(2,1)
7537 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7538 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7540 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7541 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7542 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7543 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7544 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7546 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7547 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7548 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7549 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7550 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7552 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7553 call matmat2(AEA(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 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7557 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7558 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7559 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7568 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7569 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7570 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7571 call transpose2(EUgC(1,1,k),auxmat(1,1))
7572 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7574 vv1(1)=pizda1(1,1)-pizda1(2,2)
7575 vv1(2)=pizda1(1,2)+pizda1(2,1)
7576 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7577 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7578 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7579 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7580 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7581 s5=scalar2(vv(1),Dtobr2(1,i))
7582 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7588 c----------------------------------------------------------------------------
7589 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7590 implicit real*8 (a-h,o-z)
7591 include 'DIMENSIONS'
7592 include 'DIMENSIONS.ZSCOPT'
7593 include 'COMMON.IOUNITS'
7594 include 'COMMON.CHAIN'
7595 include 'COMMON.DERIV'
7596 include 'COMMON.INTERACT'
7597 include 'COMMON.CONTACTS'
7598 include 'COMMON.TORSION'
7599 include 'COMMON.VAR'
7600 include 'COMMON.GEO'
7602 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7603 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7608 C Parallel Antiparallel C
7614 C \ j|/k\| \ |/k\|l C
7619 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7620 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7621 C AL 7/4/01 s1 would occur in the sixth-order moment,
7622 C but not in a cluster cumulant
7624 s1=dip(1,jj,i)*dip(1,kk,k)
7626 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7627 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7628 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7629 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7630 call transpose2(EUg(1,1,k),auxmat(1,1))
7631 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7635 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7637 eello6_graph2=-(s1+s2+s3+s4)
7639 eello6_graph2=-(s2+s3+s4)
7642 if (.not. calc_grad) return
7643 C Derivatives in gamma(i-1)
7646 s1=dipderg(1,jj,i)*dip(1,kk,k)
7648 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7649 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7650 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7651 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7653 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7655 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7657 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7659 C Derivatives in gamma(k-1)
7661 s1=dip(1,jj,i)*dipderg(1,kk,k)
7663 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7664 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7665 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7666 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7667 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7668 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7669 vv(1)=pizda(1,1)-pizda(2,2)
7670 vv(2)=pizda(1,2)+pizda(2,1)
7671 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7673 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7675 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7677 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7678 C Derivatives in gamma(j-1) or gamma(l-1)
7681 s1=dipderg(3,jj,i)*dip(1,kk,k)
7683 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7684 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7685 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7686 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7689 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7692 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7694 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7697 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7698 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7700 C Derivatives in gamma(l-1) or gamma(j-1)
7703 s1=dip(1,jj,i)*dipderg(3,kk,k)
7705 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7706 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7707 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7708 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7709 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)-pizda(2,2)
7711 vv(2)=pizda(1,2)+pizda(2,1)
7712 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7715 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7717 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7720 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7721 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7723 C Cartesian derivatives.
7725 write (2,*) 'In eello6_graph2'
7727 write (2,*) 'iii=',iii
7729 write (2,*) 'kkk=',kkk
7731 write (2,'(3(2f10.5),5x)')
7732 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7742 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7744 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7747 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7749 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7750 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7752 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7753 call transpose2(EUg(1,1,k),auxmat(1,1))
7754 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7756 vv(1)=pizda(1,1)-pizda(2,2)
7757 vv(2)=pizda(1,2)+pizda(2,1)
7758 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7759 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7761 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7763 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7766 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7768 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7775 c----------------------------------------------------------------------------
7776 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7777 implicit real*8 (a-h,o-z)
7778 include 'DIMENSIONS'
7779 include 'DIMENSIONS.ZSCOPT'
7780 include 'COMMON.IOUNITS'
7781 include 'COMMON.CHAIN'
7782 include 'COMMON.DERIV'
7783 include 'COMMON.INTERACT'
7784 include 'COMMON.CONTACTS'
7785 include 'COMMON.TORSION'
7786 include 'COMMON.VAR'
7787 include 'COMMON.GEO'
7788 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7790 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7792 C Parallel Antiparallel C
7798 C j|/k\| / |/k\|l / C
7803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7805 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7806 C energy moment and not to the cluster cumulant.
7807 iti=itortyp(itype(i))
7808 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7809 itj1=itortyp(itype(j+1))
7813 itk=itortyp(itype(k))
7814 itk1=itortyp(itype(k+1))
7815 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7816 itl1=itortyp(itype(l+1))
7821 s1=dip(4,jj,i)*dip(4,kk,k)
7823 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7824 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7825 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7826 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7827 call transpose2(EE(1,1,itk),auxmat(1,1))
7828 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7829 vv(1)=pizda(1,1)+pizda(2,2)
7830 vv(2)=pizda(2,1)-pizda(1,2)
7831 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7832 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7834 eello6_graph3=-(s1+s2+s3+s4)
7836 eello6_graph3=-(s2+s3+s4)
7839 if (.not. calc_grad) return
7840 C Derivatives in gamma(k-1)
7841 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7842 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7843 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7844 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7845 C Derivatives in gamma(l-1)
7846 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7847 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7848 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7849 vv(1)=pizda(1,1)+pizda(2,2)
7850 vv(2)=pizda(2,1)-pizda(1,2)
7851 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7852 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7853 C Cartesian derivatives.
7859 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7861 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7864 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7866 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7867 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7869 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7870 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7872 vv(1)=pizda(1,1)+pizda(2,2)
7873 vv(2)=pizda(2,1)-pizda(1,2)
7874 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7876 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7878 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7881 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7883 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7885 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7891 c----------------------------------------------------------------------------
7892 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7893 implicit real*8 (a-h,o-z)
7894 include 'DIMENSIONS'
7895 include 'DIMENSIONS.ZSCOPT'
7896 include 'COMMON.IOUNITS'
7897 include 'COMMON.CHAIN'
7898 include 'COMMON.DERIV'
7899 include 'COMMON.INTERACT'
7900 include 'COMMON.CONTACTS'
7901 include 'COMMON.TORSION'
7902 include 'COMMON.VAR'
7903 include 'COMMON.GEO'
7904 include 'COMMON.FFIELD'
7905 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7906 & auxvec1(2),auxmat1(2,2)
7908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7910 C Parallel Antiparallel C
7916 C \ j|/k\| \ |/k\|l C
7921 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7923 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7924 C energy moment and not to the cluster cumulant.
7925 cd write (2,*) 'eello_graph4: wturn6',wturn6
7926 iti=itortyp(itype(i))
7927 itj=itortyp(itype(j))
7928 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7929 itj1=itortyp(itype(j+1))
7933 itk=itortyp(itype(k))
7934 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7935 itk1=itortyp(itype(k+1))
7939 itl=itortyp(itype(l))
7940 if (l.lt.nres-1) then
7941 itl1=itortyp(itype(l+1))
7945 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7946 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7947 cd & ' itl',itl,' itl1',itl1
7950 s1=dip(3,jj,i)*dip(3,kk,k)
7952 s1=dip(2,jj,j)*dip(2,kk,l)
7955 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7956 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7958 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7959 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7961 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7962 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7964 call transpose2(EUg(1,1,k),auxmat(1,1))
7965 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7966 vv(1)=pizda(1,1)-pizda(2,2)
7967 vv(2)=pizda(2,1)+pizda(1,2)
7968 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7969 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7971 eello6_graph4=-(s1+s2+s3+s4)
7973 eello6_graph4=-(s2+s3+s4)
7975 if (.not. calc_grad) return
7976 C Derivatives in gamma(i-1)
7980 s1=dipderg(2,jj,i)*dip(3,kk,k)
7982 s1=dipderg(4,jj,j)*dip(2,kk,l)
7985 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7987 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7988 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7990 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7991 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7993 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7994 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7995 cd write (2,*) 'turn6 derivatives'
7997 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7999 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8003 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8005 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8009 C Derivatives in gamma(k-1)
8012 s1=dip(3,jj,i)*dipderg(2,kk,k)
8014 s1=dip(2,jj,j)*dipderg(4,kk,l)
8017 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8018 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8020 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8021 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8023 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8024 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8026 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8027 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8028 vv(1)=pizda(1,1)-pizda(2,2)
8029 vv(2)=pizda(2,1)+pizda(1,2)
8030 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8031 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8033 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8035 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8039 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8041 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8044 C Derivatives in gamma(j-1) or gamma(l-1)
8045 if (l.eq.j+1 .and. l.gt.1) then
8046 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8047 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8048 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8049 vv(1)=pizda(1,1)-pizda(2,2)
8050 vv(2)=pizda(2,1)+pizda(1,2)
8051 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8052 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8053 else if (j.gt.1) then
8054 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8055 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8056 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8057 vv(1)=pizda(1,1)-pizda(2,2)
8058 vv(2)=pizda(2,1)+pizda(1,2)
8059 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8060 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8061 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8063 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8066 C Cartesian derivatives.
8073 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8075 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8079 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8081 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8085 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8087 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8089 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8090 & b1(1,itj1),auxvec(1))
8091 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8093 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8094 & b1(1,itl1),auxvec(1))
8095 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8097 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8099 vv(1)=pizda(1,1)-pizda(2,2)
8100 vv(2)=pizda(2,1)+pizda(1,2)
8101 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8103 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8105 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8108 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8111 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8114 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8116 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8118 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8122 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8124 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8127 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8129 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8137 c----------------------------------------------------------------------------
8138 double precision function eello_turn6(i,jj,kk)
8139 implicit real*8 (a-h,o-z)
8140 include 'DIMENSIONS'
8141 include 'DIMENSIONS.ZSCOPT'
8142 include 'COMMON.IOUNITS'
8143 include 'COMMON.CHAIN'
8144 include 'COMMON.DERIV'
8145 include 'COMMON.INTERACT'
8146 include 'COMMON.CONTACTS'
8147 include 'COMMON.TORSION'
8148 include 'COMMON.VAR'
8149 include 'COMMON.GEO'
8150 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8151 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8153 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8154 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8155 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8156 C the respective energy moment and not to the cluster cumulant.
8161 iti=itortyp(itype(i))
8162 itk=itortyp(itype(k))
8163 itk1=itortyp(itype(k+1))
8164 itl=itortyp(itype(l))
8165 itj=itortyp(itype(j))
8166 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8167 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8168 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8173 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8175 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8179 derx_turn(lll,kkk,iii)=0.0d0
8186 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8188 cd write (2,*) 'eello6_5',eello6_5
8190 call transpose2(AEA(1,1,1),auxmat(1,1))
8191 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8192 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8193 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8197 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8198 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8199 s2 = scalar2(b1(1,itk),vtemp1(1))
8201 call transpose2(AEA(1,1,2),atemp(1,1))
8202 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8203 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8204 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8208 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8209 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8210 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8212 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8213 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8214 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8215 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8216 ss13 = scalar2(b1(1,itk),vtemp4(1))
8217 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8221 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8227 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8229 C Derivatives in gamma(i+2)
8231 call transpose2(AEA(1,1,1),auxmatd(1,1))
8232 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8233 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8234 call transpose2(AEAderg(1,1,2),atempd(1,1))
8235 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8236 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8240 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8241 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8242 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8248 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8249 C Derivatives in gamma(i+3)
8251 call transpose2(AEA(1,1,1),auxmatd(1,1))
8252 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8253 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8254 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8258 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8259 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8260 s2d = scalar2(b1(1,itk),vtemp1d(1))
8262 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8263 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8265 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8267 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8268 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8269 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8279 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8280 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8282 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8283 & -0.5d0*ekont*(s2d+s12d)
8285 C Derivatives in gamma(i+4)
8286 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8287 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8288 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8290 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8291 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8292 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8302 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8304 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8306 C Derivatives in gamma(i+5)
8308 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8309 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8310 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8314 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8315 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8316 s2d = scalar2(b1(1,itk),vtemp1d(1))
8318 call transpose2(AEA(1,1,2),atempd(1,1))
8319 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8320 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8324 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8325 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8327 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8328 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8329 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8339 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8340 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8342 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8343 & -0.5d0*ekont*(s2d+s12d)
8345 C Cartesian derivatives
8350 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8351 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8352 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8356 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8357 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8359 s2d = scalar2(b1(1,itk),vtemp1d(1))
8361 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8362 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8363 s8d = -(atempd(1,1)+atempd(2,2))*
8364 & scalar2(cc(1,1,itl),vtemp2(1))
8368 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8370 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8371 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8378 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8381 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8385 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8386 & - 0.5d0*(s8d+s12d)
8388 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8397 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8399 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8400 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8401 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8402 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8403 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8405 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8406 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8407 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8411 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8412 cd & 16*eel_turn6_num
8414 if (j.lt.nres-1) then
8421 if (l.lt.nres-1) then
8429 ggg1(ll)=eel_turn6*g_contij(ll,1)
8430 ggg2(ll)=eel_turn6*g_contij(ll,2)
8431 ghalf=0.5d0*ggg1(ll)
8433 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8434 & +ekont*derx_turn(ll,2,1)
8435 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8436 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8437 & +ekont*derx_turn(ll,4,1)
8438 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8439 ghalf=0.5d0*ggg2(ll)
8441 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8442 & +ekont*derx_turn(ll,2,2)
8443 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8444 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8445 & +ekont*derx_turn(ll,4,2)
8446 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8451 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8456 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8462 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8467 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8471 cd write (2,*) iii,g_corr6_loc(iii)
8474 eello_turn6=ekont*eel_turn6
8475 cd write (2,*) 'ekont',ekont
8476 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8479 crc-------------------------------------------------
8480 SUBROUTINE MATVEC2(A1,V1,V2)
8481 implicit real*8 (a-h,o-z)
8482 include 'DIMENSIONS'
8483 DIMENSION A1(2,2),V1(2),V2(2)
8487 c 3 VI=VI+A1(I,K)*V1(K)
8491 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8492 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8497 C---------------------------------------
8498 SUBROUTINE MATMAT2(A1,A2,A3)
8499 implicit real*8 (a-h,o-z)
8500 include 'DIMENSIONS'
8501 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8502 c DIMENSION AI3(2,2)
8506 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8512 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8513 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8514 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8515 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8523 c-------------------------------------------------------------------------
8524 double precision function scalar2(u,v)
8526 double precision u(2),v(2)
8529 scalar2=u(1)*v(1)+u(2)*v(2)
8533 C-----------------------------------------------------------------------------
8535 subroutine transpose2(a,at)
8537 double precision a(2,2),at(2,2)
8544 c--------------------------------------------------------------------------
8545 subroutine transpose(n,a,at)
8548 double precision a(n,n),at(n,n)
8556 C---------------------------------------------------------------------------
8557 subroutine prodmat3(a1,a2,kk,transp,prod)
8560 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8562 crc double precision auxmat(2,2),prod_(2,2)
8565 crc call transpose2(kk(1,1),auxmat(1,1))
8566 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8567 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8569 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8570 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8571 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8572 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8573 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8574 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8575 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8576 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8579 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8580 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8582 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8583 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8584 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8585 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8586 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8587 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8588 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8589 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8592 c call transpose2(a2(1,1),a2t(1,1))
8595 crc print *,((prod_(i,j),i=1,2),j=1,2)
8596 crc print *,((prod(i,j),i=1,2),j=1,2)
8600 C-----------------------------------------------------------------------------
8601 double precision function scalar(u,v)
8603 double precision u(3),v(3)
8613 C-----------------------------------------------------------------------
8614 double precision function sscale(r)
8615 double precision r,gamm
8616 include "COMMON.SPLITELE"
8617 if(r.lt.r_cut-rlamb) then
8619 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8620 gamm=(r-(r_cut-rlamb))/rlamb
8621 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8627 C-----------------------------------------------------------------------
8628 C-----------------------------------------------------------------------
8629 double precision function sscagrad(r)
8630 double precision r,gamm
8631 include "COMMON.SPLITELE"
8632 if(r.lt.r_cut-rlamb) then
8634 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8635 gamm=(r-(r_cut-rlamb))/rlamb
8636 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8642 C-----------------------------------------------------------------------
8643 C-----------------------------------------------------------------------
8644 double precision function sscalelip(r)
8645 double precision r,gamm
8646 include "COMMON.SPLITELE"
8647 C if(r.lt.r_cut-rlamb) then
8649 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8650 C gamm=(r-(r_cut-rlamb))/rlamb
8651 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8657 C-----------------------------------------------------------------------
8658 double precision function sscagradlip(r)
8659 double precision r,gamm
8660 include "COMMON.SPLITELE"
8661 C if(r.lt.r_cut-rlamb) then
8663 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8664 C gamm=(r-(r_cut-rlamb))/rlamb
8665 sscagradlip=r*(6*r-6.0d0)
8671 c----------------------------------------------------------------------------
8672 double precision function sscale2(r,r_cut,r0,rlamb)
8674 double precision r,gamm,r_cut,r0,rlamb,rr
8676 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
8677 c write (2,*) "rr",rr
8678 if(rr.lt.r_cut-rlamb) then
8680 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8681 gamm=(rr-(r_cut-rlamb))/rlamb
8682 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8688 C-----------------------------------------------------------------------
8689 double precision function sscalgrad2(r,r_cut,r0,rlamb)
8691 double precision r,gamm,r_cut,r0,rlamb,rr
8693 if(rr.lt.r_cut-rlamb) then
8695 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
8696 gamm=(rr-(r_cut-rlamb))/rlamb
8698 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
8700 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
8707 c----------------------------------------------------------------------------
8708 subroutine e_saxs(Esaxs_constr)
8710 include 'DIMENSIONS'
8711 include 'DIMENSIONS.ZSCOPT'
8712 include 'DIMENSIONS.FREE'
8715 include "COMMON.SETUP"
8718 include 'COMMON.SBRIDGE'
8719 include 'COMMON.CHAIN'
8720 include 'COMMON.GEO'
8721 include 'COMMON.LOCAL'
8722 include 'COMMON.INTERACT'
8723 include 'COMMON.VAR'
8724 include 'COMMON.IOUNITS'
8725 include 'COMMON.DERIV'
8726 include 'COMMON.CONTROL'
8727 include 'COMMON.NAMES'
8728 include 'COMMON.FFIELD'
8729 include 'COMMON.LANGEVIN'
8731 double precision Esaxs_constr
8732 integer i,iint,j,k,l
8733 double precision PgradC(maxSAXS,3,maxres),
8734 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
8736 double precision PgradC_(maxSAXS,3,maxres),
8737 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
8739 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
8740 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
8741 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
8742 & auxX,auxX1,CACAgrad,Cnorm
8743 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
8744 double precision dist
8746 c SAXS restraint penalty function
8748 write(iout,*) "------- SAXS penalty function start -------"
8749 write (iout,*) "nsaxs",nsaxs
8750 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
8751 write (iout,*) "Psaxs"
8753 write (iout,'(i5,e15.5)') i, Psaxs(i)
8756 Esaxs_constr = 0.0d0
8766 do i=iatsc_s,iatsc_e
8767 if (itype(i).eq.ntyp1) cycle
8768 do iint=1,nint_gr(i)
8769 do j=istart(i,iint),iend(i,iint)
8770 if (itype(j).eq.ntyp1) cycle
8773 dijCASC=dist(i,j+nres)
8774 dijSCCA=dist(i+nres,j)
8775 dijSCSC=dist(i+nres,j+nres)
8776 sigma2CACA=2.0d0/(pstok**2)
8777 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
8778 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
8779 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
8782 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8783 if (itype(j).ne.10) then
8784 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
8788 if (itype(i).ne.10) then
8789 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
8793 if (itype(i).ne.10 .and. itype(j).ne.10) then
8794 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
8798 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
8800 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8802 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8803 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
8804 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
8805 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
8808 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8809 PgradC(k,l,i) = PgradC(k,l,i)-aux
8810 PgradC(k,l,j) = PgradC(k,l,j)+aux
8812 if (itype(j).ne.10) then
8813 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
8814 PgradC(k,l,i) = PgradC(k,l,i)-aux
8815 PgradC(k,l,j) = PgradC(k,l,j)+aux
8816 PgradX(k,l,j) = PgradX(k,l,j)+aux
8819 if (itype(i).ne.10) then
8820 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
8821 PgradX(k,l,i) = PgradX(k,l,i)-aux
8822 PgradC(k,l,i) = PgradC(k,l,i)-aux
8823 PgradC(k,l,j) = PgradC(k,l,j)+aux
8826 if (itype(i).ne.10 .and. itype(j).ne.10) then
8827 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
8828 PgradC(k,l,i) = PgradC(k,l,i)-aux
8829 PgradC(k,l,j) = PgradC(k,l,j)+aux
8830 PgradX(k,l,i) = PgradX(k,l,i)-aux
8831 PgradX(k,l,j) = PgradX(k,l,j)+aux
8837 sigma2CACA=scal_rad**2*0.25d0/
8838 & (restok(itype(j))**2+restok(itype(i))**2)
8840 IF (saxs_cutoff.eq.0) THEN
8843 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
8844 Pcalc(k) = Pcalc(k)+expCACA
8845 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
8847 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8848 PgradC(k,l,i) = PgradC(k,l,i)-aux
8849 PgradC(k,l,j) = PgradC(k,l,j)+aux
8853 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
8856 c write (2,*) "ijk",i,j,k
8857 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
8858 if (sss2.eq.0.0d0) cycle
8859 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
8860 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
8861 Pcalc(k) = Pcalc(k)+expCACA
8863 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
8865 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
8866 & ssgrad2*expCACA/sss2
8869 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
8870 PgradC(k,l,i) = PgradC(k,l,i)+aux
8871 PgradC(k,l,j) = PgradC(k,l,j)-aux
8880 if (nfgtasks.gt.1) then
8881 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
8882 & MPI_SUM,king,FG_COMM,IERR)
8883 if (fg_rank.eq.king) then
8885 Pcalc(k) = Pcalc_(k)
8888 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
8889 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8890 if (fg_rank.eq.king) then
8894 PgradC(k,l,i) = PgradC_(k,l,i)
8900 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
8901 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
8902 if (fg_rank.eq.king) then
8906 PgradX(k,l,i) = PgradX_(k,l,i)
8915 if (fg_rank.eq.king) then
8919 Cnorm = Cnorm + Pcalc(k)
8921 Esaxs_constr = dlog(Cnorm)-wsaxs0
8923 if (Pcalc(k).gt.0.0d0)
8924 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
8926 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
8930 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
8940 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
8941 auxC1 = auxC1+PgradC(k,l,i)
8943 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
8944 auxX1 = auxX1+PgradX(k,l,i)
8947 gsaxsC(l,i) = auxC - auxC1/Cnorm
8949 gsaxsX(l,i) = auxX - auxX1/Cnorm
8951 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
8952 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
8960 c----------------------------------------------------------------------------
8961 subroutine e_saxsC(Esaxs_constr)
8963 include 'DIMENSIONS'
8964 include 'DIMENSIONS.ZSCOPT'
8965 include 'DIMENSIONS.FREE'
8968 include "COMMON.SETUP"
8971 include 'COMMON.SBRIDGE'
8972 include 'COMMON.CHAIN'
8973 include 'COMMON.GEO'
8974 include 'COMMON.LOCAL'
8975 include 'COMMON.INTERACT'
8976 include 'COMMON.VAR'
8977 include 'COMMON.IOUNITS'
8978 include 'COMMON.DERIV'
8979 include 'COMMON.CONTROL'
8980 include 'COMMON.NAMES'
8981 include 'COMMON.FFIELD'
8982 include 'COMMON.LANGEVIN'
8984 double precision Esaxs_constr
8985 integer i,iint,j,k,l
8986 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
8988 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
8990 double precision dk,dijCASPH,dijSCSPH,
8991 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
8992 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
8994 c SAXS restraint penalty function
8996 write(iout,*) "------- SAXS penalty function start -------"
8997 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
8998 & " isaxs_end",isaxs_end
8999 write (iout,*) "nnt",nnt," ntc",nct
9001 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9002 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9005 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9008 Esaxs_constr = 0.0d0
9010 do j=isaxs_start,isaxs_end
9022 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9024 if (itype(i).ne.10) then
9026 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9029 sigma2CA=2.0d0/pstok**2
9030 sigma2SC=4.0d0/restok(itype(i))**2
9031 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9032 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9033 Pcalc = Pcalc+expCASPH+expSCSPH
9035 write(*,*) "processor i j Pcalc",
9036 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
9038 CASPHgrad = sigma2CA*expCASPH
9039 SCSPHgrad = sigma2SC*expSCSPH
9041 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9042 PgradX(l,i) = PgradX(l,i) + aux
9043 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9048 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
9049 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
9052 logPtot = logPtot - dlog(Pcalc)
9053 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
9054 c & " logPtot",logPtot
9057 if (nfgtasks.gt.1) then
9058 c write (iout,*) "logPtot before reduction",logPtot
9059 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9060 & MPI_SUM,king,FG_COMM,IERR)
9062 c write (iout,*) "logPtot after reduction",logPtot
9063 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9064 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9065 if (fg_rank.eq.king) then
9068 gsaxsC(l,i) = gsaxsC_(l,i)
9072 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9073 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9074 if (fg_rank.eq.king) then
9077 gsaxsX(l,i) = gsaxsX_(l,i)
9083 Esaxs_constr = logPtot